diff --git a/CMakeLists.txt b/CMakeLists.txt new file mode 100644 index 000000000..e7e010394 --- /dev/null +++ b/CMakeLists.txt @@ -0,0 +1,177 @@ +## MPAS-Model +cmake_minimum_required(VERSION 3.12) + +include(${CMAKE_CURRENT_SOURCE_DIR}/cmake/Functions/MPAS_Functions.cmake) +get_mpas_version(MPAS_VERSION) +project(MPAS LANGUAGES C Fortran VERSION ${MPAS_VERSION} DESCRIPTION "MPAS - Model for Prediction Across Scales") + +list(INSERT CMAKE_MODULE_PATH 0 ${CMAKE_CURRENT_SOURCE_DIR}/cmake/Modules) +set(CMAKE_DIRECTORY_LABELS ${PROJECT_NAME}) +include(GNUInstallDirs) + +# Options +set(MPAS_ALL_CORES atmosphere init_atmosphere) +set(MPAS_CORES atmosphere CACHE STRING "MPAS cores to build. Options: ${MPAS_ALL_CORES}") +if(MPAS_CORES MATCHES " ") #Convert strings separated with spaces to CMake list separated with ';' + string(REPLACE " " ";" MPAS_CORES ${MPAS_CORES}) + set(MPAS_CORES ${MPAS_CORES} CACHE STRING "MPAS cores to build. Options: ${MPAS_ALL_CORES}" FORCE) +endif() +option(DO_PHYSICS "Use built-in physics schemes." TRUE) +option(MPAS_DOUBLE_PRECISION "Use double precision 64-bit Floating point." TRUE) +option(MPAS_PROFILE "Enable GPTL profiling" OFF) +option(MPAS_OPENMP "Enable OpenMP" OFF) +option(BUILD_SHARED_LIBS "Build shared libraries" ON) +option(MPAS_USE_PIO "Build with PIO I/O library" OFF) + +message(STATUS "[OPTION] MPAS_CORES: ${MPAS_CORES}") +message(STATUS "[OPTION] MPAS_DOUBLE_PRECISION: ${MPAS_DOUBLE_PRECISION}") +message(STATUS "[OPTION] MPAS_PROFILE: ${MPAS_PROFILE}") +message(STATUS "[OPTION] MPAS_OPENMP: ${MPAS_OPENMP}") +message(STATUS "[OPTION] BUILD_SHARED_LIBS: ${BUILD_SHARED_LIBS}") +message(STATUS "[OPTION] MPAS_USE_PIO: ${MPAS_USE_PIO}") + +# Build product output locations +set(CMAKE_RUNTIME_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/bin) +set(CMAKE_LIBRARY_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/lib) +set(CMAKE_ARCHIVE_OUTPUT_DIRECTORY ${CMAKE_BINARY_DIR}/lib) + +# Set default build type to RelWithDebInfo +if(NOT CMAKE_BUILD_TYPE) + message(STATUS "Setting default build type to Release. Specify CMAKE_BUILD_TYPE to override.") + set(CMAKE_BUILD_TYPE "Release" CACHE STRING "CMake Build type" FORCE) + set_property(CACHE CMAKE_BUILD_TYPE PROPERTY STRINGS "Debug" "Release" "MinSizeRel" "RelWithDebInfo") +endif() + +# Detect MPAS git version +if(NOT MPAS_GIT_VERSION) + find_package(Git QUIET) + if(GIT_FOUND) + execute_process(COMMAND ${GIT_EXECUTABLE} describe --dirty + WORKING_DIRECTORY "${CMAKE_SOURCE_DIR}" + OUTPUT_VARIABLE _mpas_git_version + ERROR_QUIET OUTPUT_STRIP_TRAILING_WHITESPACE) + else() + set(_mpas_git_version "Unknown") + endif() + set(MPAS_GIT_VERSION ${_mpas_git_version} CACHE STRING "MPAS-Model git version") +endif() + +### Dependencies +find_package(OpenMP COMPONENTS Fortran) + +# use mpifort options with nvfortran +if(CMAKE_Fortran_COMPILER_ID MATCHES NVHPC) + find_program(CMAKE_Fortran_COMPILER_MPI NAMES mpifort REQUIRED) + message(VERBOSE "CMAKE_Fortran_COMPILER_MPI: ${CMAKE_Fortran_COMPILER_MPI}") + set(MPI_Fortran_COMPILER mpifort) +endif() +find_package(MPI REQUIRED COMPONENTS Fortran) + +find_package(PnetCDF REQUIRED COMPONENTS Fortran) +if(MPAS_USE_PIO) + find_package(PIO REQUIRED COMPONENTS Fortran C) + find_package(NetCDF REQUIRED COMPONENTS Fortran C) +endif() +if(MPAS_PROFILE) + find_package(GPTL REQUIRED) +endif() + +# Find C pre-processor +if(CMAKE_C_COMPILER_ID MATCHES GNU) + find_program(CPP_EXECUTABLE NAMES cpp REQUIRED) + set(CPP_EXTRA_FLAGS -traditional) +elseif(CMAKE_C_COMPILER_ID MATCHES "(Apple)?Clang" ) + find_program(CPP_EXECUTABLE NAMES cpp REQUIRED) +elseif(CMAKE_C_COMPILER_ID MATCHES "NVHPC" ) + find_program(CPP_EXECUTABLE NAMES cpp REQUIRED) +else() + message(STATUS "Unknown compiler: ${CMAKE_C_COMPILER_ID}") + set(CPP_EXECUTABLE ${CMAKE_C_COMPILER}) +endif() + +## Common Variables + +# Fortran module output directory for build interface +set(MPAS_MODULE_DIR ${PROJECT_NAME}/module/${CMAKE_Fortran_COMPILER_ID}/${CMAKE_Fortran_COMPILER_VERSION}) +# Install Fortran module directory +install(DIRECTORY ${CMAKE_BINARY_DIR}/${MPAS_MODULE_DIR}/ DESTINATION ${CMAKE_INSTALL_LIBDIR}/${MPAS_MODULE_DIR}/) + +# Location of common subdriver module compiled by each cores +set(MPAS_MAIN_SRC ${CMAKE_CURRENT_SOURCE_DIR}/src/driver/mpas.F) +set(MPAS_SUBDRIVER_SRC ${CMAKE_CURRENT_SOURCE_DIR}/src/driver/mpas_subdriver.F) + +## Create targets +add_subdirectory(src/external/ezxml) # Target: MPAS::external::ezxml +if(NOT MPAS_USE_PIO) + add_subdirectory(src/external/SMIOL) # Target: MPAS::external::smiol +endif() +if(ESMF_FOUND) + message(STATUS "Configure MPAS for external ESMF") + add_definitions(-DMPAS_EXTERNAL_ESMF_LIB -DMPAS_NO_ESMF_INIT) + add_library(${PROJECT_NAME}::external::esmf ALIAS esmf) +else() + message(STATUS "Configure MPAS for internal ESMF") + add_subdirectory(src/external/esmf_time_f90) # Target: MPAS::external::esmf_time +endif() +add_subdirectory(src/tools/input_gen) # Targets: namelist_gen, streams_gen +add_subdirectory(src/tools/registry) # Targets: mpas_parse_ +add_subdirectory(src/framework) # Target: MPAS::framework +add_subdirectory(src/operators) # Target: MPAS::operators + +foreach(_core IN LISTS MPAS_CORES) + add_subdirectory(src/core_${_core}) # Target: MPAS::core:: +endforeach() + +### Package config +include(CMakePackageConfigHelpers) + +# Build-tree target exports +export(EXPORT ${PROJECT_NAME}ExportsExternal NAMESPACE ${PROJECT_NAME}::external:: FILE ${PROJECT_NAME}-targets-external.cmake) +export(EXPORT ${PROJECT_NAME}Exports NAMESPACE ${PROJECT_NAME}:: FILE ${PROJECT_NAME}-targets.cmake) +export(EXPORT ${PROJECT_NAME}ExportsCore NAMESPACE ${PROJECT_NAME}::core:: FILE ${PROJECT_NAME}-targets-core.cmake) + +# CMake Config file install location +set(CONFIG_INSTALL_DESTINATION ${CMAKE_INSTALL_LIBDIR}/cmake/${PROJECT_NAME}) +# Install MPAS-supplied Find.cmake modules for use by downstream CMake dependencies +install(DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR}/cmake/Modules DESTINATION ${CONFIG_INSTALL_DESTINATION}) + +## -config.cmake: build-tree +# Variables to export for use from build-tree +set(BINDIR ${CMAKE_BINARY_DIR}/bin) +set(CORE_DATADIR_ROOT ${CMAKE_BINARY_DIR}/${PROJECT_NAME}) +set(CMAKE_MODULE_INSTALL_PATH ${CMAKE_CURRENT_SOURCE_DIR}/cmake/Modules) +string(TOLOWER ${PROJECT_NAME} PROJECT_NAME_LOWER) +configure_package_config_file(cmake/PackageConfig.cmake.in ${PROJECT_NAME_LOWER}-config.cmake + INSTALL_DESTINATION . + INSTALL_PREFIX ${CMAKE_CURRENT_BINARY_DIR} + PATH_VARS BINDIR CORE_DATADIR_ROOT CMAKE_MODULE_INSTALL_PATH) + +## -config.cmake: install-tree +# Variables to export for use from install-tree +set(BINDIR ${CMAKE_INSTALL_BINDIR}) +set(CORE_DATADIR_ROOT ${CMAKE_INSTALL_DATADIR}/${PROJECT_NAME}) +set(CMAKE_MODULE_INSTALL_PATH ${CONFIG_INSTALL_DESTINATION}/Modules) +configure_package_config_file(cmake/PackageConfig.cmake.in install/${PROJECT_NAME_LOWER}-config.cmake + INSTALL_DESTINATION ${CONFIG_INSTALL_DESTINATION} + PATH_VARS BINDIR CORE_DATADIR_ROOT CMAKE_MODULE_INSTALL_PATH) +install(FILES ${CMAKE_CURRENT_BINARY_DIR}/install/${PROJECT_NAME_LOWER}-config.cmake + DESTINATION ${CONFIG_INSTALL_DESTINATION}) + +## -config-version.cmake +write_basic_package_version_file( + ${CMAKE_CURRENT_BINARY_DIR}/${PROJECT_NAME_LOWER}-config-version.cmake + VERSION ${PROJECT_VERSION} + COMPATIBILITY AnyNewerVersion) +install(FILES ${CMAKE_CURRENT_BINARY_DIR}/${PROJECT_NAME_LOWER}-config-version.cmake + DESTINATION ${CONFIG_INSTALL_DESTINATION}) + +## package-targets.cmake and package-targets-.cmake +install(EXPORT ${PROJECT_NAME}ExportsExternal NAMESPACE ${PROJECT_NAME}::external:: + FILE ${PROJECT_NAME_LOWER}-targets-external.cmake + DESTINATION ${CONFIG_INSTALL_DESTINATION}) +install(EXPORT ${PROJECT_NAME}Exports NAMESPACE ${PROJECT_NAME}:: + FILE ${PROJECT_NAME_LOWER}-targets.cmake + DESTINATION ${CONFIG_INSTALL_DESTINATION}) +install(EXPORT ${PROJECT_NAME}ExportsCore NAMESPACE ${PROJECT_NAME}::core:: + FILE ${PROJECT_NAME_LOWER}-targets-core.cmake + DESTINATION ${CONFIG_INSTALL_DESTINATION}) diff --git a/Makefile b/Makefile index ee13a6e52..2c9cd0823 100644 --- a/Makefile +++ b/Makefile @@ -16,11 +16,11 @@ gnu: # BUILDTARGET GNU Fortran, C, and C++ compilers "CC_SERIAL = gcc" \ "CXX_SERIAL = g++" \ "FFLAGS_PROMOTION = -fdefault-real-8 -fdefault-double-8" \ - "FFLAGS_OPT = -std=f2008 -O3 -fallow-argument-mismatch -ffree-line-length-none -fconvert=big-endian -ffree-form" \ + "FFLAGS_OPT = -std=f2008 -O3 -ffree-line-length-none -fconvert=big-endian -ffree-form" \ "CFLAGS_OPT = -O3" \ "CXXFLAGS_OPT = -O3" \ "LDFLAGS_OPT = -O3" \ - "FFLAGS_DEBUG = -g -ffree-line-length-none -fallow-argument-mismatch -fconvert=big-endian -ffree-form -fcheck=all -fbacktrace -ffpe-trap=invalid,zero,overflow" \ + "FFLAGS_DEBUG = -std=f2008 -g -ffree-line-length-none -fconvert=big-endian -ffree-form -fcheck=all -fbacktrace -ffpe-trap=invalid,zero,overflow" \ "CFLAGS_DEBUG = -g" \ "CXXFLAGS_DEBUG = -g" \ "LDFLAGS_DEBUG = -g" \ @@ -154,7 +154,7 @@ nvhpc: # BUILDTARGET NVIDIA HPC SDK "FFLAGS_DEBUG = -O0 -g -Mbounds -Mchkptr -byteswapio -Mfree -Ktrap=divz,fp,inv,ovf -traceback" \ "CFLAGS_DEBUG = -O0 -g -traceback" \ "CXXFLAGS_DEBUG = -O0 -g -traceback" \ - "LDFLAGS_DEBUG = -O0 -g -Mbounds -Mchkptr -Ktrap=divz,fp,inv,ovf -traceback" \ + "LDFLAGS_DEBUG = -O0 -g -Mbounds -Ktrap=divz,fp,inv,ovf -traceback" \ "FFLAGS_OMP = -mp" \ "CFLAGS_OMP = -mp" \ "FFLAGS_ACC = -Mnofma -acc -gpu=cc70,cc80 -Minfo=accel" \ @@ -184,7 +184,7 @@ pgi: # BUILDTARGET PGI compiler suite "FFLAGS_DEBUG = -O0 -g -Mbounds -Mchkptr -byteswapio -Mfree -Ktrap=divz,fp,inv,ovf -traceback" \ "CFLAGS_DEBUG = -O0 -g -traceback" \ "CXXFLAGS_DEBUG = -O0 -g -traceback" \ - "LDFLAGS_DEBUG = -O0 -g -Mbounds -Mchkptr -Ktrap=divz,fp,inv,ovf -traceback" \ + "LDFLAGS_DEBUG = -O0 -g -Mbounds -Ktrap=divz,fp,inv,ovf -traceback" \ "FFLAGS_OMP = -mp" \ "CFLAGS_OMP = -mp" \ "FFLAGS_ACC = -Mnofma -acc -Minfo=accel" \ @@ -216,7 +216,7 @@ pgi-summit: # BUILDTARGET PGI compiler suite w/OpenACC options for ORNL Summit "FFLAGS_DEBUG = -O0 -g -Mbounds -Mchkptr -byteswapio -Mfree -Ktrap=divz,fp,inv,ovf -traceback" \ "CFLAGS_DEBUG = -O0 -g -traceback" \ "CXXFLAGS_DEBUG = -O0 -g -traceback" \ - "LDFLAGS_DEBUG = -O0 -g -Mbounds -Mchkptr -Ktrap=divz,fp,inv,ovf -traceback" \ + "LDFLAGS_DEBUG = -O0 -g -Mbounds -Ktrap=divz,fp,inv,ovf -traceback" \ "FFLAGS_OMP = -mp" \ "CFLAGS_OMP = -mp" \ "PICFLAG = -fpic" \ @@ -667,10 +667,10 @@ intel: # BUILDTARGET Intel oneAPI Fortran, C, and C++ compiler suite "CFLAGS_OPT = -O3" \ "CXXFLAGS_OPT = -O3" \ "LDFLAGS_OPT = -O3" \ - "FFLAGS_DEBUG = -g -convert big_endian -free -check all -fpe0 -traceback" \ + "FFLAGS_DEBUG = -g -convert big_endian -free -check bounds,pointers,arg_temp_created,format,shape,contiguous -fpe0 -traceback" \ "CFLAGS_DEBUG = -g -traceback" \ "CXXFLAGS_DEBUG = -g -traceback" \ - "LDFLAGS_DEBUG = -g -fpe0 -traceback" \ + "LDFLAGS_DEBUG = -g -traceback" \ "FFLAGS_OMP = -qopenmp" \ "CFLAGS_OMP = -qopenmp" \ "PICFLAG = -fpic" \ @@ -820,10 +820,10 @@ else # Not using PIO, using SMIOL endif ifneq "$(NETCDF)" "" -ifneq ($(wildcard $(NETCDF)/lib), ) +ifneq ($(wildcard $(NETCDF)/lib/libnetcdf.*), ) NETCDFLIBLOC = lib endif -ifneq ($(wildcard $(NETCDF)/lib64), ) +ifneq ($(wildcard $(NETCDF)/lib64/libnetcdf.*), ) NETCDFLIBLOC = lib64 endif CPPINCLUDES += -I$(NETCDF)/include @@ -844,10 +844,10 @@ endif ifneq "$(PNETCDF)" "" -ifneq ($(wildcard $(PNETCDF)/lib), ) +ifneq ($(wildcard $(PNETCDF)/lib/libpnetcdf.*), ) PNETCDFLIBLOC = lib endif -ifneq ($(wildcard $(PNETCDF)/lib64), ) +ifneq ($(wildcard $(PNETCDF)/lib64/libpnetcdf.*), ) PNETCDFLIBLOC = lib64 endif CPPINCLUDES += -I$(PNETCDF)/include @@ -1041,28 +1041,6 @@ else OPENACC_MESSAGE="MPAS was built without OpenACC accelerator support." endif -ifneq ($(wildcard .mpas_core_*), ) # CHECK FOR BUILT CORE - -ifneq ($(wildcard .mpas_core_$(CORE)), ) # CHECK FOR SAME CORE AS ATTEMPTED BUILD. - override AUTOCLEAN=false - CONTINUE=true -else - LAST_CORE=`cat .mpas_core_*` - -ifeq "$(AUTOCLEAN)" "true" # CHECK FOR CLEAN PRIOR TO BUILD OF A NEW CORE. - CONTINUE=true - AUTOCLEAN_MESSAGE="Infrastructure was cleaned prior to building ." -else - CONTINUE=false -endif # END OF AUTOCLEAN CHECK - -endif # END OF CORE=LAST_CORE CHECK - -else - - override AUTOCLEAN=false - CONTINUE=true -endif # END IF BUILT CORE CHECK ifneq ($(wildcard namelist.$(NAMELIST_SUFFIX)), ) # Check for generated namelist file. NAMELIST_MESSAGE="A default namelist file (namelist.$(NAMELIST_SUFFIX).defaults) has been generated, but namelist.$(NAMELIST_SUFFIX) has not been modified." @@ -1119,12 +1097,119 @@ report_builds: @echo "CORE=$(CORE)" endif -ifeq "$(CONTINUE)" "true" all: mpas_main -else -all: clean_core + endif +# +# The rebuild_check target determines whether the shared framework or $(CORE) were +# previously compiled with incompatible options, and stops the build with an error +# message if so. +# +rebuild_check: + @# + @# Write current build options to a file .build_opts.tmp, to later be + @# compared with build options use for the shared framework or core. + @# Only build options that affect compatibility are written, while options + @# like $(RM), $(BUILD_TARGET), and $(CORE) are not. + @# + $(shell printf "FC=$(FC)\n$\ + CC=$(CC)\n$\ + CXX=$(CXX)\n$\ + SFC=$(SFC)\n$\ + SCC=$(SCC)\n$\ + CFLAGS=$(CFLAGS)\n$\ + CXXFLAGS=$(CXXFLAGS)\n$\ + FFLAGS=$(FFLAGS)\n$\ + LDFLAGS=$(LDFLAGS)\n$\ + CPPFLAGS=$(CPPFLAGS)\n$\ + LIBS=$(LIBS)\n$\ + CPPINCLUDES=$(CPPINCLUDES)\n$\ + OPENMP=$(OPENMP)\n$\ + OPENMP_OFFLOAD=$(OPENMP_OFFLOAD)\n$\ + OPENACC=$(OPENACC)\n$\ + TAU=$(TAU)\n$\ + PICFLAG=$(PICFLAG)\n$\ + TIMER_LIB=$(TIMER_LIB)\n$\ + GEN_F90=$(GEN_F90)\n" | sed 's/-DMPAS_EXE_NAME=[^[:space:]]*//' | sed 's/-DMPAS_NAMELIST_SUFFIX=[^[:space:]]*//' | sed 's/-DCORE_[^[:space:]]*//' | sed 's/-DMPAS_GIT_VERSION=[^[:space:]]*//' > .build_opts.tmp ) + + @# + @# PREV_BUILD is set to "OK" if the shared framework and core are either + @# clean or were previously compiled with compatible options. Otherwise, + @# PREV_BUILD is set to "shared framework" if the shared framework was + @# built with incompatible options, or "$(CORE) core" if the core was + @# built with incompatible options. + @# + $(eval PREV_BUILD := $(shell $\ + if [ -f ".build_opts.framework" ]; then $\ + cmp -s .build_opts.tmp .build_opts.framework; $\ + if [ $$? -eq 0 ]; then $\ + stat=0; $\ + else $\ + stat=1; $\ + x="shared framework"; $\ + if [ "$(AUTOCLEAN)" = "true" ]; then $\ + cp .build_opts.tmp .build_opts.framework; $\ + fi; $\ + fi $\ + else $\ + stat=0; $\ + cp .build_opts.tmp .build_opts.framework; $\ + fi; $\ + : ; $\ + : At this this point, stat is already set, and we should only ; $\ + : set it to 1 but never to 0, as that might mask an incompatibility ; $\ + : in the framework build. ; $\ + : ; $\ + if [ -f ".build_opts.$(CORE)" ]; then $\ + cmp -s .build_opts.tmp .build_opts.$(CORE); $\ + if [ $$? -ne 0 ]; then $\ + stat=1; $\ + if [ "$$x" = "" ]; then $\ + x="$(CORE) core"; $\ + else $\ + x="$$x and $(CORE) core"; $\ + fi; $\ + if [ "$(AUTOCLEAN)" = "true" ]; then $\ + cp .build_opts.tmp .build_opts.$(CORE); $\ + fi; $\ + fi; $\ + else $\ + if [ $$stat -eq 0 ]; then $\ + cp .build_opts.tmp .build_opts.$(CORE); $\ + fi; $\ + fi; $\ + rm -f .build_opts.tmp; $\ + if [ $$stat -eq 1 ]; then $\ + printf "$$x"; $\ + else $\ + printf "OK"; $\ + fi; $\ + )) + + $(if $(findstring and,$(PREV_BUILD)),$(eval VERB=were),$(eval VERB=was)) +ifeq "$(AUTOCLEAN)" "true" + $(if $(findstring framework,$(PREV_BUILD)),$(eval AUTOCLEAN_DEPS+=clean_shared)) + $(if $(findstring core,$(PREV_BUILD)),$(eval AUTOCLEAN_DEPS+=clean_core)) + $(if $(findstring OK,$(PREV_BUILD)), $(eval override AUTOCLEAN=false), ) + $(eval AUTOCLEAN_MESSAGE=The $(PREV_BUILD) $(VERB) cleaned and re-compiled.) +else + $(if $(findstring OK,$(PREV_BUILD)), \ + , \ + $(info ************************************************************************) \ + $(info The $(PREV_BUILD) $(VERB) previously compiled with ) \ + $(info incompatible options. Please do one of the following:) \ + $(info ) \ + $(info - Clean the $(CORE) core, which will also cause the shared) \ + $(info framework to be cleaned; then compile the $(CORE) core.) \ + $(info ) \ + $(info or)\ + $(info ) \ + $(info - Add AUTOCLEAN=true to the build command to automatically clean) \ + $(info and re-compile the $(PREV_BUILD).) \ + $(info ) \ + $(info ************************************************************************) \ + $(error )) endif @@ -1264,7 +1349,7 @@ ifeq "$(OPENACC)" "true" endif # OPENACC eq true -pio_test: openmp_test openacc_test +pio_test: openmp_test openacc_test pnetcdf_test @# @# PIO_VERS will be set to: @# 0 if no working PIO library was detected (and .piotest.log will contain error messages) @@ -1350,9 +1435,10 @@ mpi_f08_test: $(info Checking for mpi_f08 support...) $(eval MPAS_MPI_F08 := $(shell $\ printf "program main\n$\ - & use mpi_f08, only : MPI_Init, MPI_Comm\n$\ + & use mpi_f08, only : MPI_Init, MPI_Comm, MPI_INTEGER, MPI_Datatype\n$\ & integer :: ierr\n$\ & type (MPI_Comm) :: comm\n$\ + & type (MPI_Datatype), parameter :: MPI_INTEGERKIND = MPI_INTEGER\n$\ & call MPI_Init(ierr)\n$\ end program main\n" | sed 's/&/ /' > mpi_f08.f90; $\ $\ @@ -1371,20 +1457,57 @@ mpi_f08_test: $(if $(findstring 1,$(MPAS_MPI_F08)), $(eval MPI_F08_MESSAGE = "Using the mpi_f08 module."), ) $(if $(findstring 1,$(MPAS_MPI_F08)), $(info mpi_f08 module detected.)) + +pnetcdf_test: + @# + @# Create test C programs that look for PNetCDF header file and some symbols in it + @# +ifneq "$(PNETCDF)" "" + @echo "Checking for a working PnetCDF library..." + @printf "#include \"pnetcdf.h\"\n\ + &#include \"mpi.h\"\n\ + &int main(){\n\ + & int err, ncid;\n\ + & err = ncmpi_create(MPI_COMM_WORLD, \"foo.nc\", NC_NOCLOBBER, MPI_INFO_NULL, &ncid);\n\ + & return 0;\n\ + &}\n" | sed 's/&/ /' > pnetcdf.c + @( $(CC) pnetcdf.c $(CPPINCLUDES) $(CFLAGS) $(LDFLAGS) -L$(PNETCDF)/$(PNETCDFLIBLOC) -lpnetcdf -o pnetcdf.out > pnetcdf.log 2>&1; \ + if [ $$? -eq 0 ] ; then \ + echo "$(CC) can compile test PnetCDF C program."; \ + else \ + echo "*********************************************************"; \ + echo "ERROR: Test PnetCDF C program could not be compiled by $(CC)."; \ + echo "Please ensure you have a working PnetCDF library installed."; \ + echo ""; \ + echo "The following compilation command failed with errors:" ; \ + echo "$(CC) pnetcdf.c $(CPPINCLUDES) $(CFLAGS) $(LDFLAGS) -L$(PNETCDF)/$(PNETCDFLIBLOC) -lpnetcdf -o pnetcdf.out"; \ + echo ""; \ + echo "Test program pnetcdf.c and output pnetcdf.log have been left"; \ + echo "in the top-level MPAS directory for further debugging"; \ + echo "*********************************************************"; \ + rm -f pnetcdf.out; exit 1; \ + fi ) + + @rm -f pnetcdf.c pnetcdf.out pnetcdf.log +else + @echo "*********************************************************"; \ + echo "ERROR: The PNETCDF environment variable isn't set."; \ + echo "Please set this variable to where PnetCDF is installed."; \ + echo "*********************************************************"; \ + exit 1 +endif + + ifneq "$(PIO)" "" -MAIN_DEPS = openmp_test openacc_test pio_test mpi_f08_test +MAIN_DEPS = rebuild_check openmp_test openacc_test pnetcdf_test pio_test mpi_f08_test override CPPFLAGS += "-DMPAS_PIO_SUPPORT" else -MAIN_DEPS = openmp_test openacc_test mpi_f08_test +MAIN_DEPS = rebuild_check openmp_test openacc_test pnetcdf_test mpi_f08_test IO_MESSAGE = "Using the SMIOL library." override CPPFLAGS += "-DMPAS_SMIOL_SUPPORT" endif - mpas_main: $(MAIN_DEPS) -ifeq "$(AUTOCLEAN)" "true" - $(RM) .mpas_core_* -endif cd src; $(MAKE) FC="$(FC)" \ CC="$(CC)" \ CXX="$(CXX)" \ @@ -1403,11 +1526,11 @@ endif FCINCLUDES="$(FCINCLUDES)" \ CORE="$(CORE)"\ AUTOCLEAN="$(AUTOCLEAN)" \ + AUTOCLEAN_DEPS="$(AUTOCLEAN_DEPS)" \ GEN_F90="$(GEN_F90)" \ NAMELIST_SUFFIX="$(NAMELIST_SUFFIX)" \ EXE_NAME="$(EXE_NAME)" - @echo "$(EXE_NAME)" > .mpas_core_$(CORE) if [ -e src/$(EXE_NAME) ]; then mv src/$(EXE_NAME) .; fi ( cd src/core_$(CORE); $(MAKE) ROOT_DIR="$(PWD)" post_build ) @echo "*******************************************************************************" @@ -1429,11 +1552,13 @@ endif @echo $(IO_MESSAGE) @echo "*******************************************************************************" clean: - cd src; $(MAKE) clean RM="$(RM)" CORE="$(CORE)" - $(RM) .mpas_core_* + cd src; $(MAKE) clean RM="$(RM)" CORE="$(CORE)" AUTOCLEAN="$(AUTOCLEAN)" $(RM) $(EXE_NAME) $(RM) namelist.$(NAMELIST_SUFFIX).defaults $(RM) streams.$(NAMELIST_SUFFIX).defaults + if [ -f .build_opts.framework ]; then $(RM) .build_opts.framework; fi + if [ -f .build_opts.$(CORE) ]; then $(RM) .build_opts.$(CORE); fi + core_error: @echo "" @echo "*******************************************************************************" @@ -1444,26 +1569,6 @@ core_error: exit 1 error: errmsg -clean_core: - @echo "" - @echo "*******************************************************************************" - @echo " The MPAS infrastructure is currently built for the $(LAST_CORE) core." - @echo " Before building the $(CORE) core, please do one of the following." - @echo "" - @echo "" - @echo " To remove the $(LAST_CORE)_model executable and clean the MPAS infrastructure, run:" - @echo " make clean CORE=$(LAST_CORE)" - @echo "" - @echo " To preserve all executables except $(CORE)_model and clean the MPAS infrastructure, run:" - @echo " make clean CORE=$(CORE)" - @echo "" - @echo " Alternatively, AUTOCLEAN=true can be appended to the make command to force a clean," - @echo " build a new $(CORE)_model executable, and preserve all other executables." - @echo "" - @echo "*******************************************************************************" - @echo "" - exit 1 - else # CORE IF all: error @@ -1491,7 +1596,7 @@ errmsg: @echo " DEBUG=true - builds debug version. Default is optimized version." @echo " USE_PAPI=true - builds version using PAPI for timers. Default is off." @echo " TAU=true - builds version using TAU hooks for profiling. Default is off." - @echo " AUTOCLEAN=true - forces a clean of infrastructure prior to build new core." + @echo " AUTOCLEAN=true - Enables automatic cleaning and re-compilation of code as needed." @echo " GEN_F90=true - Generates intermediate .f90 files through CPP, and builds with them." @echo " TIMER_LIB=opt - Selects the timer library interface to be used for profiling the model. Options are:" @echo " TIMER_LIB=native - Uses native built-in timers in MPAS" diff --git a/README.md b/README.md index e8a113a3f..eecd7a204 100644 --- a/README.md +++ b/README.md @@ -28,20 +28,30 @@ History - Version 0.2.0 - Included variables and new isobaric levels. - Version 0.1.0 - Initial version structure (0.1.0) based on the dynamic core of the MPAS 8.0.1 Model. - -MPAS-v8.1.0 -==== - -The Model for Prediction Across Scales (MPAS) is a collaborative project for developing atmosphere, ocean, and other earth-system simulation components for use in climate, regional climate, and weather studies. The primary development partners are the climate modeling group at Los Alamos National Laboratory (COSIM) and the National Center for Atmospheric Research. Both primary partners are responsible for the MPAS framework, operators, and tools common to the applications; LANL has primary responsibility for the ocean model, and NCAR has primary responsibility for the atmospheric model. - -The MPAS framework facilitates the rapid development and prototyping of models by providing infrastructure typically required by model developers, including high-level data types, communication routines, and I/O routines. By using MPAS, developers can leverage pre-existing code and focus more on development of their model. - -Building -==== - -This README is provided as a brief introduction to the MPAS framework. It does not provide details about each specific model, nor does it provide building instructions. - -For information about building and running each core, please refer to each core's user's guide, which can be found at the following web sites: +The Model for Prediction Across Scales (MPAS) is a collaborative project for +developing atmosphere, ocean, and other earth-system simulation components for +use in climate, regional climate, and weather studies. The primary development +partners are the climate modeling group at Los Alamos National Laboratory +(COSIM) and the National Center for Atmospheric Research. Both primary +partners are responsible for the MPAS framework, operators, and tools common to +the applications; LANL has primary responsibility for the ocean model, and NCAR +has primary responsibility for the atmospheric model. + +The MPAS framework facilitates the rapid development and prototyping of models +by providing infrastructure typically required by model developers, including +high-level data types, communication routines, and I/O routines. By using MPAS, +developers can leverage pre-existing code and focus more on development of +their model. + +BUILDING +======== + +This README is provided as a brief introduction to the MPAS framework. It does +not provide details about each specific model, nor does it provide building +instructions. + +For information about building and running each core, please refer to each +core's user's guide, which can be found at the following web sites: [MPAS-Atmosphere](http://mpas-dev.github.io/atmosphere/atmosphere_download.html) @@ -53,9 +63,10 @@ For information about building and running each core, please refer to each core' Code Layout ------------ +---------- -Within the MPAS repository, code is laid out as follows. Sub-directories are only described below the src directory. +Within the MPAS repository, code is laid out as follows. Sub-directories are +only described below the src directory. MPAS-Model ├── src @@ -71,4 +82,6 @@ Within the MPAS repository, code is laid out as follows. Sub-directories are onl ├── testing_and_setup -- Tools for setting up configurations and test cases (Shared) └── default_inputs -- Copies of default stream and namelists files (Shared) -Model cores are typically developed independently. For information about building and running a particular core, please refer to that core's user's guide. +Model cores are typically developed independently. For information about +building and running a particular core, please refer to that core's user's +guide. diff --git a/cmake/Functions/MPAS_Functions.cmake b/cmake/Functions/MPAS_Functions.cmake new file mode 100644 index 000000000..fe7655622 --- /dev/null +++ b/cmake/Functions/MPAS_Functions.cmake @@ -0,0 +1,264 @@ +## +# get_mpas_version( ) +# +# Extracts the MPAS-Model project's version from the README.md file. +# The extracted version is a string following the format "X.Y.Z", where +# "X", "Y", and "Z" correspond to the major, minor, and patch versions +# respectively. +# +# Precondition: +# * README.md file needs to be in the current source directory. +# * README.md file should contain the project version formatted +# as "MPAS-vX.Y.Z". +# +# Postcondition: +# * If a match is found, will contain the version string, +# else it will be empty. +# +# Args: +# - The name of the variable that will hold the extracted version +# string. +# +# Example usage: +# get_mpas_version(MPAS_VERSION) +# message("MPAS Version: ${MPAS_VERSION}") +## +function(get_mpas_version mpas_version) + file(READ "${CMAKE_CURRENT_SOURCE_DIR}/README.md" readme_contents) + string(REGEX MATCH "MPAS-v([0-9]+\\.[0-9]+\\.[0-9]+)" _ ${readme_contents}) + set(${mpas_version} ${CMAKE_MATCH_1} PARENT_SCOPE) +endfunction() + +## +# get_git_version( ) +# Extracts the current Git version of the project. +# will contain the Git version string. +# Example usage: +# get_git_version(GIT_VERSION) +# message("Git Version: ${GIT_VERSION}") +## + + +function(get_git_version git_version) + execute_process( + COMMAND git describe --tags --always + WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR} + RESULT_VARIABLE RESULT + OUTPUT_VARIABLE GIT_VERSION + OUTPUT_STRIP_TRAILING_WHITESPACE + ) + + if(NOT RESULT EQUAL 0) + message(WARNING "Failed to get Git version!") + endif() + set(${git_version} ${GIT_VERSION} PARENT_SCOPE + ) +endfunction() + + +## +# mpas_fortran_target( ) +# +# Fortran configuration and options common to all MPAS Fortran targets +# +# * Installs common Fortan modules to a per-compiler-version directory +# * General Fortran formatting and configuration options +# * Per-compiler configuration and options +# * MPAS_DOUBLE_PRECISION related flags +# +# Args: +# - The name of the target to prepare +# + +function(mpas_fortran_target target) + # Fortran modules include path + set_target_properties(${target} PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/${MPAS_MODULE_DIR}) + target_include_directories(${target} INTERFACE $ + $) + #Relocatable, portable, runtime dynamic linking + set_target_properties(${target} PROPERTIES INSTALL_RPATH "\$ORIGIN/../${CMAKE_INSTALL_LIBDIR}") + + # Global Fortran configuration + set_target_properties(${target} PROPERTIES Fortran_FORMAT FREE) + if(MPAS_USE_PIO) + set(MPAS_FORTRAN_TARGET_COMPILE_DEFINITIONS + USE_PIO2=1 + ) + else() + set(MPAS_FORTRAN_TARGET_COMPILE_DEFINITIONS + MPAS_SMIOL_SUPPORT=1 + ) + endif() + list(APPEND MPAS_FORTRAN_TARGET_COMPILE_DEFINITIONS _MPI=1) + # Enable OpenMP support + if(MPAS_OPENMP) + target_link_libraries(${target} PUBLIC OpenMP::OpenMP_Fortran) + endif() + + # Compiler-specific options and flags + if(CMAKE_Fortran_COMPILER_ID MATCHES GNU) + list(APPEND MPAS_FORTRAN_TARGET_COMPILE_OPTIONS_PRIVATE + $<$:-ffree-line-length-none> + ) + list(APPEND MPAS_FORTRAN_TARGET_COMPILE_OPTIONS_PUBLIC + $<$:-fconvert=big-endian> + ) + + if(CMAKE_Fortran_COMPILER_VERSION VERSION_GREATER_EQUAL 10) + list(APPEND MPAS_FORTRAN_TARGET_COMPILE_OPTIONS_PRIVATE + $<$:-fallow-argument-mismatch> + $<$:-fallow-invalid-boz> + ) + endif() + if(MPAS_DOUBLE_PRECISION) + list(APPEND MPAS_FORTRAN_TARGET_COMPILE_OPTIONS_PRIVATE + $<$:-fdefault-real-8> $<$:-fdefault-double-8> + ) + else() + list(APPEND MPAS_FORTRAN_TARGET_COMPILE_DEFINITIONS SINGLE_PRECISION) + endif() + elseif(CMAKE_Fortran_COMPILER_ID MATCHES Intel) + list(APPEND MPAS_FORTRAN_TARGET_COMPILE_OPTIONS_PUBLIC + $<$:-align array64byte> + $<$:-convert big_endian> + ) + if(MPAS_DOUBLE_PRECISION) + list(APPEND MPAS_FORTRAN_TARGET_COMPILE_OPTIONS_PRIVATE + $<$:-real-size 64> + ) + else() + list(APPEND MPAS_FORTRAN_TARGET_COMPILE_DEFINITIONS SINGLE_PRECISION) + endif() + elseif(CMAKE_Fortran_COMPILER_ID MATCHES NVHPC) + + list(APPEND MPAS_FORTRAN_TARGET_COMPILE_DEFINITIONS + $<$:-DCPRPGI -DMPAS_NAMELIST_SUFFIX=atmosphere -DMPAS_EXE_NAME=atmosphere_model> + $<$:-DMPAS_OPENACC -DSINGLE_PRECISION -DMPAS_BUILD_TARGET=nvhpc> + ) + list(APPEND MPAS_FORTRAN_TARGET_COMPILE_OPTIONS_PRIVATE + $<$: -Mnofma -acc -gpu=math_uniform,cc70,cc80 -Minfo=accel -byteswapio> + ) + message(VERBOSE "${target} options: ${MPAS_FORTRAN_TARGET_COMPILE_OPTIONS_PRIVATE}") + message(VERBOSE "${target} defines: ${MPAS_FORTRAN_TARGET_COMPILE_DEFINITIONS}") + endif() + target_compile_definitions(${target} PRIVATE ${MPAS_FORTRAN_TARGET_COMPILE_DEFINITIONS}) + target_compile_options(${target} PRIVATE ${MPAS_FORTRAN_TARGET_COMPILE_OPTIONS_PRIVATE}) + target_compile_options(${target} PUBLIC ${MPAS_FORTRAN_TARGET_COMPILE_OPTIONS_PUBLIC}) +endfunction() + + +# mpas_core_target(CORE TARGET INCLUDE ) +# +# Common configuration and properties for `MPAS::core::` targets. +# * Calls mpas_fortran_target() for common Fortran target configuration. +# * Installs Fortran modules to a per-core directory and adds target include directories +# appropriate for build and install trees. +# * XML Processing, parsing and generation of includes, namelists and streams +# * Each core uses a core-specific parser executable +# * Links to MPAS::framework and MPAS::operators +# * Exports MPAS::core:: target alias for use by external dependencies +# * Installs core libraries modules and generated files. +# +# Args: +# CORE - Name of core +# TARGET - Name of core_target (without namespace) +# INCLUDES - List of generated include files +# +function(mpas_core_target) + cmake_parse_arguments(ARG "" "CORE;TARGET" "INCLUDES" ${ARGN}) + + mpas_fortran_target(${ARG_TARGET}) + + set_property(TARGET ${ARG_TARGET} APPEND PROPERTY SOURCES ${MPAS_SUBDRIVER_SRC}) + + string(TOUPPER "${ARG_TARGET}" TARGET) + set_target_properties(${ARG_TARGET} PROPERTIES OUTPUT_NAME mpas_${ARG_CORE}) + + #Fortran modules output location + set(CORE_MODULE_DIR ${MPAS_MODULE_DIR}/${ARG_TARGET}) + set_target_properties(${ARG_TARGET} PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/${CORE_MODULE_DIR}) + target_include_directories(${ARG_TARGET} INTERFACE $ + $) + + #MPAS Specific option + target_compile_definitions(${ARG_TARGET} PRIVATE ${TARGET}=1) + + #Generated includes are included from either ./inc/ or ./ so we create a symlink in the build directory + #To handle the inc/ variety (sw, test, seaice) uniformly with the ./ variety (atmosphere, init_atmosphere) + add_custom_target(${ARG_CORE}_include_link ALL + COMMAND ${CMAKE_COMMAND} -E create_symlink ${CMAKE_CURRENT_BINARY_DIR} ${CMAKE_CURRENT_BINARY_DIR}/inc) + add_dependencies(${ARG_TARGET} ${ARG_CORE}_include_link) + target_include_directories(${ARG_TARGET} PUBLIC $) + + #Core-independent library dependencies + target_link_libraries(${ARG_TARGET} PUBLIC ${PROJECT_NAME}::operators ${PROJECT_NAME}::framework) + + #Define alias for external use + add_library(${PROJECT_NAME}::core::${ARG_CORE} ALIAS ${ARG_TARGET}) + + #Create main executable + add_executable(mpas_${ARG_CORE} ${MPAS_MAIN_SRC}) + mpas_fortran_target(mpas_${ARG_CORE}) + target_link_libraries(mpas_${ARG_CORE} PUBLIC ${PROJECT_NAME}::core::${ARG_CORE}) + + #Per-core generated output and tables directory location + set(CORE_DATADIR ${CMAKE_BINARY_DIR}/${PROJECT_NAME}/${ARG_TARGET}) + file(MAKE_DIRECTORY ${CORE_DATADIR}) + + #Process registry and generate includes, namelists, and streams + get_git_version(git_version) + string(TOUPPER ${ARG_CORE} ARG_CORE_UPPER) + set(CPP_EXTRA_FLAGS ${CPP_EXTRA_FLAGS} -DCORE_${ARG_CORE_UPPER} -DMPAS_NAMELIST_SUFFIX=${ARG_CORE} -DMPAS_EXE_NAME=mpas_${ARG_CORE} -DMPAS_GIT_VERSION=${git_version} -DMPAS_BUILD_TARGET=${CMAKE_Fortran_COMPILER_ID}) + message("CPP_EXTRA_FLAGS: ${CPP_EXTRA_FLAGS}") + if (${DO_PHYSICS}) + set(CPP_EXTRA_FLAGS ${CPP_EXTRA_FLAGS} -DDO_PHYSICS) + endif() + +add_custom_command(OUTPUT Registry_processed.xml + COMMAND ${CPP_EXECUTABLE} -E -P ${CPP_EXTRA_FLAGS} ${CMAKE_CURRENT_SOURCE_DIR}/Registry.xml > Registry_processed.xml + COMMENT "CORE ${ARG_CORE}: Pre-Process Registry" + DEPENDS Registry.xml) + add_custom_command(OUTPUT ${ARG_INCLUDES} + COMMAND mpas_parse_${ARG_CORE} Registry_processed.xml ${CPP_EXTRA_FLAGS} + COMMENT "CORE ${ARG_CORE}: Parse Registry" + DEPENDS mpas_parse_${ARG_CORE} Registry_processed.xml) + add_custom_command(OUTPUT namelist.${ARG_CORE} + WORKING_DIRECTORY ${CORE_DATADIR} + COMMAND mpas_namelist_gen ${CMAKE_CURRENT_BINARY_DIR}/Registry_processed.xml namelist.${ARG_CORE} in_defaults=true + COMMENT "CORE ${ARG_CORE}: Generate Namelist" + DEPENDS mpas_namelist_gen Registry_processed.xml) + add_custom_command(OUTPUT streams.${ARG_CORE} + WORKING_DIRECTORY ${CORE_DATADIR} + COMMAND mpas_streams_gen ${CMAKE_CURRENT_BINARY_DIR}/Registry_processed.xml streams.${ARG_CORE} stream_list.${ARG_CORE}. listed + COMMENT "CORE ${ARG_CORE}: Generate Streams" + DEPENDS mpas_streams_gen Registry_processed.xml) + add_custom_target(gen_${ARG_CORE} DEPENDS ${ARG_INCLUDES} namelist.${ARG_CORE} streams.${ARG_CORE}) + add_dependencies(${ARG_TARGET} gen_${ARG_CORE}) + + #Install data and target library and executable + install(DIRECTORY ${CORE_DATADIR}/ DESTINATION ${CMAKE_INSTALL_DATADIR}/${PROJECT_NAME}/${ARG_TARGET} + FILES_MATCHING PATTERN "namelist.*" PATTERN "streams.*" PATTERN "stream_list.*" ) + install(TARGETS ${ARG_TARGET} EXPORT ${PROJECT_NAME}ExportsCore + ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR} + LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR}) + install(TARGETS mpas_${ARG_CORE} + RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR}) +endfunction() + +## +# set_MPAS_DEBUG_flag( ) +# +# Sets the MPAS_DEBUG compile definition for a given target when the build type is Debug. +# +# Args: +# - The target for which the compile definition will be set +# +# Usage example: +# set_MPAS_DEBUG_flag(TARGET) +# This will define MPAS_DEBUG for the target TARGET during a Debug build +## +function(set_MPAS_DEBUG_flag target) + if(CMAKE_BUILD_TYPE MATCHES Debug) + target_compile_definitions(${target} PRIVATE MPAS_DEBUG) + endif() +endfunction() diff --git a/cmake/Modules/FindGPTL.cmake b/cmake/Modules/FindGPTL.cmake new file mode 100644 index 000000000..8e8014c33 --- /dev/null +++ b/cmake/Modules/FindGPTL.cmake @@ -0,0 +1,175 @@ +# FindGPTL.cmake +# +# Copyright UCAR 2020 +# +# Find the GPTL: General Purpose Timing Library (https://jmrosinski.github.io/GPTL/) +# +# This find module sets the following variables and targets: +# +# Variables: +# GPTL_FOUND - True if GPTL was found +# GPTL_VERSION_STRING - Version of installed GPTL +# GPTL_BIN_DIR - GPTL binary directory +# GPTL_HAS_PKG_CONFIG - GPTL was found with installed `gptl.pc` and pkg-config. This indicates full support +# for compiler and linker flags as exported by GPTL. +# Targets: +# GPTL::GPTL - Imported interface target to pass to target_link_libraries() +# +# NOTE: This find modules uses `pkg-config` to locate GPTL and glean the appropriate flags, directories, +# and link dependency ordering. For this to work, both a `pkg-config` executable and a `gptl.pc` +# config file need to be found. +# * To find the `pkg-config` executable, ensure it is on your PATH. +# * For non-standard locations the official CMake FindPkgConfig uses Cmake variable `PKG_CONFIG_EXECUTABLE` +# or environment variable `PKG_CONFIG`. See: https://cmake.org/cmake/help/latest/module/FindPkgConfig.html +# * To find `gptl.pc` ensure it is on the (colon-separated) directories listed in standard pkg-config +# environment variable `PKG_CONFIG_PATH`. +# * See: https://linux.die.net/man/1/pkg-config +# * A working GPTL pkg-config install can be confirmed on the command line, e.g., +# ``` +# $ pkg-config --modversion gptl +# 8.0.2 +# ``` +# To set a non-standard location for GPTL, ensure the correct `gptl.pc` pkg config file is found first +# on the environment's `PKG_CONFIG_PATH`. This can be checked with the pkg-config executable, e.g., +# ``` +# $ pkg-config --variable=prefix gptl +# /usr/local +# ``` +# Only when pkg-config is not supported or available, GPTL will be searched by the standard CMake search procedures. +# Set environment or CMake variable GPTL_ROOT to control this search. The GPTL_ROOT variable will have no effect +# if GPTL_HAS_PKG_CONFIG=True. +# + +find_package(PkgConfig QUIET) +if(PKG_CONFIG_FOUND) + message(DEBUG "[FindGPTL] Using PKG_CONFIG_EXECUTABLE:${PKG_CONFIG_EXECUTABLE}") +endif() + +#Helper: +#check_pkg_config(ret_var pcname pcflags...) +# Check if pcname is known to pkg-config +# Returns: +# Boolean: true if ${pcname}.pc file is found by pkg-config). +# Args: +# ret_var: return variable name. +# pcname: pkg-config name to look for (.pc file) +function(check_pkg_config ret_var pcname) + if(NOT PKG_CONFIG_FOUND OR NOT EXISTS ${PKG_CONFIG_EXECUTABLE}) + set(${ret_var} False PARENT_SCOPE) + else() + execute_process(COMMAND ${PKG_CONFIG_EXECUTABLE} --exists ${pcname} RESULT_VARIABLE _found) + if(_found EQUAL 0) + set(${ret_var} True PARENT_SCOPE) + else() + set(${ret_var} False PARENT_SCOPE) + endif() + endif() +endfunction() + +#Helper: +#get_pkg_config(ret_var pcname pcflags...) +# Get the output of pkg-config +# Args: +# ret_var: return variable name +# pcname: pkg-config name to look for (.pc file) +# pcflags: pkg-config flags to pass +function(get_pkg_config ret_var pcname pcflags) + execute_process(COMMAND ${PKG_CONFIG_EXECUTABLE} ${ARGN} ${pcname} ${pcflags} OUTPUT_VARIABLE _out RESULT_VARIABLE _ret OUTPUT_STRIP_TRAILING_WHITESPACE) + if(_ret EQUAL 0) + separate_arguments(_out) + set(${ret_var} ${_out} PARENT_SCOPE) + else() + set(${ret_var} "" PARENT_SCOPE) + endif() +endfunction() + +check_pkg_config(GPTL_HAS_PKG_CONFIG gptl) +if(GPTL_HAS_PKG_CONFIG) + #Use pkg-config to find the prefix, flags, directories, executables, and libraries + get_pkg_config(GPTL_VERSION_STRING gptl --modversion) + get_pkg_config(GPTL_PREFIX gptl --variable=prefix) + get_pkg_config(GPTL_INCLUDE_DIR gptl --cflags-only-I) + if(EXISTS GPTL_INCLUDE_DIR) + string(REGEX REPLACE "-I([^ ]+)" "\\1;" GPTL_INCLUDE_DIR ${GPTL_INCLUDE_DIR}) #Remove -I + else() + find_path(GPTL_INCLUDE_DIR NAMES gptl.h PATH_SUFFIXES include include/gptl PATHS ${GPTL_PREFIX} NO_DEFAULT_PATH) + endif() + find_path(GPTL_MODULE_DIR NAMES gptl.mod PATH_SUFFIXES include include/gptl module module/gptl PATHS ${GPTL_PREFIX} NO_DEFAULT_PATH) + get_pkg_config(GPTL_COMPILE_OPTIONS gptl --cflags-only-other) + get_pkg_config(GPTL_LINK_LIBRARIES gptl --libs-only-l) + get_pkg_config(GPTL_LINK_DIRECTORIES gptl --libs-only-L) + if(GPTL_LINK_DIRECTORIES) + string(REGEX REPLACE "-L([^ ]+)" "\\1;" GPTL_LINK_DIRECTORIES ${GPTL_LINK_DIRECTORIES}) #Remove -L + endif() + get_pkg_config(GPTL_LINK_OPTIONS gptl --libs-only-other) + find_library(GPTL_LIBRARY NAMES gptl PATH_SUFFIXES lib lib64 PATHS ${GPTL_PREFIX} NO_DEFAULT_PATH) + find_path(GPTL_BIN_DIR NAMES gptl_avail PATH_SUFFIXES bin PATHS ${GPTL_PREFIX} NO_DEFAULT_PATH) +else() + #Attempt to find GPTL without pkg-config as last resort. + message(WARNING "\ +FindGPTL: The `pkg-config` executable was not found. Ensure it is on your path or set \ +environment variable PKG_CONFIG to your pkg-config executable. \ +Attempting to find GPTL without pkg-config support may cause some required compiler and linker options to be unset.") + + find_path(GPTL_INCLUDE_DIR NAMES gptl.h PATH_SUFFIXES include include/gptl) + find_path(GPTL_MODULE_DIR NAMES gptl.mod PATH_SUFFIXES include include/gptl module module/gptl) + find_library(GPTL_LIBRARY NAMES gptl PATH_SUFFIXES lib lib64) + find_path(GPTL_BIN_DIR NAMES gptl_avail PATH_SUFFIXES bin) +endif() + +#Hide non-documented cache variables reserved for internal/advanced usage +mark_as_advanced( GPTL_INCLUDE_DIR + GPTL_MODULE_DIR + GPTL_LIBRARY ) + +#Debugging output +message(DEBUG "[FindGPTL] GPTL_FOUND: ${GPTL_FOUND}") +message(DEBUG "[FindGPTL] GPTL_VERSION_STRING: ${GPTL_VERSION_STRING}") +message(DEBUG "[FindGPTL] GPTL_HAS_PKG_CONFIG: ${GPTL_HAS_PKG_CONFIG}") +message(DEBUG "[FindGPTL] GPTL_PREFIX: ${GPTL_PREFIX}") +message(DEBUG "[FindGPTL] GPTL_BIN_DIR: ${GPTL_BIN_DIR}") +message(DEBUG "[FindGPTL] GPTL_INCLUDE_DIR: ${GPTL_INCLUDE_DIR}") +message(DEBUG "[FindGPTL] GPTL_MODULE_DIR: ${GPTL_MODULE_DIR}") +message(DEBUG "[FindGPTL] GPTL_LIBRARY: ${GPTL_LIBRARY}") +message(DEBUG "[FindGPTL] GPTL_LINK_LIBRARIES: ${GPTL_LINK_LIBRARIES}") +message(DEBUG "[FindGPTL] GPTL_LINK_DIRECTORIES: ${GPTL_LINK_DIRECTORIES}") +message(DEBUG "[FindGPTL] GPTL_LINK_OPTIONS: ${GPTL_LINK_OPTIONS}") + +#Check package has been found correctly +include(FindPackageHandleStandardArgs) +find_package_handle_standard_args( + GPTL + REQUIRED_VARS + GPTL_LIBRARY + GPTL_INCLUDE_DIR + GPTL_MODULE_DIR + GPTL_BIN_DIR + VERSION_VAR + GPTL_VERSION_STRING +) + +#Create GPTL::GPTL imported interface target +if(GPTL_FOUND AND NOT TARGET GPTL::GPTL) + add_library(GPTL::GPTL INTERFACE IMPORTED) + set_property(TARGET GPTL::GPTL PROPERTY INTERFACE_INCLUDE_DIRECTORIES ${GPTL_INCLUDE_DIR}) + if(GPTL_MODULE_DIR) + set_property(TARGET GPTL::GPTL APPEND PROPERTY INTERFACE_INCLUDE_DIRECTORIES ${GPTL_MODULE_DIR}) + endif() + if(GPTL_COMPILE_OPTIONS) + set_property(TARGET GPTL::GPTL PROPERTY INTERFACE_COMPILE_OPTIONS ${GPTL_COMPILE_OPTIONS}) + endif() + if(GPTL_LINK_DIRECTORIES) + set_property(TARGET GPTL::GPTL PROPERTY INTERFACE_LINK_DIRECTORIES ${GPTL_LINK_DIRECTORIES}) + endif() + if(GPTL_LINK_OPTIONS) + set_property(TARGET GPTL::GPTL PROPERTY INTERFACE_LINK_OPTIONS ${GPTL_LINK_OPTIONS}) + endif() + if(GPTL_LINK_LIBRARIES) + set_property(TARGET GPTL::GPTL PROPERTY INTERFACE_LINK_LIBRARIES ${GPTL_LINK_LIBRARIES}) + else() + set_property(TARGET GPTL::GPTL PROPERTY INTERFACE_LINK_LIBRARIES ${GPTL_LIBRARY}) + get_filename_component(_lib_dir ${GPTL_LIBRARY} DIRECTORY) + set_property(TARGET GPTL::GPTL APPEND PROPERTY INTERFACE_LINK_DIRECTORIES ${_lib_dir}) + unset(_lib_dir) + endif() +endif() diff --git a/cmake/Modules/FindNetCDF.cmake b/cmake/Modules/FindNetCDF.cmake new file mode 100644 index 000000000..f2fc6ac51 --- /dev/null +++ b/cmake/Modules/FindNetCDF.cmake @@ -0,0 +1,343 @@ +# (C) Copyright 2017-2020 UCAR +# +# This software is licensed under the terms of the Apache Licence Version 2.0 +# which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +# +# (C) Copyright 2011- ECMWF. +# +# This software is licensed under the terms of the Apache Licence Version 2.0 +# which can be obtained at http://www.apache.org/licenses/LICENSE-2.0. +# In applying this licence, ECMWF does not waive the privileges and immunities +# granted to it by virtue of its status as an intergovernmental organisation nor +# does it submit to any jurisdiction. +# +# Try to find NetCDF includes and library. +# Supports static and shared libaries and allows each component to be found in sepearte prefixes. +# +# This module defines +# +# - NetCDF_FOUND - System has NetCDF +# - NetCDF_INCLUDE_DIRS - the NetCDF include directories +# - NetCDF_VERSION - the version of NetCDF +# - NetCDF_CONFIG_EXECUTABLE - the netcdf-config executable if found +# - NetCDF_PARALLEL - Boolean True if NetCDF4 has parallel IO support via hdf5 and/or pnetcdf +# - NetCDF_HAS_PNETCDF - Boolean True if NetCDF4 has pnetcdf support +# +# Deprecated Defines +# - NetCDF_LIBRARIES - [Deprecated] Use NetCDF::NetCDF_ targets instead. +# +# +# Following components are available: +# +# - C - C interface to NetCDF (netcdf) +# - CXX - CXX4 interface to NetCDF (netcdf_c++4) +# - Fortran - Fortran interface to NetCDF (netcdff) +# +# For each component the following are defined: +# +# - NetCDF__FOUND - whether the component is found +# - NetCDF__LIBRARIES - the libraries for the component +# - NetCDF__LIBRARY_SHARED - Boolean is true if libraries for component are shared +# - NetCDF__INCLUDE_DIRS - the include directories for specified component +# - NetCDF::NetCDF_ - target of component to be used with target_link_libraries() +# +# The following paths will be searched in order if set in CMake (first priority) or environment (second priority) +# +# - NetCDF_ROOT - root of NetCDF installation +# - NetCDF_PATH - root of NetCDF installation +# +# The search process begins with locating NetCDF Include headers. If these are in a non-standard location, +# set one of the following CMake or environment variables to point to the location: +# +# - NetCDF_INCLUDE_DIR or NetCDF_${comp}_INCLUDE_DIR +# - NetCDF_INCLUDE_DIRS or NetCDF_${comp}_INCLUDE_DIR +# +# Notes: +# +# - Use "NetCDF::NetCDF_" targets only. NetCDF_LIBRARIES exists for backwards compatibility and should not be used. +# - These targets have all the knowledge of include directories and library search directories, and a single +# call to target_link_libraries will provide all these transitive properties to your target. Normally all that is +# needed to build and link against NetCDF is, e.g.: +# target_link_libraries(my_c_tgt PUBLIC NetCDF::NetCDF_C) +# - "NetCDF" is always the preferred naming for this package, its targets, variables, and environment variables +# - For compatibility, some variables are also set/checked using alternate names NetCDF4, NETCDF, or NETCDF4 +# - Environments relying on these older environment variable names should move to using a "NetCDF_ROOT" environment variable +# - Preferred component capitalization follows the CMake LANGUAGES variables: i.e., C, Fortran, CXX +# - For compatibility, alternate capitalizations are supported but should not be used. +# - If no components are defined, all components will be searched +# + +list( APPEND _possible_components C CXX Fortran ) + +## Include names for each component +set( NetCDF_C_INCLUDE_NAME netcdf.h ) +set( NetCDF_CXX_INCLUDE_NAME netcdf ) +set( NetCDF_Fortran_INCLUDE_NAME netcdf.mod ) + +## Library names for each component +set( NetCDF_C_LIBRARY_NAME netcdf ) +set( NetCDF_CXX_LIBRARY_NAME netcdf_c++4 ) +set( NetCDF_Fortran_LIBRARY_NAME netcdff ) + +## Enumerate search components +foreach( _comp ${_possible_components} ) + string( TOUPPER "${_comp}" _COMP ) + set( _arg_${_COMP} ${_comp} ) + set( _name_${_COMP} ${_comp} ) +endforeach() + +set( _search_components C) +foreach( _comp ${${CMAKE_FIND_PACKAGE_NAME}_FIND_COMPONENTS} ) + string( TOUPPER "${_comp}" _COMP ) + set( _arg_${_COMP} ${_comp} ) + list( APPEND _search_components ${_name_${_COMP}} ) + if( NOT _name_${_COMP} ) + message(SEND_ERROR "Find${CMAKE_FIND_PACKAGE_NAME}: COMPONENT ${_comp} is not a valid component. Valid components: ${_possible_components}" ) + endif() +endforeach() +list( REMOVE_DUPLICATES _search_components ) + +## Search hints for finding include directories and libraries +foreach( _comp IN ITEMS "_" "_C_" "_Fortran_" "_CXX_" ) + foreach( _name IN ITEMS NetCDF4 NetCDF NETCDF4 NETCDF ) + foreach( _var IN ITEMS ROOT PATH ) + list(APPEND _search_hints ${${_name}${_comp}${_var}} $ENV{${_name}${_comp}${_var}} ) + list(APPEND _include_search_hints + ${${_name}${_comp}INCLUDE_DIR} $ENV{${_name}${_comp}INCLUDE_DIR} + ${${_name}${_comp}INCLUDE_DIRS} $ENV{${_name}${_comp}INCLUDE_DIRS} ) + endforeach() + endforeach() +endforeach() +#Old-school HPC module env variable names +foreach( _name IN ITEMS NetCDF4 NetCDF NETCDF4 NETCDF ) + foreach( _comp IN ITEMS "_C" "_Fortran" "_CXX" ) + list(APPEND _search_hints ${${_name}} $ENV{${_name}}) + list(APPEND _search_hints ${${_name}${_comp}} $ENV{${_name}${_comp}}) + endforeach() +endforeach() + +## Find headers for each component +set(NetCDF_INCLUDE_DIRS) +set(_new_search_components) +foreach( _comp IN LISTS _search_components ) + if(NOT ${PROJECT_NAME}_NetCDF_${_comp}_FOUND) + list(APPEND _new_search_components ${_comp}) + endif() + find_file(NetCDF_${_comp}_INCLUDE_FILE + NAMES ${NetCDF_${_comp}_INCLUDE_NAME} + DOC "NetCDF ${_comp} include directory" + HINTS ${_include_search_hints} ${_search_hints} + PATH_SUFFIXES include include/netcdf + ) + mark_as_advanced(NetCDF_${_comp}_INCLUDE_FILE) + message(DEBUG "NetCDF_${_comp}_INCLUDE_FILE: ${NetCDF_${_comp}_INCLUDE_FILE}") + if( NetCDF_${_comp}_INCLUDE_FILE ) + get_filename_component(NetCDF_${_comp}_INCLUDE_FILE ${NetCDF_${_comp}_INCLUDE_FILE} ABSOLUTE) + get_filename_component(NetCDF_${_comp}_INCLUDE_DIR ${NetCDF_${_comp}_INCLUDE_FILE} DIRECTORY) + list(APPEND NetCDF_INCLUDE_DIRS ${NetCDF_${_comp}_INCLUDE_DIR}) + endif() +endforeach() +if(NetCDF_INCLUDE_DIRS) + list(REMOVE_DUPLICATES NetCDF_INCLUDE_DIRS) +endif() +set(NetCDF_INCLUDE_DIRS "${NetCDF_INCLUDE_DIRS}" CACHE STRING "NetCDF Include directory paths" FORCE) + +## Find n*-config executables for search components +foreach( _comp IN LISTS _search_components ) + if( _comp MATCHES "^(C)$" ) + set(_conf "c") + elseif( _comp MATCHES "^(Fortran)$" ) + set(_conf "f") + elseif( _comp MATCHES "^(CXX)$" ) + set(_conf "cxx4") + endif() + find_program( NetCDF_${_comp}_CONFIG_EXECUTABLE + NAMES n${_conf}-config + HINTS ${NetCDF_INCLUDE_DIRS} ${_include_search_hints} ${_search_hints} + PATH_SUFFIXES bin Bin ../bin ../../bin + DOC "NetCDF n${_conf}-config helper" ) + message(DEBUG "NetCDF_${_comp}_CONFIG_EXECUTABLE: ${NetCDF_${_comp}_CONFIG_EXECUTABLE}") +endforeach() + +set(_C_libs_flag --libs) +set(_Fortran_libs_flag --flibs) +set(_CXX_libs_flag --libs) +set(_C_includes_flag --includedir) +set(_Fortran_includes_flag --includedir) +set(_CXX_includes_flag --includedir) +function(netcdf_config exec flag output_var) + set(${output_var} False PARENT_SCOPE) + if( exec ) + execute_process( COMMAND ${exec} ${flag} RESULT_VARIABLE _ret OUTPUT_VARIABLE _val) + if( _ret EQUAL 0 ) + string( STRIP ${_val} _val ) + set( ${output_var} ${_val} PARENT_SCOPE ) + endif() + endif() +endfunction() + +## Find libraries for each component +set( NetCDF_LIBRARIES ) +foreach( _comp IN LISTS _search_components ) + string( TOUPPER "${_comp}" _COMP ) + + find_library( NetCDF_${_comp}_LIBRARY + NAMES ${NetCDF_${_comp}_LIBRARY_NAME} + DOC "NetCDF ${_comp} library" + HINTS ${NetCDF_${_comp}_INCLUDE_DIRS} ${_search_hints} + PATH_SUFFIXES lib64 lib ../lib64 ../lib ../../lib64 ../../lib ) + mark_as_advanced( NetCDF_${_comp}_LIBRARY ) + get_filename_component(NetCDF_${_comp}_LIBRARY ${NetCDF_${_comp}_LIBRARY} ABSOLUTE) + set(NetCDF_${_comp}_LIBRARY ${NetCDF_${_comp}_LIBRARY} CACHE STRING "NetCDF ${_comp} library" FORCE) + message(DEBUG "NetCDF_${_comp}_LIBRARY: ${NetCDF_${_comp}_LIBRARY}") + + + if( NetCDF_${_comp}_LIBRARY ) + if( NetCDF_${_comp}_LIBRARY MATCHES ".a$" ) + set( NetCDF_${_comp}_LIBRARY_SHARED FALSE ) + set( _library_type STATIC) + else() + if( NOT ${NetCDF_${_comp}_LIBRARY} IN_LIST NetCDF_LIBRARIES ) + list( APPEND NetCDF_LIBRARIES ${NetCDF_${_comp}_LIBRARY} ) + message(DEBUG "Adding new netcdf library [${_comp}]: ${NetCDF_${_comp}_LIBRARY}") + endif() + set( NetCDF_${_comp}_LIBRARY_SHARED TRUE ) + set( _library_type SHARED) + endif() + endif() + + #Use nc-config to set per-component LIBRARIES variable if possible + netcdf_config( ${NetCDF_${_comp}_CONFIG_EXECUTABLE} ${_${_comp}_libs_flag} _val ) + if( _val ) + set( NetCDF_${_comp}_LIBRARIES ${_val} ) + if(NOT NetCDF_${_comp}_LIBRARY_SHARED AND NOT NetCDF_${_comp}_FOUND) #Static targets should use nc_config to get a proper link line with all necessary static targets. + list( APPEND NetCDF_LIBRARIES ${NetCDF_${_comp}_LIBRARIES} ) + endif() + else() + set( NetCDF_${_comp}_LIBRARIES ${NetCDF_${_comp}_LIBRARY} ) + if(NOT NetCDF_${_comp}_LIBRARY_SHARED) + message(SEND_ERROR "Unable to properly find NetCDF. Found static libraries at: ${NetCDF_${_comp}_LIBRARY} but could not run nc-config: ${NetCDF_CONFIG_EXECUTABLE}") + endif() + endif() + + #Use nc-config to set per-component INCLUDE_DIRS variable if possible + netcdf_config( ${NetCDF_${_comp}_CONFIG_EXECUTABLE} ${_${_comp}_includes_flag} _val ) + if( _val ) + string( REPLACE " " ";" _val ${_val} ) + set( NetCDF_${_comp}_INCLUDE_DIRS ${_val} ) + else() + set( NetCDF_${_comp}_INCLUDE_DIRS ${NetCDF_${_comp}_INCLUDE_DIR} ) + endif() + + if( NetCDF_${_comp}_LIBRARIES AND NetCDF_${_comp}_INCLUDE_DIRS ) + set( ${CMAKE_FIND_PACKAGE_NAME}_${_arg_${_COMP}}_FOUND TRUE ) + if (NOT TARGET NetCDF::NetCDF_${_comp}) + add_library(NetCDF::NetCDF_${_comp} ${_library_type} IMPORTED) + set_target_properties(NetCDF::NetCDF_${_comp} PROPERTIES + IMPORTED_LOCATION ${NetCDF_${_comp}_LIBRARY} + INTERFACE_INCLUDE_DIRECTORIES "${NetCDF_${_comp}_INCLUDE_DIRS}" + INTERFACE_LINK_LIBRARIES ${NetCDF_${_comp}_LIBRARIES} ) + endif() + endif() +endforeach() +set(NetCDF_LIBRARIES "${NetCDF_LIBRARIES}" CACHE STRING "NetCDF library targets" FORCE) + +## Find version via netcdf-config if possible +if (NetCDF_INCLUDE_DIRS) + if( NetCDF_C_CONFIG_EXECUTABLE ) + netcdf_config( ${NetCDF_C_CONFIG_EXECUTABLE} --version _vers ) + if( _vers ) + string(REGEX REPLACE ".* ((([0-9]+)\\.)+([0-9]+)).*" "\\1" NetCDF_VERSION "${_vers}" ) + endif() + else() + foreach( _dir IN LISTS NetCDF_INCLUDE_DIRS) + if( EXISTS "${_dir}/netcdf_meta.h" ) + file(STRINGS "${_dir}/netcdf_meta.h" _netcdf_version_lines + REGEX "#define[ \t]+NC_VERSION_(MAJOR|MINOR|PATCH|NOTE)") + string(REGEX REPLACE ".*NC_VERSION_MAJOR *\([0-9]*\).*" "\\1" _netcdf_version_major "${_netcdf_version_lines}") + string(REGEX REPLACE ".*NC_VERSION_MINOR *\([0-9]*\).*" "\\1" _netcdf_version_minor "${_netcdf_version_lines}") + string(REGEX REPLACE ".*NC_VERSION_PATCH *\([0-9]*\).*" "\\1" _netcdf_version_patch "${_netcdf_version_lines}") + string(REGEX REPLACE ".*NC_VERSION_NOTE *\"\([^\"]*\)\".*" "\\1" _netcdf_version_note "${_netcdf_version_lines}") + set(NetCDF_VERSION "${_netcdf_version_major}.${_netcdf_version_minor}.${_netcdf_version_patch}${_netcdf_version_note}") + unset(_netcdf_version_major) + unset(_netcdf_version_minor) + unset(_netcdf_version_patch) + unset(_netcdf_version_note) + unset(_netcdf_version_lines) + endif() + endforeach() + endif() +endif () + +## Detect additional package properties +netcdf_config(${NetCDF_C_CONFIG_EXECUTABLE} --has-parallel4 _val) +if( NOT _val MATCHES "^(yes|no)$" ) + netcdf_config(${NetCDF_C_CONFIG_EXECUTABLE} --has-parallel _val) +endif() +if( _val MATCHES "^(yes)$" ) + set(NetCDF_PARALLEL TRUE CACHE STRING "NetCDF has parallel IO capability via pnetcdf or hdf5." FORCE) +else() + set(NetCDF_PARALLEL FALSE CACHE STRING "NetCDF has no parallel IO capability." FORCE) +endif() + +## Finalize find_package +include(FindPackageHandleStandardArgs) + +if(NOT NetCDF_FOUND OR _new_search_components) + find_package_handle_standard_args( ${CMAKE_FIND_PACKAGE_NAME} + REQUIRED_VARS NetCDF_INCLUDE_DIRS NetCDF_LIBRARIES + VERSION_VAR NetCDF_VERSION + HANDLE_COMPONENTS ) +endif() + +foreach( _comp IN LISTS _search_components ) + if( NetCDF_${_comp}_FOUND ) + #Record found components to avoid duplication in NetCDF_LIBRARIES for static libraries + set(NetCDF_${_comp}_FOUND ${NetCDF_${_comp}_FOUND} CACHE BOOL "NetCDF ${_comp} Found" FORCE) + #Set a per-package, per-component found variable to communicate between multiple calls to find_package() + set(${PROJECT_NAME}_NetCDF_${_comp}_FOUND True) + endif() +endforeach() + +if( ${CMAKE_FIND_PACKAGE_NAME}_FOUND AND NOT ${CMAKE_FIND_PACKAGE_NAME}_FIND_QUIETLY AND _new_search_components) + message( STATUS "Find${CMAKE_FIND_PACKAGE_NAME} [${CMAKE_CURRENT_LIST_DIR}/FindNetCDF.cmake]:" ) + message( STATUS " - NetCDF_VERSION [${NetCDF_VERSION}]") + message( STATUS " - NetCDF_PARALLEL [${NetCDF_PARALLEL}]") + foreach( _comp IN LISTS _new_search_components ) + string( TOUPPER "${_comp}" _COMP ) + message( STATUS " - NetCDF_${_comp}_CONFIG_EXECUTABLE [${NetCDF_${_comp}_CONFIG_EXECUTABLE}]") + if( ${CMAKE_FIND_PACKAGE_NAME}_${_arg_${_COMP}}_FOUND ) + get_filename_component(_root ${NetCDF_${_comp}_INCLUDE_DIR}/.. ABSOLUTE) + if( NetCDF_${_comp}_LIBRARY_SHARED ) + message( STATUS " - NetCDF::NetCDF_${_comp} [SHARED] [Root: ${_root}] Lib: ${NetCDF_${_comp}_LIBRARY} ") + else() + message( STATUS " - NetCDF::NetCDF_${_comp} [STATIC] [Root: ${_root}] Lib: ${NetCDF_${_comp}_LIBRARY} ") + endif() + endif() + endforeach() +endif() + +foreach( _prefix NetCDF NetCDF4 NETCDF NETCDF4 ${CMAKE_FIND_PACKAGE_NAME} ) + set( ${_prefix}_INCLUDE_DIRS ${NetCDF_INCLUDE_DIRS} ) + set( ${_prefix}_LIBRARIES ${NetCDF_LIBRARIES}) + set( ${_prefix}_VERSION ${NetCDF_VERSION} ) + set( ${_prefix}_FOUND ${${CMAKE_FIND_PACKAGE_NAME}_FOUND} ) + set( ${_prefix}_CONFIG_EXECUTABLE ${NetCDF_CONFIG_EXECUTABLE} ) + set( ${_prefix}_PARALLEL ${NetCDF_PARALLEL} ) + + foreach( _comp ${_search_components} ) + string( TOUPPER "${_comp}" _COMP ) + set( _arg_comp ${_arg_${_COMP}} ) + set( ${_prefix}_${_comp}_FOUND ${${CMAKE_FIND_PACKAGE_NAME}_${_arg_comp}_FOUND} ) + set( ${_prefix}_${_COMP}_FOUND ${${CMAKE_FIND_PACKAGE_NAME}_${_arg_comp}_FOUND} ) + set( ${_prefix}_${_arg_comp}_FOUND ${${CMAKE_FIND_PACKAGE_NAME}_${_arg_comp}_FOUND} ) + + set( ${_prefix}_${_comp}_LIBRARIES ${NetCDF_${_comp}_LIBRARIES} ) + set( ${_prefix}_${_COMP}_LIBRARIES ${NetCDF_${_comp}_LIBRARIES} ) + set( ${_prefix}_${_arg_comp}_LIBRARIES ${NetCDF_${_comp}_LIBRARIES} ) + + set( ${_prefix}_${_comp}_INCLUDE_DIRS ${NetCDF_${_comp}_INCLUDE_DIRS} ) + set( ${_prefix}_${_COMP}_INCLUDE_DIRS ${NetCDF_${_comp}_INCLUDE_DIRS} ) + set( ${_prefix}_${_arg_comp}_INCLUDE_DIRS ${NetCDF_${_comp}_INCLUDE_DIRS} ) + endforeach() +endforeach() diff --git a/cmake/Modules/FindPIO.cmake b/cmake/Modules/FindPIO.cmake new file mode 100644 index 000000000..4988264c4 --- /dev/null +++ b/cmake/Modules/FindPIO.cmake @@ -0,0 +1,181 @@ +# FindPIO.cmake +# +# Copyright UCAR 2020 +# +# Find PIO: A high-level Parallel I/O Library for structured grid applications +# https://github.com/NCAR/ParallelIO +# +# Components available for query: +# C - Has C support +# Fortran - Has Fortran support +# STATIC - Has static targets for supported LANG +# SHARED - Has shared targets for supported LANG +# +# Variables provided: +# PIO_FOUND - True if PIO was found +# PIO_VERSION - Version of installed PIO +# +# Targets provided: +# PIO::PIO_Fortran_STATIC - Fortran interface target for static libraries +# PIO::PIO_Fortran_SHARED - Fortran interface target for shared libraries +# PIO::PIO_Fortran - Fortran interface target alias to shared libraries if available else static libraries +# PIO::PIO_C_STATIC - C interface target for static libraries +# PIO::PIO_C_SHARED - C interface target for shared libraries +# PIO::PIO_C - C interface target alias to shared libraries if available else static libraries +# +# To control finding of this package, set PIO_ROOT environment variable to the full path to the prefix +# under which PIO was installed (e.g., /usr/local) +# + +## Find libraries and paths, and determine found components +find_path(PIO_INCLUDE_DIR NAMES pio.h HINTS "${PIO_PREFIX}" PATH_SUFFIXES include include/pio) +if(PIO_INCLUDE_DIR) + string(REGEX REPLACE "/include(/.+)?" "" PIO_PREFIX ${PIO_INCLUDE_DIR}) + set(PIO_PREFIX ${PIO_PREFIX} CACHE STRING "") + find_path(PIO_MODULE_DIR NAMES pio.mod PATHS "${PIO_PREFIX}" + PATH_SUFFIXES include include/pio lib/pio/module module module/pio NO_DEFAULT_PATH) + if(APPLE) + set(_SHARED_LIB_EXT .dylib) + else() + set(_SHARED_LIB_EXT .so) + endif() + find_library(PIO_C_STATIC_LIB libpioc.a PATHS "${PIO_PREFIX}" PATH_SUFFIXES lib lib64 NO_DEFAULT_PATH) + find_library(PIO_C_SHARED_LIB libpioc${_SHARED_LIB_EXT} PATHS "${PIO_PREFIX}" PATH_SUFFIXES lib lib64 NO_DEFAULT_PATH) + find_library(PIO_Fortran_STATIC_LIB libpiof.a PATHS "${PIO_PREFIX}" PATH_SUFFIXES lib lib64 NO_DEFAULT_PATH) + find_library(PIO_Fortran_SHARED_LIB libpiof${_SHARED_LIB_EXT} PATHS "${PIO_PREFIX}" PATH_SUFFIXES lib lib64 NO_DEFAULT_PATH) + unset(_SHARED_LIB_EXT) + + #Check for Fortran components + if(PIO_MODULE_DIR) + if(PIO_Fortran_STATIC_LIB) + set(PIO_Fortran_STATIC_FOUND 1) + endif() + if(PIO_Fortran_SHARED_LIB) + set(PIO_Fortran_SHARED_FOUND 1) + endif() + if(PIO_Fortran_STATIC_FOUND OR PIO_Fortran_SHARED_FOUND) + set(PIO_Fortran_FOUND 1) + endif() + endif() + #Check for C components + if(PIO_C_STATIC_LIB) + set(PIO_C_STATIC_FOUND 1) + endif() + if(PIO_C_SHARED_LIB) + set(PIO_C_SHARED_FOUND 1) + endif() + if(PIO_C_STATIC_FOUND OR PIO_C_SHARED_FOUND) + set(PIO_C_FOUND 1) + endif() + if(PIO_C_SHARED_FOUND AND (NOT PIO_Fortran_FOUND OR PIO_Fortran_SHARED_FOUND)) + set(PIO_SHARED_FOUND 1) + endif() + if(PIO_C_STATIC_FOUND AND (NOT PIO_Fortran_FOUND OR PIO_Fortran_STATIC_FOUND)) + set(PIO_STATIC_FOUND 1) + endif() +endif() + +## Debugging output +message(DEBUG "[FindPIO] PIO_INCLUDE_DIR: ${PIO_INCLUDE_DIR}") +message(DEBUG "[FindPIO] PIO_PREFIX: ${PIO_PREFIX}") +message(DEBUG "[FindPIO] PIO_MODULE_DIR: ${PIO_MODULE_DIR}") +message(DEBUG "[FindPIO] PIO_Fortran_STATIC_LIB: ${PIO_Fortran_STATIC_LIB}") +message(DEBUG "[FindPIO] PIO_Fortran_SHARED_LIB: ${PIO_Fortran_SHARED_LIB}") +message(DEBUG "[FindPIO] PIO_C_STATIC_LIB: ${PIO_C_STATIC_LIB}") +message(DEBUG "[FindPIO] PIO_C_SHARED_LIB: ${PIO_C_SHARED_LIB}") +message(DEBUG "[FindPIO] PIO_Fortran_FOUND: ${PIO_Fortran_FOUND}") +message(DEBUG "[FindPIO] PIO_C_FOUND: ${PIO_C_FOUND}") +message(DEBUG "[FindPIO] PIO_SHARED_FOUND: ${PIO_SHARED_FOUND}") +message(DEBUG "[FindPIO] PIO_STATIC_FOUND: ${PIO_STATIC_FOUND}") + +## Check package has been found correctly +include(FindPackageHandleStandardArgs) +find_package_handle_standard_args( + PIO + REQUIRED_VARS + PIO_PREFIX + PIO_INCLUDE_DIR + HANDLE_COMPONENTS +) +message(DEBUG "[FindPIO] PIO_FOUND: ${PIO_FOUND}") + +## Create targets +set(_new_components) + + +# PIO::PIO_Fortran_STATIC imported interface target +if(PIO_Fortran_FOUND AND PIO_STATIC_FOUND AND NOT TARGET PIO::PIO_Fortran_STATIC) + add_library(PIO::PIO_Fortran_STATIC INTERFACE IMPORTED) + set_target_properties(PIO::PIO_Fortran_STATIC PROPERTIES + INTERFACE_INCLUDE_DIRECTORIES ${PIO_INCLUDE_DIR} + INTERFACE_LINK_LIBRARIES ${PIO_Fortran_STATIC_LIB} + IMPORTED_GLOBAL True ) + if(PIO_MODULE_DIR AND NOT PIO_MODULE_DIR STREQUAL PIO_INCLUDE_DIR ) + set_property(TARGET PIO::PIO_Fortran_STATIC APPEND PROPERTY INTERFACE_INCLUDE_DIRECTORIES ${PIO_MODULE_DIR}) + endif() + target_link_libraries(PIO::PIO_Fortran_STATIC INTERFACE NetCDF::NetCDF_C) + set(_new_components 1) +endif() + +# PIO::PIO_Fortran_SHARED imported interface target +if(PIO_Fortran_FOUND AND PIO_SHARED_FOUND AND NOT TARGET PIO::PIO_Fortran_SHARED) + add_library(PIO::PIO_Fortran_SHARED INTERFACE IMPORTED) + set_target_properties(PIO::PIO_Fortran_SHARED PROPERTIES + INTERFACE_INCLUDE_DIRECTORIES ${PIO_INCLUDE_DIR} + INTERFACE_LINK_LIBRARIES ${PIO_Fortran_SHARED_LIB} + IMPORTED_GLOBAL True ) + if(PIO_MODULE_DIR AND NOT PIO_MODULE_DIR STREQUAL PIO_INCLUDE_DIR ) + set_property(TARGET PIO::PIO_Fortran_SHARED APPEND PROPERTY INTERFACE_INCLUDE_DIRECTORIES ${PIO_MODULE_DIR}) + endif() + set(_new_components 1) +endif() + +# PIO::PIO_C_STATIC imported interface target +if(PIO_C_FOUND AND PIO_STATIC_FOUND AND NOT TARGET PIO::PIO_C_STATIC) + add_library(PIO::PIO_C_STATIC INTERFACE IMPORTED) + set_target_properties(PIO::PIO_C_STATIC PROPERTIES + INTERFACE_INCLUDE_DIRECTORIES ${PIO_INCLUDE_DIR} + INTERFACE_LINK_LIBRARIES ${PIO_C_STATIC_LIB} + IMPORTED_GLOBAL True ) + target_link_libraries(PIO::PIO_C_STATIC INTERFACE NetCDF::NetCDF_C) + set(_new_components 1) +endif() + +# PIO::PIO_C_SHARED imported interface target +if(PIO_C_FOUND AND PIO_SHARED_FOUND AND NOT TARGET PIO::PIO_C_SHARED) + add_library(PIO::PIO_C_SHARED INTERFACE IMPORTED) + set_target_properties(PIO::PIO_C_SHARED PROPERTIES + INTERFACE_INCLUDE_DIRECTORIES ${PIO_INCLUDE_DIR} + INTERFACE_LINK_LIBRARIES ${PIO_C_SHARED_LIB} + IMPORTED_GLOBAL True ) + set(_new_components 1) +endif() + +# PIO::PIO_Fortran - Shared libraries if available, static otherwise +if(TARGET PIO::PIO_Fortran_SHARED) + add_library(PIO::PIO_Fortran ALIAS PIO::PIO_Fortran_SHARED) +elseif(TARGET PIO::PIO_Fortran_STATIC) + add_library(PIO::PIO_Fortran ALIAS PIO::PIO_Fortran_STATIC) +endif() + +# PIO::PIO_C - Shared libraries if available, static otherwise +if(TARGET PIO::PIO_C_SHARED) + add_library(PIO::PIO_C ALIAS PIO::PIO_C_SHARED) +elseif(TARGET PIO::PIO_C_STATIC) + add_library(PIO::PIO_C ALIAS PIO::PIO_C_STATIC) +endif() + +## Print status +if(${CMAKE_FIND_PACKAGE_NAME}_FOUND AND NOT ${CMAKE_FIND_PACKAGE_NAME}_FIND_QUIETLY AND _new_components) + message( STATUS "Find${CMAKE_FIND_PACKAGE_NAME}:" ) + message( STATUS " - ${CMAKE_FIND_PACKAGE_NAME}_PREFIX [${${CMAKE_FIND_PACKAGE_NAME}_PREFIX}]") + set(_found_comps) + foreach( _comp IN ITEMS Fortran C STATIC SHARED ) + if( ${CMAKE_FIND_PACKAGE_NAME}_${_comp}_FOUND ) + list(APPEND _found_comps ${_comp}) + endif() + endforeach() + message( STATUS " - ${CMAKE_FIND_PACKAGE_NAME} Components Found: ${_found_comps}") + unset(_found_comps) +endif() +unset(_new_components) diff --git a/cmake/Modules/FindPnetCDF.cmake b/cmake/Modules/FindPnetCDF.cmake new file mode 100644 index 000000000..91a076ba5 --- /dev/null +++ b/cmake/Modules/FindPnetCDF.cmake @@ -0,0 +1,174 @@ +# FindPnetCDF.cmake +# +# Copyright UCAR 2020 +# +# Find PnetCDF: A Parallel I/O Library for NetCDF File Access +# https://parallel-netcdf.github.io/ +# +# Components available for query: +# C - Has C support +# CXX - Has CXX support +# Fortran - Has Fortran support +# NetCDF4 - Has NetCDF4 output support +# GPTL - Has profiling support with GPTL enabled +# Threads - Has thread safety enabled +# +# Variables provided: +# PnetCDF_FOUND - True if PnetCDFL was found +# PnetCDF_CONFIG_EXE - pnetcdf-config executable if found +# PnetCDF_VERSION - Version of installed PnetCDF +# PnetCDF_BIN_DIR - PnetCDF binary directory +# PnetCDF_DEBUG - True if PnetCDF is built in debug mode +# +# Targets provided: +# PnetCDF::PnetCDF_Fortran - Fortran interface target +# PnetCDF::PnetCDF_C - C interface target +# PnetCDF::PnetCDF_CXX - CXX interface target +# +# Functions provided: +# pnetcdf_get_config(ret_var flags) - Call `pnetcdf-config` with flags and set ret_var with output on execution success. +# +# +# This module requires the `pnetcdf-config` executable to detect the directories and compiler and linker flags +# necessary for the PnetCDF::PnetCDF target. To control where PnetCDF is found: +# * Option 1: Set an environment or cmake variable `PnetCDF_ROOT` to the install prefix for PnetCDF (e.g. /usr/local) +# * Option 2: Set an environment or cmake variable `PnetCDF_CONFIG_EXE` to the full path to the `pnetcdf-config` +# (e.g., /usr/local/bin/pnetcdf-config) +# + +find_program(PnetCDF_CONFIG_EXE NAMES pnetcdf-config PATH_SUFFIXES bin bin64 PATHS + $ENV{PnetCDF_CONFIG_EXE} ${PnetCDF_ROOT} $ENV{PnetCDF_ROOT} ${PNETCDF_ROOT} $ENV{PNETCDF_ROOT}) +message(DEBUG "[FindPnetCDF] Using PnetCDF_CONFIG_EXE:${PnetCDF_CONFIG_EXE}") + +# pnetcdf_get_config(ret_var flags...) +# Get the output of pnetcdf-config +# Args: +# ret_var: return variable name +# flags: flags to pass to pnetcdf-config +function(pnetcdf_get_config ret_var pcflags) + execute_process(COMMAND ${PnetCDF_CONFIG_EXE} ${pcflags} OUTPUT_VARIABLE _out RESULT_VARIABLE _ret OUTPUT_STRIP_TRAILING_WHITESPACE) + if(_ret EQUAL 0) + separate_arguments(_out) + set(${ret_var} ${_out} PARENT_SCOPE) + else() + set(${ret_var} "" PARENT_SCOPE) + endif() +endfunction() + +## Find libraries and paths, and determine found components +if(EXISTS ${PnetCDF_CONFIG_EXE}) + #Use pnetcdf-config to find the prefix, flags, directories, executables, and libraries + pnetcdf_get_config(PnetCDF_VERSION --version) + string(REGEX MATCH "([0-9.]+)" PnetCDF_VERSION "${PnetCDF_VERSION}") #Match only version actual number + + pnetcdf_get_config(PnetCDF_PREFIX --prefix) + pnetcdf_get_config(PnetCDF_CXX_FOUND --has-c++) + pnetcdf_get_config(PnetCDF_Fortran_FOUND --has-fortran) + pnetcdf_get_config(PnetCDF_NetCDF4_FOUND --netcdf4) + pnetcdf_get_config(PnetCDF_GPTL_FOUND --profiling) + pnetcdf_get_config(PnetCDF_Threads_FOUND --thread-safe) + pnetcdf_get_config(PnetCDF_DEBUG --debug) + pnetcdf_get_config(PnetCDF_INCLUDE_DIR --includedir) + pnetcdf_get_config(PnetCDF_LIB_DIR --libdir) + + #Translate boolean variables from pnetcdf-config enabled/disabled to True/False + foreach(_var IN ITEMS PnetCDF_CXX_FOUND PnetCDF_Fortran_FOUND PnetCDF_NetCDF4_FOUND PnetCDF_GPTL_FOUND PnetCDF_Threads_FOUND PnetCDF_DEBUG) + if( ${_var} MATCHES "(enabled)|([Yy][Ee][Ss])") + set(${_var} True) + else() + set(${_var} False) + endif() + endforeach() + + find_path(PnetCDF_MODULE_DIR NAMES pnetcdf.mod HINTS ${PnetCDF_PREFIX} ${PnetCDF_INCLUDE_DIR} + PATH_SUFFIXES include include/pnetcdf module module/pnetcdf lib/pnetcdf/module NO_DEFAULT_PATH) + if(PnetCDF_Fortran_FOUND AND NOT EXISTS ${PnetCDF_MODULE_DIR}) + message(WARNING "[PnetCDF] pnetcdf-config --has-fortran=yes, but could not find pnetcdf.mod. Set PnetCDF_MODULE_DIR to path containing pnetcdf.mod") + set(PnetCDF_Fortran_FOUND NO) + endif() + + if(PnetCDF_INCLUDE_DIR AND PnetCDF_LIB_DIR) + set(PnetCDF_C_FOUND True) + endif() + + find_path(PnetCDF_BIN_DIR NAMES pnetcdf-config PATH_SUFFIXES bin PATHS ${PnetCDF_PREFIX} NO_DEFAULT_PATH) + find_library(PnetCDF_LIBRARY NAMES pnetcdf PATH_SUFFIXES lib lib64 PATHS ${PnetCDF_PREFIX} NO_DEFAULT_PATH) + #Hide non-documented cache variables reserved for internal/advanced usage + mark_as_advanced( PnetCDF_MODULE_DIR PnetCDF_LIBRARY ) +endif() + +## Debugging output +message(DEBUG "[FindPnetCDF] PnetCDF_CONFIG_EXE: ${PnetCDF_CONFIG_EXE}") +message(DEBUG "[FindPnetCDF] PnetCDF_VERSION: ${PnetCDF_VERSION}") +message(DEBUG "[FindPnetCDF] PnetCDF_C_FOUND: ${PnetCDF_C_FOUND}") +message(DEBUG "[FindPnetCDF] PnetCDF_CXX_FOUND: ${PnetCDF_CXX_FOUND}") +message(DEBUG "[FindPnetCDF] PnetCDF_Fortran_FOUND: ${PnetCDF_Fortran_FOUND}") +message(DEBUG "[FindPnetCDF] PnetCDF_NetCDF4_FOUND: ${PnetCDF_NetCDF4_FOUND}") +message(DEBUG "[FindPnetCDF] PnetCDF_GPTL_FOUND: ${PnetCDF_GPTL_FOUND}") +message(DEBUG "[FindPnetCDF] PnetCDF_Threads_FOUND: ${PnetCDF_Threads_FOUND}") +message(DEBUG "[FindPnetCDF] PnetCDF_DEBUG: ${PnetCDF_DEBUG}") +message(DEBUG "[FindPnetCDF] PnetCDF_PREFIX: ${PnetCDF_PREFIX}") +message(DEBUG "[FindPnetCDF] PnetCDF_BIN_DIR: ${PnetCDF_BIN_DIR}") +message(DEBUG "[FindPnetCDF] PnetCDF_INCLUDE_DIR: ${PnetCDF_INCLUDE_DIR}") +message(DEBUG "[FindPnetCDF] PnetCDF_MODULE_DIR: ${PnetCDF_MODULE_DIR}") +message(DEBUG "[FindPnetCDF] PnetCDF_LIB_DIR: ${PnetCDF_LIB_DIR}") + +## Check package has been found correctly +include(FindPackageHandleStandardArgs) +find_package_handle_standard_args( + PnetCDF + REQUIRED_VARS + PnetCDF_CONFIG_EXE + PnetCDF_PREFIX + VERSION_VAR + PnetCDF_VERSION + HANDLE_COMPONENTS +) +message(DEBUG "[FindPnetCDF] PnetCDF_FOUND: ${PnetCDF_FOUND}") + +## Create targets +set(_new_components) + +# PnetCDF::PnetCDF_Fortran imported interface target +if(PnetCDF_Fortran_FOUND AND NOT TARGET PnetCDF::PnetCDF_Fortran) + add_library(PnetCDF::PnetCDF_Fortran INTERFACE IMPORTED) + set_target_properties(PnetCDF::PnetCDF_Fortran PROPERTIES INTERFACE_INCLUDE_DIRECTORIES ${PnetCDF_INCLUDE_DIR} + INTERFACE_LINK_DIRECTORIES ${PnetCDF_LIB_DIR}) + if(PnetCDF_MODULE_DIR AND NOT PnetCDF_MODULE_DIR STREQUAL PnetCDF_INCLUDE_DIR ) + set_property(TARGET PnetCDF::PnetCDF_Fortran APPEND PROPERTY INTERFACE_INCLUDE_DIRECTORIES ${PnetCDF_MODULE_DIR}) + endif() + set(_new_components 1) + target_link_libraries(PnetCDF::PnetCDF_Fortran INTERFACE -lpnetcdf) +endif() + +# PnetCDF::PnetCDF_C imported interface target +if(PnetCDF_C_FOUND AND NOT TARGET PnetCDF::PnetCDF_C) + add_library(PnetCDF::PnetCDF_C INTERFACE IMPORTED) + set_target_properties(PnetCDF::PnetCDF_C PROPERTIES INTERFACE_INCLUDE_DIRECTORIES ${PnetCDF_INCLUDE_DIR} + INTERFACE_LINK_DIRECTORIES ${PnetCDF_LIB_DIR}) + set(_new_components 1) +endif() + +# PnetCDF::PnetCDF_CXX imported interface target +if(PnetCDF_CXX_FOUND AND NOT TARGET PnetCDF::PnetCDF_CXX) + add_library(PnetCDF::PnetCDF_CXX INTERFACE IMPORTED) + set_target_properties(PnetCDF::PnetCDF_CXX PROPERTIES INTERFACE_INCLUDE_DIRECTORIES ${PnetCDF_INCLUDE_DIR} + INTERFACE_LINK_DIRECTORIES ${PnetCDF_LIB_DIR}) + set(_new_components 1) +endif() + +## Print status +if(${CMAKE_FIND_PACKAGE_NAME}_FOUND AND NOT ${CMAKE_FIND_PACKAGE_NAME}_FIND_QUIETLY AND _new_components) + message( STATUS "Find${CMAKE_FIND_PACKAGE_NAME}:" ) + message( STATUS " - ${CMAKE_FIND_PACKAGE_NAME}_VERSION [${${CMAKE_FIND_PACKAGE_NAME}_VERSION}]") + message( STATUS " - ${CMAKE_FIND_PACKAGE_NAME}_PREFIX [${${CMAKE_FIND_PACKAGE_NAME}_PREFIX}]") + set(_found_comps) + foreach( _comp IN ITEMS Fortran C CXX NetCDF4 GPTL Threads ) + if( ${CMAKE_FIND_PACKAGE_NAME}_${_comp}_FOUND ) + list(APPEND _found_comps ${_comp}) + endif() + endforeach() + message( STATUS " - ${CMAKE_FIND_PACKAGE_NAME} Components Found: ${_found_comps}") + unset(_found_comps) +endif() +unset(_new_components) diff --git a/cmake/PackageConfig.cmake.in b/cmake/PackageConfig.cmake.in new file mode 100644 index 000000000..e7b8860c9 --- /dev/null +++ b/cmake/PackageConfig.cmake.in @@ -0,0 +1,121 @@ +@PACKAGE_INIT@ + +# @PROJECT_NAME@-config.cmake +# +# Valid Find COMPONENTS: +# * SHARED - Require shared libraries. +# * STATIC - Require static libraries. +# * DOUBLE_PRECISION - Find double precision libraries +# * PROFILE - True if GPTL profiling is enabled +# * OpenMP - True if OpenMP support is enabled +# * core_atmosphere - Find atmosphere core +# * core_init_atmosphere - Find init_atmosphere core +# * core_ocean - Find ocean core +# * core_landice - Find landice core +# * core_seaice - Find seaice core +# * core_sw - Find sw core +# * core_test - Find test core +# +# +# Output variables set: +# * @PROJECT_NAME@_VERSION - Version of install package +# * @PROJECT_NAME@_VERSION_MAJOR - Major version of install package +# * @PROJECT_NAME@_VERSION_MINOR - Minor version of install package +# * @PROJECT_NAME@_MODULES_Fortran_COMPILER_ID - Compiler used to generate Fortran Modules +# * @PROJECT_NAME@_MODULES_Fortran_COMPILER_VERSION - Compiler version used to generate Fortran Modules +# * @PROJECT_NAME@_CORE__DATADIR - Location for data files for core (namelist, streams, data tables, etc.) +# * @PROJECT_NAME@_BINDIR - Location for installed auxiliary binaries. +# + +# Imported interface targets provided: +# * @PROJECT_NAME@::core:: - Core targets +# * @PROJECT_NAME@::operators - Operators library target +# * @PROJECT_NAME@::framework - Framework library target +# * @PROJECT_NAME@::external::esmf - exmf_time library target +# * @PROJECT_NAME@::external::ezxml - ezxml library target +# + +# * @PROJECT_NAME@::@PROJECT_NAME@_shared - shared library target: + +#Include targets file. This will create IMPORTED target @PROJECT_NAME@ +string(TOLOWER @PROJECT_NAME@ _project_name_lower) +if(NOT TARGET @PROJECT_NAME@::framework) + include("${CMAKE_CURRENT_LIST_DIR}/${_project_name_lower}-targets-external.cmake") + include("${CMAKE_CURRENT_LIST_DIR}/${_project_name_lower}-targets.cmake") + include("${CMAKE_CURRENT_LIST_DIR}/${_project_name_lower}-targets-core.cmake") +endif() + +set(@PROJECT_NAME@_VERSION @PROJECT_VERSION@) +set(@PROJECT_NAME@_VERSION_MAJOR @PROJECT_VERSION_MAJOR@) +set(@PROJECT_NAME@_VERSION_MINOR @PROJECT_VERSION_MINOR@) + +#Export Fortran compiler version and check module compatibility +set(@PROJECT_NAME@_MODULES_Fortran_COMPILER_ID @CMAKE_Fortran_COMPILER_ID@) +set(@PROJECT_NAME@_MODULES_Fortran_COMPILER_VERSION @CMAKE_Fortran_COMPILER_VERSION@) +if(NOT @PROJECT_NAME@_MODULES_Fortran_COMPILER_ID STREQUAL CMAKE_Fortran_COMPILER_ID + OR NOT @PROJECT_NAME@_MODULES_Fortran_COMPILER_VERSION VERSION_EQUAL CMAKE_Fortran_COMPILER_VERSION) + message(SEND_ERROR "Package @PROJECT_NAME@ provides Fortran modules built with " + "${@PROJECT_NAME@_MODULES_Fortran_COMPILER_ID}-${@PROJECT_NAME@_MODULES_Fortran_COMPILER_VERSION} " + "but this build for ${PROJECT_NAME} uses incompatible compiler ${CMAKE_Fortran_COMPILER_ID}-${CMAKE_Fortran_COMPILER_VERSION}") +endif() + +set_and_check(@PROJECT_NAME@_BINDIR @PACKAGE_BINDIR@) +set_and_check(@PROJECT_NAME@_CMAKE_MODULE_PATH @PACKAGE_CMAKE_MODULE_INSTALL_PATH@) +set(CMAKE_MODULE_PATH ${@PROJECT_NAME@_CMAKE_MODULE_PATH} ${CMAKE_MODULE_PATH}) + +include(CMakeFindDependencyMacro) +if(@OpenMP_Fortran_FOUND@) #OpenMP_Fortran_FOUND + if(NOT OpenMP_Fortran_FOUND) + find_package(OpenMP REQUIRED COMPONENTS Fortran) + endif() + set(@PROJECT_NAME@_OpenMP_FOUND True) +endif() +if(NOT MPI_Fortran_FOUND) + find_package(MPI REQUIRED COMPONENTS Fortran) +endif() +if(NOT NetCDF_Fortran_FOUND) + find_package(NetCDF REQUIRED COMPONENTS Fortran) +endif() +find_package(PnetCDF REQUIRED COMPONENTS Fortran) +find_package(PIO REQUIRED COMPONENTS Fortran C) +if(@MPAS_PROFILE@) #MPAS_PROFILE + if(NOT GPTL_FOUND) + find_dependency(GPTL REQUIRED) + endif() + set(@PROJECT_NAME@_PROFILE_FOUND) +endif() + +if(@BUILD_SHARED_LIBS@) #BUILD_SHARED_LIBS + set(@PROJECT_NAME@_SHARED_FOUND True) +else() + set(@PROJECT_NAME@_STATIC_FOUND True) +endif() +if(@MPAS_DOUBLE_PRECISION@) #MPAS_DOUBLE_PRECISION + set(@PROJECT_NAME@_DOUBLE_PRECISION_FOUND True) +else() + set(@PROJECT_NAME@_DOUBLE_PRECISION_FOUND False) +endif() +set(MPAS_CORES @MPAS_CORES@) +foreach(_core IN LISTS MPAS_CORES) + string(TOUPPER ${_core} _CORE) + set_and_check(@PROJECT_NAME@_CORE_${_CORE}_DATADIR @PACKAGE_CORE_DATADIR_ROOT@/core_${_core}) + set(@PROJECT_NAME@_core_${_core}_FOUND True) +endforeach() + +check_required_components("@PROJECT_NAME@") + +## Print status +if(NOT @PROJECT_NAME@_FIND_QUIETLY) + #Get list of all found components for printing + set(_found_components) + set(_all_components SHARED STATIC PROFILE OpenMP DOUBLE_PRECISION core_atmosphere core_init_atmosphere core_landice core_ocean core_sw core_test) + foreach(_cmp IN LISTS _all_components) + if(@PROJECT_NAME@_${_cmp}_FOUND) + list(APPEND _found_components ${_cmp}) + endif() + endforeach() + + message(STATUS "Found @PROJECT_NAME@: (version: \"@PROJECT_VERSION@\") (components: ${_found_components})") + unset(_found_components) + unset(_all_components) +endif() diff --git a/doc/Makefile b/docs/Makefile similarity index 100% rename from doc/Makefile rename to docs/Makefile diff --git a/doc/conf.py b/docs/conf.py similarity index 100% rename from doc/conf.py rename to docs/conf.py diff --git a/doc/index.rst b/docs/index.rst similarity index 100% rename from doc/index.rst rename to docs/index.rst diff --git a/doc/ocean/design_docs/index.rst b/docs/ocean/design_docs/index.rst similarity index 100% rename from doc/ocean/design_docs/index.rst rename to docs/ocean/design_docs/index.rst diff --git a/doc/ocean/index.rst b/docs/ocean/index.rst similarity index 100% rename from doc/ocean/index.rst rename to docs/ocean/index.rst diff --git a/namelist_monan/GF_ConvPar_nml b/namelist_monan/GF_ConvPar_nml index bba18a3bd..93d299ecb 100644 --- a/namelist_monan/GF_ConvPar_nml +++ b/namelist_monan/GF_ConvPar_nml @@ -35,6 +35,7 @@ tau_land_cp = 3600., != cold pool lifetime over land mx_buoy1 = 250.5, ! J/kg mx_buoy2 = 20004.0, ! J/kg + tu_buoyx = 1.0, sgs_w_timescale = 1, != 0/1: uses vertical velocity for determination of tau_ecmwf @@ -44,8 +45,6 @@ moist_trigger = 0, != 0/1: relative humidity effects on the cap_max trigger function adv_trigger = 0, != 0/1: adv trigger based on Xie et al 2019. dcape_threshold = 70., != CAPE time rate threshold for ADV_TRIGGER (J kg^-1 hr^-1) - lcl_trigger = 0, != only for shallow: lcl_trigger > 0 activates the LCL trigger which - != requires the lcl height be lower than the pbl height. 0 turn it off. cap_maxs = 50., != max- distance (hPa) the air parcel is allowed to go up looking for the LFC !--- diff --git a/src/Makefile b/src/Makefile index cc0cc020d..b9c037c8c 100644 --- a/src/Makefile +++ b/src/Makefile @@ -6,12 +6,6 @@ include Makefile.in.$(ESM) else -ifeq "$(AUTOCLEAN)" "true" -AUTOCLEAN_DEPS=clean_shared -else -AUTOCLEAN_DEPS= -endif - all: mpas mpas: $(AUTOCLEAN_DEPS) externals frame ops dycore drver @@ -45,18 +39,24 @@ dycore: $(AUTOCLEAN_DEPS) build_tools externals frame ops clean: clean_shared clean_core clean_core: +ifeq "$(AUTOCLEAN)" "true" + $(info ) + $(info *********************************************************************************************) + $(info The $(CORE) core will be cleaned and re-compiled.) + $(info *********************************************************************************************) + $(info ) +endif if [ -d core_$(CORE) ] ; then \ ( cd core_$(CORE); $(MAKE) clean ) \ fi; clean_shared: ifeq "$(AUTOCLEAN)" "true" - @echo "" - @echo "*********************************************************************************************" - @echo "The MPAS infrastructure is currently built for a core different from $(CORE)." - @echo "The infrastructure will be cleaned and re-built for the $(CORE) core." - @echo "*********************************************************************************************" - @echo "" + $(info ) + $(info *********************************************************************************************) + $(info The infrastructure will be cleaned and re-compiled.) + $(info *********************************************************************************************) + $(info ) endif $(RM) libframework.a libops.a libdycore.a lib$(CORE).a *.o ( cd tools; $(MAKE) clean ) diff --git a/src/core_atmosphere/CMakeLists.txt b/src/core_atmosphere/CMakeLists.txt new file mode 100644 index 000000000..0667b6718 --- /dev/null +++ b/src/core_atmosphere/CMakeLists.txt @@ -0,0 +1,419 @@ + +## Source files +# physics/ +set(ATMOSPHERE_CORE_PHYSICS_SOURCES + ccpp_kind_types.F + mpas_atmphys_camrad_init.F + mpas_atmphys_constants.F + mpas_atmphys_control.F + mpas_atmphys_date_time.F + mpas_atmphys_driver_cloudiness.F + mpas_atmphys_driver_microphysics.F + mpas_atmphys_driver_oml.F + mpas_atmphys_finalize.F + mpas_atmphys_functions.F + mpas_atmphys_init_microphysics.F + mpas_atmphys_interface.F + mpas_atmphys_landuse.F + mpas_atmphys_lsm_noahinit.F + mpas_atmphys_manager.F + mpas_atmphys_o3climatology.F + mpas_atmphys_rrtmg_lwinit.F + mpas_atmphys_rrtmg_swinit.F + mpas_atmphys_sfc_diagnostics.F + mpas_atmphys_update.F + mpas_atmphys_update_surface.F + mpas_atmphys_utilities.F + mpas_atmphys_driver.F + mpas_atmphys_driver_convection.F + mpas_atmphys_driver_gwdo.F + mpas_atmphys_driver_lsm.F + mpas_atmphys_driver_pbl.F + mpas_atmphys_driver_radiation_lw.F + mpas_atmphys_driver_radiation_sw.F + mpas_atmphys_driver_seaice.F + mpas_atmphys_driver_sfclayer.F + mpas_atmphys_init.F + mpas_atmphys_lsm_shared.F + mpas_atmphys_packages.F + mpas_atmphys_todynamics.F + mpas_atmphys_vars.F + mpas_atmphys_driver_lsm_noahmp.F + mpas_atmphys_lsm_noahmpfinalize.F + mpas_atmphys_lsm_noahmpinit.F +) +list(TRANSFORM ATMOSPHERE_CORE_PHYSICS_SOURCES PREPEND physics/) + +## Unused +# physics/physics_wrf/ +set(ATMOSPHERE_CORE_PHYSICS_WRF_SOURCES + libmassv.F + cu_ntiedtke_post.F + cu_ntiedtke_pre.F + module_bep_bem_helper.F + module_bl_gwdo.F + module_bl_ugwp_gwdo.F + module_bl_ysu.F + module_cam_error_function.F + module_cam_shr_kind_mod.F + module_cam_support.F + module_cu_gf.mpas.F + module_mp_kessler.F + module_mp_radar.F + module_mp_thompson.F + module_mp_thompson_cldfra3.F + module_mp_thompson_aerosols.F + module_mp_wsm6.F + module_ra_rrtmg_sw_aerosols.F + module_ra_cam_support.F + module_ra_rrtmg_lw.F + module_ra_rrtmg_sw.F + module_ra_rrtmg_vinterp.F + module_sf_bem.F + module_sf_bep.F + module_sf_bep_bem.F + module_sf_noah_seaice.F + module_sf_noah_seaice_drv.F + module_sf_noahdrv.F + module_sf_noahlsm.F + module_sf_noahlsm_glacial_only.F + module_sf_oml.F + module_sf_sfcdiags.F + module_sf_sfclay.F + module_sf_sfclayrev.F + module_sf_urban.F + bl_mynn_post.F + bl_mynn_pre.F + module_bl_mynn.F + module_cu_kfeta.F + module_cu_ntiedtke.F + module_cu_tiedtke.F + module_ra_cam.F + module_sf_mynn.F + sf_mynn_pre.F + sf_sfclayrev_pre.F +) + +list(TRANSFORM ATMOSPHERE_CORE_PHYSICS_WRF_SOURCES PREPEND physics/physics_wrf/) + + +set(ATMOSPHERE_CORE_PHYSICS_MMM_DIR ${CMAKE_CURRENT_SOURCE_DIR}/physics/physics_mmm) + +if(NOT EXISTS ${ATMOSPHERE_CORE_PHYSICS_MMM_DIR}) + set(PHYSICS_MMM_REPO_URL "https://github.com/NCAR/MMM-physics") + execute_process(COMMAND git clone ${PHYSICS_MMM_REPO_URL} ${ATMOSPHERE_CORE_PHYSICS_MMM_DIR} + RESULT_VARIABLE GIT_CLONE_RESULT + OUTPUT_VARIABLE GIT_CLONE_OUTPUT + ERROR_VARIABLE GIT_CLONE_ERROR) + if(NOT GIT_CLONE_RESULT EQUAL 0) + message(FATAL_ERROR "Git clone failed with error: ${GIT_CLONE_ERROR}") + endif() + +else() + message(STATUS "Directory ${DIR_TO_CHECK} already exists, skipping clone") +endif() + +set(ATMOSPHERE_CORE_PHYSICS_MMM_SOURCES + bl_gwdo.F90 + bl_ysu.F90 + cu_ntiedtke.F90 + module_libmassv.F90 + mp_wsm6.F90 + mp_wsm6_effectRad.F90 + bl_mynn.F90 + bl_mynn_subroutines.F90 + mp_radar.F90 + mynn_shared.F90 + sf_mynn.F90 + sf_sfclayrev.F90 +) + +list(TRANSFORM ATMOSPHERE_CORE_PHYSICS_MMM_SOURCES PREPEND physics/physics_mmm/) + +set(ATMOSPHERE_CORE_PHYSICS_NOAA_DIR ${CMAKE_CURRENT_SOURCE_DIR}/physics/physics_noaa/UGWP) + +if(NOT EXISTS ${ATMOSPHERE_CORE_PHYSICS_NOAA_DIR}) + set(PHYSICS_NOAA_REPO_URL "https://github.com/NOAA-GSL/UGWP.git") + execute_process(COMMAND git clone ${PHYSICS_NOAA_REPO_URL} ${ATMOSPHERE_CORE_PHYSICS_NOAA_DIR} + RESULT_VARIABLE GIT_CLONE_RESULT + OUTPUT_VARIABLE GIT_CLONE_OUTPUT + ERROR_VARIABLE GIT_CLONE_ERROR) + if(NOT GIT_CLONE_RESULT EQUAL 0) + message(FATAL_ERROR "Git clone failed with error: ${GIT_CLONE_ERROR}") + endif() + +else() + message(STATUS "Directory ${DIR_TO_CHECK} already exists, skipping clone") +endif() + +set(ATMOSPHERE_CORE_PHYSICS_NOAA_SOURCES + bl_ugwp.F + bl_ugwpv1_ngw.F + cires_tauamf_data.F + cires_ugwpv1_initialize.F + cires_ugwpv1_module.F + cires_ugwpv1_solv2.F + cires_ugwpv1_triggers.F +) + +list(TRANSFORM ATMOSPHERE_CORE_PHYSICS_NOAA_SOURCES PREPEND physics/physics_noaa/UGWP/) + +set(ATMOSPHERE_CORE_PHYSICS_NOAMP_UTILITY_SOURCES + CheckNanMod.F90 + Machine.F90 +) +list(TRANSFORM ATMOSPHERE_CORE_PHYSICS_NOAMP_UTILITY_SOURCES PREPEND physics/physics_noahmp/utility/) + +set(ATMOSPHERE_CORE_PHYSICS_NOAMP_MPAS_DRIVER_SOURCES + BiochemVarInTransferMod.F90 + ConfigVarOutTransferMod.F90 + ForcingVarInTransferMod.F90 + NoahmpDriverMainMod.F90 + NoahmpIOVarFinalizeMod.F90 + NoahmpReadNamelistMod.F90 + PedoTransferSR2006Mod.F90 + BiochemVarOutTransferMod.F90 + EnergyVarInTransferMod.F90 + ForcingVarOutTransferMod.F90 + NoahmpIOVarInitMod.F90 + NoahmpReadTableMod.F90 + WaterVarInTransferMod.F90 + ConfigVarInTransferMod.F90 + EnergyVarOutTransferMod.F90 + NoahmpInitMainMod.F90 + NoahmpIOVarType.F90 + NoahmpSnowInitMod.F90 + WaterVarOutTransferMod.F90 +) +list(TRANSFORM ATMOSPHERE_CORE_PHYSICS_NOAMP_MPAS_DRIVER_SOURCES PREPEND physics/physics_noahmp/drivers/mpas/) + +set(ATMOSPHERE_CORE_PHYSICS_NOAMP_SRC_SOURCES + AtmosForcingMod.F90 + BalanceErrorCheckGlacierMod.F90 + BalanceErrorCheckMod.F90 + BiochemCropMainMod.F90 + BiochemNatureVegMainMod.F90 + BiochemVarInitMod.F90 + BiochemVarType.F90 + CanopyHydrologyMod.F90 + CanopyRadiationTwoStreamMod.F90 + CanopyWaterInterceptMod.F90 + CarbonFluxCropMod.F90 + CarbonFluxNatureVegMod.F90 + ConfigVarInitMod.F90 + ConfigVarType.F90 + ConstantDefineMod.F90 + CropGrowDegreeDayMod.F90 + CropPhotosynthesisMod.F90 + EnergyMainGlacierMod.F90 + EnergyMainMod.F90 + EnergyVarInitMod.F90 + EnergyVarType.F90 + ForcingVarInitMod.F90 + ForcingVarType.F90 + GeneralInitGlacierMod.F90 + GeneralInitMod.F90 + GlacierIceThermalPropertyMod.F90 + GlacierPhaseChangeMod.F90 + GlacierTemperatureMainMod.F90 + GlacierTemperatureSolverMod.F90 + GlacierThermalDiffusionMod.F90 + GroundAlbedoGlacierMod.F90 + GroundAlbedoMod.F90 + GroundRoughnessPropertyGlacierMod.F90 + GroundRoughnessPropertyMod.F90 + GroundThermalPropertyGlacierMod.F90 + GroundThermalPropertyMod.F90 + GroundWaterMmfMod.F90 + GroundWaterTopModelMod.F90 + HumiditySaturationMod.F90 + IrrigationFloodMod.F90 + IrrigationInfilPhilipMod.F90 + IrrigationMicroMod.F90 + IrrigationPrepareMod.F90 + IrrigationSprinklerMod.F90 + IrrigationTriggerMod.F90 + Makefile + MatrixSolverTriDiagonalMod.F90 + NoahmpMainGlacierMod.F90 + NoahmpMainMod.F90 + NoahmpVarType.F90 + PhenologyMainMod.F90 + PrecipitationHeatAdvectGlacierMod.F90 + PrecipitationHeatAdvectMod.F90 + PsychrometricVariableGlacierMod.F90 + PsychrometricVariableMod.F90 + ResistanceAboveCanopyChen97Mod.F90 + ResistanceAboveCanopyMostMod.F90 + ResistanceBareGroundChen97Mod.F90 + ResistanceBareGroundMostMod.F90 + ResistanceCanopyStomataBallBerryMod.F90 + ResistanceCanopyStomataJarvisMod.F90 + ResistanceGroundEvaporationGlacierMod.F90 + ResistanceGroundEvaporationMod.F90 + ResistanceLeafToGroundMod.F90 + RunoffSubSurfaceDrainageMod.F90 + RunoffSubSurfaceEquiWaterTableMod.F90 + RunoffSubSurfaceGroundWaterMod.F90 + RunoffSubSurfaceShallowMmfMod.F90 + RunoffSurfaceBatsMod.F90 + RunoffSurfaceDynamicVicMod.F90 + RunoffSurfaceExcessDynamicVicMod.F90 + RunoffSurfaceFreeDrainMod.F90 + RunoffSurfaceTopModelEquiMod.F90 + RunoffSurfaceTopModelGrdMod.F90 + RunoffSurfaceTopModelMmfMod.F90 + RunoffSurfaceVicMod.F90 + RunoffSurfaceXinAnJiangMod.F90 + ShallowWaterTableMmfMod.F90 + SnowAgingBatsMod.F90 + SnowAlbedoBatsMod.F90 + SnowAlbedoClassMod.F90 + SnowCoverGlacierMod.F90 + SnowCoverGroundNiu07Mod.F90 + SnowfallBelowCanopyMod.F90 + SnowLayerCombineMod.F90 + SnowLayerDivideMod.F90 + SnowLayerWaterComboMod.F90 + SnowpackCompactionMod.F90 + SnowpackHydrologyGlacierMod.F90 + SnowpackHydrologyMod.F90 + SnowThermalPropertyMod.F90 + SnowWaterMainGlacierMod.F90 + SnowWaterMainMod.F90 + SoilHydraulicPropertyMod.F90 + SoilMoistureSolverMod.F90 + SoilSnowTemperatureMainMod.F90 + SoilSnowTemperatureSolverMod.F90 + SoilSnowThermalDiffusionMod.F90 + SoilSnowWaterPhaseChangeMod.F90 + SoilThermalPropertyMod.F90 + SoilWaterDiffusionRichardsMod.F90 + SoilWaterInfilGreenAmptMod.F90 + SoilWaterInfilPhilipMod.F90 + SoilWaterInfilSmithParlangeMod.F90 + SoilWaterMainMod.F90 + SoilWaterSupercoolKoren99Mod.F90 + SoilWaterSupercoolNiu06Mod.F90 + SoilWaterTranspirationMod.F90 + SurfaceAlbedoGlacierMod.F90 + SurfaceAlbedoMod.F90 + SurfaceEmissivityGlacierMod.F90 + SurfaceEmissivityMod.F90 + SurfaceEnergyFluxBareGroundMod.F90 + SurfaceEnergyFluxGlacierMod.F90 + SurfaceEnergyFluxVegetatedMod.F90 + SurfaceRadiationGlacierMod.F90 + SurfaceRadiationMod.F90 + TileDrainageEquiDepthMod.F90 + TileDrainageHooghoudtMod.F90 + TileDrainageSimpleMod.F90 + VaporPressureSaturationMod.F90 + WaterMainGlacierMod.F90 + WaterMainMod.F90 + WaterTableDepthSearchMod.F90 + WaterTableEquilibriumMod.F90 + WaterVarInitMod.F90 + WaterVarType.F90 +) +list(TRANSFORM ATMOSPHERE_CORE_PHYSICS_NOAMP_SRC_SOURCES PREPEND physics/physics_noahmp/src/) + +# diagnostics/ +set(ATMOSPHERE_CORE_DIAGNOSTIC_SOURCES + mpas_atm_diagnostic_template.F + mpas_atm_diagnostics_manager.F + mpas_atm_diagnostics_utils.F + mpas_cloud_diagnostics.F + mpas_convective_diagnostics.F + mpas_isobaric_diagnostics.F + mpas_pv_diagnostics.F + mpas_soundings.F +) + +list(TRANSFORM ATMOSPHERE_CORE_DIAGNOSTIC_SOURCES PREPEND diagnostics/) + +# dynamics/ +set(ATMOSPHERE_CORE_DYNAMICS_SOURCES + mpas_atm_boundaries.F + mpas_atm_iau.F + mpas_atm_time_integration.F) +list(TRANSFORM ATMOSPHERE_CORE_DYNAMICS_SOURCES PREPEND dynamics/) + +# utils/ +set(ATMOSPHERE_CORE_UTILS_SOURCES + atmphys_build_tables_thompson.F + build_tables.F) +list(TRANSFORM ATMOSPHERE_CORE_UTILS_SOURCES PREPEND utils/) + +# core_atosphere +set(ATMOSPHERE_CORE_SOURCES + mpas_atm_dimensions.F + mpas_atm_threading.F + mpas_atm_core.F + mpas_atm_core_interface.F + mpas_atm_halos.F +) + +## Generated includes +set(ATMOSPHERE_CORE_INCLUDES + block_dimension_routines.inc + core_variables.inc + define_packages.inc + domain_variables.inc + namelist_call.inc + namelist_defines.inc + setup_immutable_streams.inc + structs_and_variables.inc) + + +add_library(core_atmosphere ${ATMOSPHERE_CORE_SOURCES} + ${ATMOSPHERE_CORE_PHYSICS_NOAMP_UTILITY_SOURCES} + ${ATMOSPHERE_CORE_PHYSICS_NOAMP_MPAS_DRIVER_SOURCES} + ${ATMOSPHERE_CORE_PHYSICS_NOAMP_SRC_SOURCES} + ${ATMOSPHERE_CORE_PHYSICS_SOURCES} + ${ATMOSPHERE_CORE_PHYSICS_MMM_SOURCES} + ${ATMOSPHERE_CORE_PHYSICS_WRF_SOURCES} + ${ATMOSPHERE_CORE_PHYSICS_NOAA_SOURCES} + ${ATMOSPHERE_CORE_DIAGNOSTIC_SOURCES} + ${ATMOSPHERE_CORE_DYNAMICS_SOURCES}) + +set(CORE_ATMOSPHERE_COMPILE_DEFINITIONS + mpas=1 + MPAS_NATIVE_TIMERS +) +if (${DO_PHYSICS}) + list(APPEND CORE_ATMOSPHERE_COMPILE_DEFINITIONS DO_PHYSICS) +endif () +target_compile_definitions(core_atmosphere PRIVATE ${CORE_ATMOSPHERE_COMPILE_DEFINITIONS}) +set_MPAS_DEBUG_flag(core_atmosphere) +mpas_core_target(CORE atmosphere TARGET core_atmosphere INCLUDES ${ATMOSPHERE_CORE_INCLUDES}) + +#Get physics_wrf tables from MPAS-Data +include(FetchContent) +if (${PROJECT_VERSION} VERSION_GREATER_EQUAL 7.0) + set(MPAS_DATA_GIT_TAG v${PROJECT_VERSION_MAJOR}.0) +else () + set(MPAS_DATA_GIT_TAG master) +endif () + +FetchContent_Declare(mpas_data + GIT_REPOSITORY https://github.com/MPAS-Dev/MPAS-Data.git + GIT_TAG ${MPAS_DATA_GIT_TAG} + GIT_PROGRESS True + GIT_SHALLOW True) +FetchContent_Populate(mpas_data) +message(STATUS "MPAS-Data source dir: ${mpas_data_SOURCE_DIR}") +set(PHYSICS_WRF_DATA_DIR ${mpas_data_SOURCE_DIR}/atmosphere/physics_wrf/files) +file(GLOB PHYSICS_WRF_DATA RELATIVE ${PHYSICS_WRF_DATA_DIR} "${PHYSICS_WRF_DATA_DIR}/*") +file(MAKE_DIRECTORY ${CMAKE_BINARY_DIR}/${PROJECT_NAME}/core_atmosphere) +foreach (data_file IN LISTS PHYSICS_WRF_DATA) + execute_process(COMMAND ${CMAKE_COMMAND} -E create_symlink ${PHYSICS_WRF_DATA_DIR}/${data_file} + ${CMAKE_BINARY_DIR}/${PROJECT_NAME}/core_atmosphere/${data_file}) +endforeach () +install(DIRECTORY ${PHYSICS_WRF_DATA_DIR}/ DESTINATION ${CMAKE_INSTALL_DATADIR}/${PROJECT_NAME}/core_atmosphere) + +add_executable(mpas_atmosphere_build_tables ${ATMOSPHERE_CORE_UTILS_SOURCES}) +target_link_libraries(mpas_atmosphere_build_tables PUBLIC core_atmosphere) +mpas_fortran_target(mpas_atmosphere_build_tables) +install(TARGETS mpas_atmosphere_build_tables EXPORT ${PROJECT_NAME}ExportsCore + RUNTIME DESTINATION ${CMAKE_INSTALL_BINDIR}) diff --git a/src/core_atmosphere/Externals.cfg b/src/core_atmosphere/Externals.cfg new file mode 100644 index 000000000..528f0824d --- /dev/null +++ b/src/core_atmosphere/Externals.cfg @@ -0,0 +1,16 @@ +#[MMM-physics] +#local_path = ./physics_mmm +#protocol = git +#repo_url = https://github.com/NCAR/MMM-physics.git +#tag = 20240626-MPASv8.2 +#required = True + +[GSL_UGWP] +local_path = ./physics_noaa/UGWP +protocol = git +repo_url = https://github.com/NOAA-GSL/UGWP.git +tag = MPAS_20241223 +required = True + +[externals_description] +schema_version = 1.0.0 diff --git a/src/core_atmosphere/Makefile b/src/core_atmosphere/Makefile index 16316c08a..eabe20df7 100644 --- a/src/core_atmosphere/Makefile +++ b/src/core_atmosphere/Makefile @@ -4,8 +4,11 @@ # To build a dycore-only MPAS-Atmosphere model, comment-out or delete # the definition of PHYSICS, below # -PHYSICS=-DDO_PHYSICS - +# If MPAS_CAM_DYCORE is found in CPPFLAGS, PHYSICS will become undefined automatically +# +ifeq ($(findstring MPAS_CAM_DYCORE,$(CPPFLAGS)),) + PHYSICS = -DDO_PHYSICS +endif ifdef PHYSICS PHYSCORE = physcore @@ -30,7 +33,7 @@ core_input_gen: gen_includes: core_reg (if [ ! -d inc ]; then mkdir -p inc; fi) # To generate *.inc files - (cd inc; $(REG_PARSE) < ../Registry_processed.xml ) + (cd inc; $(REG_PARSE) ../Registry_processed.xml $(CPPFLAGS) ) post_build: if [ ! -e $(ROOT_DIR)/default_inputs ]; then mkdir $(ROOT_DIR)/default_inputs; fi @@ -42,6 +45,7 @@ physcore: mpas_atm_dimensions.o ( mkdir libphys; cd libphys; ar -x ../physics/libphys.a ) ( cd ../..; ln -sf ./src/core_atmosphere/physics/physics_wrf/files/*TBL .) ( cd ../..; ln -sf ./src/core_atmosphere/physics/physics_wrf/files/*DATA* .) + ( cd ../..; ln -sf ./src/core_atmosphere/physics/physics_noahmp/parameters/*TBL .) dycore: mpas_atm_dimensions.o $(PHYSCORE) ( cd dynamics; $(MAKE) all PHYSICS="$(PHYSICS)" ) @@ -80,7 +84,7 @@ clean: $(RM) $@ $*.mod ifeq "$(GEN_F90)" "true" $(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_monan -I./physics/physics_wrf -I./physics/physics_mmm -I../external/esmf_time_f90 + $(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES) -I../framework -I../operators -I./physics -I./dynamics -I./diagnostics -I./physics/physics_monan -I./physics/physics_wrf -I./physics/physics_mmm -I./physics/physics_noaa/UGWP -I../external/esmf_time_f90 else - $(FC) $(CPPFLAGS) $(PHYSICS) $(FFLAGS) -c $*.F $(CPPINCLUDES) $(FCINCLUDES) -I./inc -I../framework -I../operators -I./physics -I./dynamics -I./diagnostics -I./physics/physics_monan -I./physics/physics_wrf -I./physics/physics_mmm -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_monan -I./physics/physics_wrf -I./physics/physics_mmm -I./physics/physics_noaa/UGWP -I../external/esmf_time_f90 endif diff --git a/src/core_atmosphere/Registry.xml b/src/core_atmosphere/Registry.xml index 1f7784723..1d47a771f 100644 --- a/src/core_atmosphere/Registry.xml +++ b/src/core_atmosphere/Registry.xml @@ -1,5 +1,5 @@ - + @@ -48,6 +48,10 @@ description="dimension of CAM radiation absorption save array"/> + + #endif @@ -397,6 +401,7 @@ + @@ -404,11 +409,15 @@ + + + + @@ -492,11 +501,39 @@ + #ifdef MPAS_CAM_DYCORE #endif - +#ifdef DO_PHYSICS + + + + + + + + + + + + + + + + + + + + + + + + + + +#endif @@ -558,16 +595,6 @@ - - - - - - - - - - #endif @@ -616,15 +643,18 @@ #ifdef DO_PHYSICS - - - - - - - - + + + + + + + + + + + @@ -635,7 +665,9 @@ + + @@ -646,32 +678,32 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -783,6 +815,18 @@ + + + + + + + + + + + + @@ -800,7 +844,10 @@ + + + @@ -841,16 +888,6 @@ - - - - - - - - - - @@ -858,13 +895,14 @@ + #endif @@ -991,7 +1029,7 @@ @@ -1016,8 +1054,8 @@ - - + + @@ -1098,6 +1136,154 @@ + +#ifdef DO_PHYSICS + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +#endif + + + + + + + + + + + + + + + + + + +#ifdef DO_PHYSICS + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +#endif + + +#ifdef DO_PHYSICS + + + + + + + + + + + + + + + + + + + + + + + + + + +#endif + @@ -1436,32 +1622,44 @@ + packages="bl_mynn_in;bl_ysu_in;cu_ntiedtke_in;mp_kessler_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="mp_kessler_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="bl_mynn_in;bl_ysu_in;cu_ntiedtke_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="bl_mynn_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="bl_mynn_in;mp_thompson_in;mp_thompson_aers_in"/> - + packages="mp_thompson_in;mp_thompson_aers_in"/> + + + + + + + @@ -1576,6 +1774,14 @@ + + + + @@ -1711,7 +1917,7 @@ - + @@ -1719,6 +1925,15 @@ + + + + + @@ -1770,31 +1985,43 @@ + packages="bl_mynn_in;bl_ysu_in;cu_ntiedtke_in;mp_kessler_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="mp_kessler_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="bl_mynn_in;bl_ysu_in;cu_ntiedtke_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="bl_mynn_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="bl_mynn_in;mp_thompson_in;mp_thompson_aers_in"/> + packages="mp_thompson_in;mp_thompson_aers_in"/> + + + + + + - - - - - - - - - - - - + + + + + @@ -1971,6 +2211,11 @@ description="logical for turning on/off top-down, radiation_driven mixing" possible_values=".true. to turn on top-down radiation_driven mixing; .false. otherwise"/> + + + possible_values="`suite',`mp_wsm6',`mp_thompson',`mp_thompson_aerosols', `mp_kessler',`off'"/> + possible_values="`suite',`sf_noah',`sf_noahmp`, `off'"/> + possible_values="`suite',`bl_ysu_gwdo',`bl_ugwp_gwdo',`off'"/> + + + + + + + + + + - @@ -2160,6 +2428,11 @@ description="threshold above which accumulated radiation diagnostics are reset" possible_values="Positive real values"/> + + + possible_values="0,1,2"/> + + @@ -2246,71 +2522,83 @@ + packages="mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + + + packages="mp_kessler_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="mp_kessler_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="mp_kessler_in;mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="mp_thompson_in;mp_thompson_aers_in;mp_wsm6_in"/> + packages="mp_thompson_in;mp_thompson_aers_in"/> + packages="mp_thompson_in;mp_thompson_aers_in"/> + + + + @@ -2318,12 +2606,12 @@ - - + @@ -2471,7 +2759,7 @@ + packages="cu_gf_monan_in"/> + + @@ -2838,12 +3128,76 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -2851,6 +3205,23 @@ description="change in PBL meridional wind tendency due to gravity wave drag over orography"/> + + + + + + + + + + + @@ -3093,13 +3464,26 @@ - + + + + + + + + + + @@ -3234,6 +3618,58 @@ persistence="scratch" /> #ifdef DO_PHYSICS + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -3337,10 +3773,22 @@ description="tendency of snow mixing ratio due to pbl processes" packages="bl_mynn_in"/> + + + + + + @@ -3371,6 +3819,43 @@ + + + + + + + + + + + + + + + + + + + + + + + @@ -3395,10 +3880,10 @@ - - - - + @@ -3437,7 +3922,7 @@ - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + #endif @@ -3511,22 +4079,28 @@ description="Potential temperature increment"/> - - - - - - @@ -3538,4 +4112,7 @@ #include "diagnostics/Registry_diagnostics.xml" +#ifdef DO_PHYSICS +#include "physics/Registry_noahmp.xml" +#endif diff --git a/src/core_atmosphere/build_options.mk b/src/core_atmosphere/build_options.mk index 34caf8d66..3b5a87345 100644 --- a/src/core_atmosphere/build_options.mk +++ b/src/core_atmosphere/build_options.mk @@ -2,6 +2,9 @@ PWD=$(shell pwd) EXE_NAME=atmosphere_model NAMELIST_SUFFIX=atmosphere override CPPFLAGS += -DCORE_ATMOSPHERE +FCINCLUDES += -I$(PWD)/src/core_atmosphere/physics/physics_noahmp/drivers/mpas \ + -I$(PWD)/src/core_atmosphere/physics/physics_noahmp/utility \ + -I$(PWD)/src/core_atmosphere/physics/physics_noahmp/src report_builds: @echo "CORE=atmosphere" diff --git a/src/core_atmosphere/dynamics/mpas_atm_boundaries.F b/src/core_atmosphere/dynamics/mpas_atm_boundaries.F index 7d439b49a..787e7719a 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_boundaries.F +++ b/src/core_atmosphere/dynamics/mpas_atm_boundaries.F @@ -7,6 +7,15 @@ ! module mpas_atm_boundaries +#ifdef MPAS_OPENACC + use mpas_timer, only: mpas_timer_start, mpas_timer_stop +#define MPAS_ACC_TIMER_START(X) call mpas_timer_start(X) +#define MPAS_ACC_TIMER_STOP(X) call mpas_timer_stop(X) +#else +#define MPAS_ACC_TIMER_START(X) +#define MPAS_ACC_TIMER_STOP(X) +#endif + 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 @@ -36,6 +45,11 @@ module mpas_atm_boundaries public :: nBdyZone, nSpecZone, nRelaxZone + interface mpas_atm_get_bdy_state + module procedure mpas_atm_get_bdy_state_2d + module procedure mpas_atm_get_bdy_state_3d + end interface mpas_atm_get_bdy_state + private type (MPAS_Time_Type) :: LBC_intv_end @@ -85,9 +99,12 @@ subroutine mpas_atm_update_bdy_tend(clock, streamManager, block, firstCall, ierr type (mpas_pool_type), pointer :: lbc real (kind=RKIND) :: dt - integer, pointer :: nCells - integer, pointer :: nEdges - integer, pointer :: index_qv + integer, pointer :: nCells_ptr + integer, pointer :: nEdges_ptr + integer, pointer :: nVertLevels_ptr + integer, pointer :: index_qv_ptr + integer, pointer :: nScalars_ptr + integer :: nCells, nEdges, nVertLevels, index_qv, nScalars real (kind=RKIND), dimension(:,:), pointer :: u real (kind=RKIND), dimension(:,:), pointer :: ru @@ -115,7 +132,7 @@ subroutine mpas_atm_update_bdy_tend(clock, streamManager, block, firstCall, ierr type (MPAS_Time_Type) :: currTime type (MPAS_TimeInterval_Type) :: lbc_interval character(len=StrKIND) :: read_time - integer :: iEdge + integer :: iEdge, iCell, k, j integer :: cell1, cell2 @@ -155,6 +172,7 @@ subroutine mpas_atm_update_bdy_tend(clock, streamManager, block, firstCall, ierr 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) @@ -162,26 +180,87 @@ subroutine mpas_atm_update_bdy_tend(clock, streamManager, block, firstCall, ierr 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_dimension(mesh, 'nCells', nCells_ptr) + call mpas_pool_get_dimension(mesh, 'nEdges', nEdges_ptr) + call mpas_pool_get_dimension(mesh, 'nVertLevels', nVertLevels_ptr) + call mpas_pool_get_dimension(state, 'num_scalars', nScalars_ptr) + call mpas_pool_get_dimension(lbc, 'index_qv', index_qv_ptr) call mpas_pool_get_array(mesh, 'zz', zz) + MPAS_ACC_TIMER_START('mpas_atm_update_bdy_tend [ACC_data_xfer]') + if (.not. firstCall) then + 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) + + !$acc enter data copyin(lbc_tend_u, lbc_tend_ru, lbc_tend_rho_edge, lbc_tend_w, & + !$acc lbc_tend_theta, lbc_tend_rtheta_m, lbc_tend_rho_zz, & + !$acc lbc_tend_rho, lbc_tend_scalars) + end if + !$acc enter data copyin(u, w, theta, rho, scalars) + !$acc enter data create(ru, rho_edge, rtheta_m, rho_zz) + MPAS_ACC_TIMER_STOP('mpas_atm_update_bdy_tend [ACC_data_xfer]') + + ! Dereference the pointers to avoid non-array pointer for OpenACC + nCells = nCells_ptr + nEdges = nEdges_ptr + nVertLevels = nVertLevels_ptr + nScalars = nScalars_ptr + index_qv = index_qv_ptr + ! Compute lbc_rho_zz - zz(:,nCells+1) = 1.0_RKIND ! Avoid potential division by zero in the following line - rho_zz(:,:) = rho(:,:) / zz(:,:) + !$acc parallel default(present) + !$acc loop vector + do k=1,nVertLevels + zz(k,nCells+1) = 1.0_RKIND ! Avoid potential division by zero in the following line + end do + !$acc end parallel + + !$acc parallel default(present) + !$acc loop gang vector collapse(2) + do iCell=1,nCells+1 + do k=1,nVertLevels + rho_zz(k,iCell) = rho(k,iCell) / zz(k,iCell) + end do + end do + !$acc end parallel ! Average lbc_rho_zz to edges + !$acc parallel default(present) + !$acc loop gang worker 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)) + !$acc loop vector + do k = 1, nVertLevels + rho_edge(k,iEdge) = 0.5_RKIND * (rho_zz(k,cell1) + rho_zz(k,cell2)) + end do end if end do + !$acc end parallel + + !$acc parallel default(present) + !$acc loop gang vector collapse(2) + do iEdge=1,nEdges+1 + do k=1,nVertLevels + ru(k,iEdge) = u(k,iEdge) * rho_edge(k,iEdge) + end do + end do - ru(:,:) = u(:,:) * rho_edge(:,:) - rtheta_m(:,:) = theta(:,:) * rho_zz(:,:) * (1.0_RKIND + rvord * scalars(index_qv,:,:)) + !$acc loop gang vector collapse(2) + do iCell=1,nCells+1 + do k=1,nVertLevels + rtheta_m(k,iCell) = theta(k,iCell) * rho_zz(k,iCell) * (1.0_RKIND + rvord * scalars(index_qv,k,iCell)) + end do + end do + !$acc end parallel if (.not. firstCall) then lbc_interval = currTime - LBC_intv_end @@ -189,37 +268,46 @@ subroutine mpas_atm_update_bdy_tend(clock, streamManager, block, firstCall, 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 + + !$acc parallel default(present) + !$acc loop gang vector collapse(2) + do iEdge=1,nEdges+1 + do k=1,nVertLevels + lbc_tend_u(k,iEdge) = (u(k,iEdge) - lbc_tend_u(k,iEdge)) * dt + lbc_tend_ru(k,iEdge) = (ru(k,iEdge) - lbc_tend_ru(k,iEdge)) * dt + lbc_tend_rho_edge(k,iEdge) = (rho_edge(k,iEdge) - lbc_tend_rho_edge(k,iEdge)) * dt + end do + end do + + !$acc loop gang vector collapse(2) + do iCell=1,nCells+1 + do k=1,nVertLevels+1 + lbc_tend_w(k,iCell) = (w(k,iCell) - lbc_tend_w(k,iCell)) * dt + end do + end do + + !$acc loop gang vector collapse(2) + do iCell=1,nCells+1 + do k=1,nVertLevels + lbc_tend_theta(k,iCell) = (theta(k,iCell) - lbc_tend_theta(k,iCell)) * dt + lbc_tend_rtheta_m(k,iCell) = (rtheta_m(k,iCell) - lbc_tend_rtheta_m(k,iCell)) * dt + lbc_tend_rho_zz(k,iCell) = (rho_zz(k,iCell) - lbc_tend_rho_zz(k,iCell)) * dt + lbc_tend_rho(k,iCell) = (rho(k,iCell) - lbc_tend_rho(k,iCell)) * dt + end do + end do + + !$acc loop gang + do iCell=1,nCells+1 + !$acc loop vector collapse(2) + do k=1,nVertLevels + do j = 1,nScalars + lbc_tend_scalars(j,k,iCell) = (scalars(j,k,iCell) - lbc_tend_scalars(j,k,iCell)) * dt + end do + end do + end do + !$acc end parallel ! ! Logging the lbc start and end times appears to be backwards, but @@ -235,6 +323,17 @@ subroutine mpas_atm_update_bdy_tend(clock, streamManager, block, firstCall, ierr end if + MPAS_ACC_TIMER_START('mpas_atm_update_bdy_tend [ACC_data_xfer]') + if (.not. firstCall) then + !$acc exit data copyout(lbc_tend_u, lbc_tend_ru, lbc_tend_rho_edge, lbc_tend_w, & + !$acc lbc_tend_theta, lbc_tend_rtheta_m, lbc_tend_rho_zz, & + !$acc lbc_tend_rho, lbc_tend_scalars) + end if + + !$acc exit data copyout(ru, rho_edge, rtheta_m, rho_zz) + !$acc exit data delete(u, w, theta, rho, scalars) + MPAS_ACC_TIMER_STOP('mpas_atm_update_bdy_tend [ACC_data_xfer]') + LBC_intv_end = currTime end subroutine mpas_atm_update_bdy_tend @@ -244,11 +343,11 @@ end subroutine mpas_atm_update_bdy_tend ! ! routine mpas_atm_get_bdy_tend ! - !> \brief Returns LBC tendencies a specified delta-t in the future + !> \brief Provide 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 + !> This subroutine returns an array with 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). @@ -256,7 +355,7 @@ end subroutine mpas_atm_update_bdy_tend !> 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 + !> horizDim=nEdges. This routine 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 @@ -264,16 +363,16 @@ end subroutine mpas_atm_update_bdy_tend !> the 'lbc' pool. For scalars, the field argument should give the name !> of the constituent, e.g., 'qv'. !> - !> Example calls to this function: + !> Example calls to this subroutine: !> - !> 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) + !> call mpas_atm_get_bdy_tend(clock, domain % blocklist, nVertLevels, nEdges, 'u', 0.0_RKIND, tend_u) + !> call mpas_atm_get_bdy_tend(clock, domain % blocklist, nVertLevels+1, nCells, 'w', 0.0_RKIND, tend_w) + !> call mpas_atm_get_bdy_tend(clock, domain % blocklist, nVertLevels, nCells, 'rho_zz', 0.0_RKIND, tend_rho_zz) + !> call mpas_atm_get_bdy_tend(clock, domain % blocklist, nVertLevels, nCells, 'theta', 0.0_RKIND, tend_theta) + !> call mpas_atm_get_bdy_tend(clock, domain % blocklist, nVertLevels, nCells, 'qv', 0.0_RKIND, tend_qv) ! !----------------------------------------------------------------------- - function mpas_atm_get_bdy_tend(clock, block, vertDim, horizDim, field, delta_t) result(return_tend) + subroutine mpas_atm_get_bdy_tend(clock, block, vertDim, horizDim, field, delta_t, return_tend) implicit none @@ -282,14 +381,13 @@ function mpas_atm_get_bdy_tend(clock, block, vertDim, horizDim, field, delta_t) 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 + real (kind=RKIND), dimension(vertDim,horizDim+1), intent(out) :: return_tend type (mpas_pool_type), pointer :: lbc - integer, pointer :: idx + integer, pointer :: idx_ptr real (kind=RKIND), dimension(:,:), pointer :: tend real (kind=RKIND), dimension(:,:,:), pointer :: tend_scalars - integer :: ierr + integer :: idx, i, j call mpas_pool_get_subpool(block % structs, 'lbc', lbc) @@ -297,27 +395,57 @@ function mpas_atm_get_bdy_tend(clock, block, vertDim, horizDim, field, delta_t) nullify(tend) call mpas_pool_get_array(lbc, 'lbc_'//trim(field), tend, 1) + MPAS_ACC_TIMER_START('mpas_atm_get_bdy_tend [ACC_data_xfer]') if (associated(tend)) then - return_tend(:,:) = tend(:,:) + !$acc enter data copyin(tend) else call mpas_pool_get_array(lbc, 'lbc_scalars', tend_scalars, 1) - call mpas_pool_get_dimension(lbc, 'index_'//trim(field), idx) + !$acc enter data copyin(tend_scalars) - return_tend(:,:) = tend_scalars(idx,:,:) + ! Ensure the integer pointed to by idx_ptr is copied to the gpu device + call mpas_pool_get_dimension(lbc, 'index_'//trim(field), idx_ptr) + idx = idx_ptr end if + MPAS_ACC_TIMER_STOP('mpas_atm_get_bdy_tend [ACC_data_xfer]') - end function mpas_atm_get_bdy_tend + !$acc parallel default(present) + if (associated(tend)) then + !$acc loop gang vector collapse(2) + do j=1,horizDim+1 + do i=1,vertDim + return_tend(i,j) = tend(i,j) + end do + end do + else + !$acc loop gang vector collapse(2) + do j=1,horizDim+1 + do i=1,vertDim + return_tend(i,j) = tend_scalars(idx,i,j) + end do + end do + end if + !$acc end parallel + + MPAS_ACC_TIMER_START('mpas_atm_get_bdy_tend [ACC_data_xfer]') + if (associated(tend)) then + !$acc exit data delete(tend) + else + !$acc exit data delete(tend_scalars) + end if + MPAS_ACC_TIMER_STOP('mpas_atm_get_bdy_tend [ACC_data_xfer]') + + end subroutine mpas_atm_get_bdy_tend !*********************************************************************** ! - ! routine mpas_atm_get_bdy_state + ! routine mpas_atm_get_bdy_state_2d ! - !> \brief Returns LBC state at a specified delta-t in the future + !> \brief Provides 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 + !> This subroutine 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). @@ -325,24 +453,24 @@ end function mpas_atm_get_bdy_tend !> 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 + !> horizDim=nEdges. This routine 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 + !> 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) + !> Example calls to this subroutine: + !> + !> call mpas_atm_get_bdy_state(clock, domain % blocklist, nVertLevels, nEdges, 'u', 0.0_RKIND, u) + !> call mpas_atm_get_bdy_state(clock, domain % blocklist, nVertLevels+1, nCells, 'w', 0.0_RKIND, w) + !> call mpas_atm_get_bdy_state(clock, domain % blocklist, nVertLevels, nCells, 'rho_zz', 0.0_RKIND, rho_zz) + !> call mpas_atm_get_bdy_state(clock, domain % blocklist, nVertLevels, nCells, 'theta', 0.0_RKIND, theta) + !> call mpas_atm_get_bdy_state(clock, domain % blocklist, nVertLevels, nCells, 'qv', 0.0_RKIND, scalars(1,:,:)) ! !----------------------------------------------------------------------- - function mpas_atm_get_bdy_state(clock, block, vertDim, horizDim, field, delta_t) result(return_state) + subroutine mpas_atm_get_bdy_state_2d(clock, block, vertDim, horizDim, field, delta_t, 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 @@ -354,11 +482,10 @@ function mpas_atm_get_bdy_state(clock, block, vertDim, horizDim, field, delta_t) 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 + real (kind=RKIND), dimension(vertDim,horizDim+1), intent(out) :: return_state type (mpas_pool_type), pointer :: lbc - integer, pointer :: idx + integer, pointer :: idx_ptr real (kind=RKIND), dimension(:,:), pointer :: tend real (kind=RKIND), dimension(:,:), pointer :: state real (kind=RKIND), dimension(:,:,:), pointer :: tend_scalars @@ -369,6 +496,7 @@ function mpas_atm_get_bdy_state(clock, block, vertDim, horizDim, field, delta_t) real (kind=RKIND) :: dt integer :: err_level integer :: ierr + integer :: i,j,idx currTime = mpas_get_clock_time(clock, MPAS_NOW, ierr) @@ -405,16 +533,145 @@ function mpas_atm_get_bdy_state(clock, block, vertDim, horizDim, field, delta_t) ! query the field as a scalar constituent ! if (associated(tend) .and. associated(state)) then - return_state(:,:) = state(:,:) - dt * tend(:,:) + MPAS_ACC_TIMER_START('mpas_atm_get_bdy_state_2d [ACC_data_xfer]') + !$acc enter data copyin(tend, state) + MPAS_ACC_TIMER_STOP('mpas_atm_get_bdy_state_2d [ACC_data_xfer]') + + !$acc parallel default(present) + !$acc loop gang vector collapse(2) + do i=1, horizDim+1 + do j=1, vertDim + return_state(j,i) = state(j,i) - dt * tend(j,i) + end do + end do + !$acc end parallel + + MPAS_ACC_TIMER_START('mpas_atm_get_bdy_state_2d [ACC_data_xfer]') + !$acc exit data delete(tend, state) + MPAS_ACC_TIMER_STOP('mpas_atm_get_bdy_state_2d [ACC_data_xfer]') 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) + call mpas_pool_get_dimension(lbc, 'index_'//trim(field), idx_ptr) + + idx=idx_ptr ! Avoid non-array pointer for OpenACC + + MPAS_ACC_TIMER_START('mpas_atm_get_bdy_state_2d [ACC_data_xfer]') + !$acc enter data copyin(tend_scalars, state_scalars) + MPAS_ACC_TIMER_STOP('mpas_atm_get_bdy_state_2d [ACC_data_xfer]') - return_state(:,:) = state_scalars(idx,:,:) - dt * tend_scalars(idx,:,:) + !$acc parallel default(present) + !$acc loop gang vector collapse(2) + do i=1, horizDim+1 + do j=1, vertDim + return_state(j,i) = state_scalars(idx,j,i) - dt * tend_scalars(idx,j,i) + end do + end do + !$acc end parallel + + MPAS_ACC_TIMER_START('mpas_atm_get_bdy_state_2d [ACC_data_xfer]') + !$acc exit data delete(tend_scalars, state_scalars) + MPAS_ACC_TIMER_STOP('mpas_atm_get_bdy_state_2d [ACC_data_xfer]') end if - end function mpas_atm_get_bdy_state + end subroutine mpas_atm_get_bdy_state_2d + + + !*********************************************************************** + ! + ! routine mpas_atm_get_bdy_state_3d + ! + !> \brief Provides LBC state at a specified delta-t in the future + !> \author Michael Duda + !> \date 4 September 2024 + !> \details + !> This subroutine 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 innerDim, 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 'scalars' field would set + !> innerDim=num_scalars, vertDim=nVertLevels, and horizDim=nCells. This + !> routine 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. + !> + !> Example call to this subroutine: + !> + !> call mpas_atm_get_bdy_state(clock, domain % blocklist, & + !> num_scalars, nVertLevels, nCells, 'scalars', & + !> 0.0_RKIND, scalars) + ! + !----------------------------------------------------------------------- + subroutine mpas_atm_get_bdy_state_3d(clock, block, innerDim, vertDim, horizDim, field, delta_t, 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) :: innerDim, vertDim, horizDim + character(len=*), intent(in) :: field + real (kind=RKIND), intent(in) :: delta_t + real (kind=RKIND), dimension(innerDim,vertDim,horizDim+1), intent(out) :: return_state + + type (mpas_pool_type), pointer :: lbc + real (kind=RKIND), dimension(:,:,:), pointer :: tend + real (kind=RKIND), dimension(:,:,:), pointer :: state + 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 + integer :: i,j,k + + + 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) + + 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) + + MPAS_ACC_TIMER_START('mpas_atm_get_bdy_state_3d [ACC_data_xfer]') + !$acc enter data copyin(tend, state) + MPAS_ACC_TIMER_STOP('mpas_atm_get_bdy_state_3d [ACC_data_xfer]') + + !$acc parallel default(present) + !$acc loop gang vector collapse(3) + do i=1, horizDim+1 + do j=1, vertDim + do k=1, innerDim + return_state(k,j,i) = state(k,j,i) - dt * tend(k,j,i) + end do + end do + end do + !$acc end parallel + + MPAS_ACC_TIMER_START('mpas_atm_get_bdy_state_3d [ACC_data_xfer]') + !$acc exit data delete(tend, state) + MPAS_ACC_TIMER_STOP('mpas_atm_get_bdy_state_3d [ACC_data_xfer]') + + end subroutine mpas_atm_get_bdy_state_3d !*********************************************************************** diff --git a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F index 42c5059a3..23221c12d 100644 --- a/src/core_atmosphere/dynamics/mpas_atm_time_integration.F +++ b/src/core_atmosphere/dynamics/mpas_atm_time_integration.F @@ -6,6 +6,14 @@ ! distributed with this code, or at http://mpas-dev.github.com/license.html ! +#ifdef MPAS_OPENACC +#define MPAS_ACC_TIMER_START(X) call mpas_timer_start(X) +#define MPAS_ACC_TIMER_STOP(X) call mpas_timer_stop(X) +#else +#define MPAS_ACC_TIMER_START(X) +#define MPAS_ACC_TIMER_STOP(X) +#endif + module atm_time_integration use mpas_derived_types @@ -57,9 +65,13 @@ end subroutine halo_exchange_routine ! real (kind=RKIND), allocatable, dimension(:,:) :: delsq_circulation ! no longer used -> removed real (kind=RKIND), allocatable, dimension(:,:) :: delsq_vorticity real (kind=RKIND), allocatable, dimension(:,:) :: dpdz + !$acc declare create(qtot) + !$acc declare create(delsq_theta, delsq_w, delsq_divergence) + !$acc declare create(delsq_u, delsq_vorticity, dpdz) ! Used in atm_advance_scalars real (kind=RKIND), dimension(:,:,:), allocatable :: horiz_flux_array + !$acc declare create(horiz_flux_array) ! Used in atm_advance_scalars_mono real (kind=RKIND), dimension(:,:), allocatable :: scalar_old_arr, scalar_new_arr @@ -69,20 +81,34 @@ end subroutine halo_exchange_routine real (kind=RKIND), dimension(:,:), allocatable :: flux_tmp_arr real (kind=RKIND), dimension(:,:), allocatable :: wdtn_arr real (kind=RKIND), dimension(:,:), allocatable :: rho_zz_int + !$acc declare create(scalar_old_arr, scalar_new_arr) + !$acc declare create(s_max_arr, s_min_arr) + !$acc declare create(flux_array, flux_upwind_tmp_arr) + !$acc declare create(flux_tmp_arr, wdtn_arr) - 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 + !$acc declare create(ru_driving_tend) + !$acc declare create(rt_driving_tend) + !$acc declare create(rho_driving_tend) + + real (kind=RKIND), dimension(:,:,:), allocatable :: scalars_driving ! 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 + !$acc declare create(scalars_driving) + !$acc declare create(ru_driving_values) + !$acc declare create(rt_driving_values) + !$acc declare create(rho_driving_values) + integer, dimension(:), pointer :: bdyMaskEdge ! regional_MPAS addition - logical, pointer :: config_apply_lbcs + logical :: config_apply_lbcs ! Used in compute_solve_diagnostics real (kind=RKIND), allocatable, dimension(:,:) :: ke_vertex real (kind=RKIND), allocatable, dimension(:,:) :: ke_edge + !$acc declare create(ke_vertex, ke_edge) type (MPAS_Clock_type), pointer, private :: clock type (block_type), pointer, private :: block @@ -188,6 +214,65 @@ subroutine mpas_atm_dynamics_init(domain) type (field2DReal), pointer :: tend_ru_physicsField, tend_rtheta_physicsField, tend_rho_physicsField #endif +#ifdef MPAS_OPENACC + type (mpas_pool_type), pointer :: mesh + + real (kind=RKIND), dimension(:), pointer :: dvEdge + integer, dimension(:,:), pointer :: cellsOnCell + integer, dimension(:,:), pointer :: cellsOnEdge + integer, dimension(:,:), pointer :: advCellsForEdge + integer, dimension(:,:), pointer :: edgesOnCell + integer, dimension(:), pointer :: nAdvCellsForEdge + integer, dimension(:), pointer :: nEdgesOnCell + real (kind=RKIND), dimension(:,:), pointer :: adv_coefs + real (kind=RKIND), dimension(:,:), pointer :: adv_coefs_3rd + real (kind=RKIND), dimension(:,:), pointer :: edgesOnCell_sign + real (kind=RKIND), dimension(:), pointer :: invAreaCell + integer, dimension(:), pointer :: bdyMaskCell + integer, dimension(:), pointer :: bdyMaskEdge + real (kind=RKIND), dimension(:), pointer :: specZoneMaskEdge + real (kind=RKIND), dimension(:), pointer :: invDvEdge + real (kind=RKIND), dimension(:), pointer :: dcEdge + real (kind=RKIND), dimension(:), pointer :: invDcEdge + integer, dimension(:,:), pointer :: edgesOnEdge + integer, dimension(:,:), pointer :: edgesOnVertex + real (kind=RKIND), dimension(:,:), pointer :: edgesOnVertex_sign + integer, dimension(:), pointer :: nEdgesOnEdge + real (kind=RKIND), dimension(:,:), pointer :: weightsOnEdge + integer, dimension(:,:), pointer :: cellsOnVertex + integer, dimension(:,:), pointer :: verticesOnCell + integer, dimension(:,:), pointer :: verticesOnEdge + real (kind=RKIND), dimension(:), pointer :: invAreaTriangle + integer, dimension(:,:), pointer :: kiteForCell + real (kind=RKIND), dimension(:,:), pointer :: kiteAreasOnVertex + real (kind=RKIND), dimension(:), pointer :: fEdge + real (kind=RKIND), dimension(:), pointer :: fVertex + real (kind=RKIND), dimension(:,:), pointer :: zz + real (kind=RKIND), dimension(:), pointer :: rdzw + real (kind=RKIND), dimension(:), pointer :: rdzu + real (kind=RKIND), dimension(:,:,:), pointer :: zb_cell + real (kind=RKIND), dimension(:,:,:), pointer :: zb3_cell + real (kind=RKIND), dimension(:), pointer :: fzm + real (kind=RKIND), dimension(:), pointer :: fzp + real (kind=RKIND), dimension(:,:,:), pointer :: zb + real (kind=RKIND), dimension(:,:,:), pointer :: zb3 + integer, dimension(:), pointer :: nearestRelaxationCell + real (kind=RKIND), dimension(:,:), pointer :: zgrid + real (kind=RKIND), dimension(:,:), pointer :: zxu + real (kind=RKIND), dimension(:,:), pointer :: dss + real (kind=RKIND), dimension(:), pointer :: specZoneMaskCell + real (kind=RKIND), dimension(:), pointer :: meshScalingRegionalCell + real (kind=RKIND), dimension(:), pointer :: meshScalingRegionalEdge + real (kind=RKIND), dimension(:), pointer :: latCell + real (kind=RKIND), dimension(:), pointer :: lonCell + real (kind=RKIND), dimension(:,:,:), pointer :: coeffs_reconstruct + real (kind=RKIND), dimension(:,:), pointer :: defc_a + real (kind=RKIND), dimension(:,:), pointer :: defc_b + real (kind=RKIND), dimension(:), pointer :: latEdge + real (kind=RKIND), dimension(:), pointer :: angleEdge + real (kind=RKIND), dimension(:), pointer :: meshScalingDel2 + real (kind=RKIND), dimension(:), pointer :: meshScalingDel4 +#endif #ifdef MPAS_CAM_DYCORE nullify(tend_physics) @@ -203,6 +288,176 @@ subroutine mpas_atm_dynamics_init(domain) call mpas_allocate_scratch_field(tend_ru_physicsField) #endif +#ifdef MPAS_OPENACC + nullify(mesh) + call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', mesh) + + call mpas_pool_get_array(mesh, 'dvEdge', dvEdge) + !$acc enter data copyin(dvEdge) + + call mpas_pool_get_array(mesh, 'cellsOnCell', cellsOnCell) + !$acc enter data copyin(cellsOnCell) + + call mpas_pool_get_array(mesh, 'cellsOnEdge', cellsOnEdge) + !$acc enter data copyin(cellsOnEdge) + + call mpas_pool_get_array(mesh, 'advCellsForEdge', advCellsForEdge) + !$acc enter data copyin(advCellsForEdge) + + call mpas_pool_get_array(mesh, 'edgesOnCell', edgesOnCell) + !$acc enter data copyin(edgesOnCell) + + call mpas_pool_get_array(mesh, 'nAdvCellsForEdge', nAdvCellsForEdge) + !$acc enter data copyin(nAdvCellsForEdge) + + call mpas_pool_get_array(mesh, 'nEdgesOnCell', nEdgesOnCell) + !$acc enter data copyin(nEdgesOnCell) + + call mpas_pool_get_array(mesh, 'adv_coefs', adv_coefs) + !$acc enter data copyin(adv_coefs) + + call mpas_pool_get_array(mesh, 'adv_coefs_3rd', adv_coefs_3rd) + !$acc enter data copyin(adv_coefs_3rd) + + call mpas_pool_get_array(mesh, 'edgesOnCell_sign', edgesOnCell_sign) + !$acc enter data copyin(edgesOnCell_sign) + + call mpas_pool_get_array(mesh, 'invAreaCell', invAreaCell) + !$acc enter data copyin(invAreaCell) + + call mpas_pool_get_array(mesh, 'bdyMaskCell', bdyMaskCell) + !$acc enter data copyin(bdyMaskCell) + + call mpas_pool_get_array(mesh, 'bdyMaskEdge', bdyMaskEdge) + !$acc enter data copyin(bdyMaskEdge) + + call mpas_pool_get_array(mesh, 'specZoneMaskEdge', specZoneMaskEdge) + !$acc enter data copyin(specZoneMaskEdge) + + call mpas_pool_get_array(mesh, 'invDvEdge', invDvEdge) + !$acc enter data copyin(invDvEdge) + + call mpas_pool_get_array(mesh, 'dcEdge', dcEdge) + !$acc enter data copyin(dcEdge) + + call mpas_pool_get_array(mesh, 'invDcEdge', invDcEdge) + !$acc enter data copyin(invDcEdge) + + call mpas_pool_get_array(mesh, 'edgesOnEdge', edgesOnEdge) + !$acc enter data copyin(edgesOnEdge) + + call mpas_pool_get_array(mesh, 'edgesOnVertex', edgesOnVertex) + !$acc enter data copyin(edgesOnVertex) + + call mpas_pool_get_array(mesh, 'edgesOnVertex_sign', edgesOnVertex_sign) + !$acc enter data copyin(edgesOnVertex_sign) + + call mpas_pool_get_array(mesh, 'nEdgesOnEdge', nEdgesOnEdge) + !$acc enter data copyin(nEdgesOnEdge) + + call mpas_pool_get_array(mesh, 'weightsOnEdge', weightsOnEdge) + !$acc enter data copyin(weightsOnEdge) + + call mpas_pool_get_array(mesh, 'cellsOnVertex', cellsOnVertex) + !$acc enter data copyin(cellsOnVertex) + + call mpas_pool_get_array(mesh, 'verticesOnCell', verticesOnCell) + !$acc enter data copyin(verticesOnCell) + + call mpas_pool_get_array(mesh, 'verticesOnEdge', verticesOnEdge) + !$acc enter data copyin(verticesOnEdge) + + call mpas_pool_get_array(mesh, 'invAreaTriangle', invAreaTriangle) + !$acc enter data copyin(invAreaTriangle) + + call mpas_pool_get_array(mesh, 'kiteForCell', kiteForCell) + !$acc enter data copyin(kiteForCell) + + call mpas_pool_get_array(mesh, 'kiteAreasOnVertex', kiteAreasOnVertex) + !$acc enter data copyin(kiteAreasOnVertex) + + call mpas_pool_get_array(mesh, 'fVertex', fVertex) + !$acc enter data copyin(fVertex) + + call mpas_pool_get_array(mesh, 'fEdge', fEdge) + !$acc enter data copyin(fEdge) + + call mpas_pool_get_array(mesh, 'zz', zz) + !$acc enter data copyin(zz) + + call mpas_pool_get_array(mesh, 'rdzw', rdzw) + !$acc enter data copyin(rdzw) + + call mpas_pool_get_array(mesh, 'rdzu', rdzu) + !$acc enter data copyin(rdzu) + + call mpas_pool_get_array(mesh, 'zb_cell', zb_cell) + !$acc enter data copyin(zb_cell) + + call mpas_pool_get_array(mesh, 'zb3_cell', zb3_cell) + !$acc enter data copyin(zb3_cell) + + call mpas_pool_get_array(mesh, 'fzm', fzm) + !$acc enter data copyin(fzm) + + call mpas_pool_get_array(mesh, 'fzp', fzp) + !$acc enter data copyin(fzp) + + call mpas_pool_get_array(mesh, 'zb', zb) + !$acc enter data copyin(zb) + + call mpas_pool_get_array(mesh, 'zb3', zb3) + !$acc enter data copyin(zb3) + + call mpas_pool_get_array(mesh, 'nearestRelaxationCell', nearestRelaxationCell) + !$acc enter data copyin(nearestRelaxationCell) + + call mpas_pool_get_array(mesh, 'zgrid', zgrid) + !$acc enter data copyin(zgrid) + + call mpas_pool_get_array(mesh, 'zxu', zxu) + !$acc enter data copyin(zxu) + + call mpas_pool_get_array(mesh, 'dss', dss) + !$acc enter data copyin(dss) + + call mpas_pool_get_array(mesh, 'specZoneMaskCell', specZoneMaskCell) + !$acc enter data copyin(specZoneMaskCell) + + call mpas_pool_get_array(mesh, 'meshScalingRegionalCell', meshScalingRegionalCell) + !$acc enter data copyin(meshScalingRegionalCell) + + call mpas_pool_get_array(mesh, 'meshScalingRegionalEdge', meshScalingRegionalEdge) + !$acc enter data copyin(meshScalingRegionalEdge) + + call mpas_pool_get_array(mesh, 'latCell', latCell) + !$acc enter data copyin(latCell) + + call mpas_pool_get_array(mesh, 'lonCell', lonCell) + !$acc enter data copyin(lonCell) + + call mpas_pool_get_array(mesh, 'coeffs_reconstruct', coeffs_reconstruct) + !$acc enter data copyin(coeffs_reconstruct) + + call mpas_pool_get_array(mesh, 'defc_a', defc_a) + !$acc enter data copyin(defc_a) + + call mpas_pool_get_array(mesh, 'defc_b', defc_b) + !$acc enter data copyin(defc_b) + + call mpas_pool_get_array(mesh, 'latEdge', latEdge) + !$acc enter data copyin(latEdge) + + call mpas_pool_get_array(mesh, 'angleEdge', angleEdge) + !$acc enter data copyin(angleEdge) + + call mpas_pool_get_array(mesh, 'meshScalingDel2', meshScalingDel2) + !$acc enter data copyin(meshScalingDel2) + + call mpas_pool_get_array(mesh, 'meshScalingDel4', meshScalingDel4) + !$acc enter data copyin(meshScalingDel4) +#endif + end subroutine mpas_atm_dynamics_init @@ -233,6 +488,66 @@ subroutine mpas_atm_dynamics_finalize(domain) type (field2DReal), pointer :: tend_ru_physicsField, tend_rtheta_physicsField, tend_rho_physicsField #endif +#ifdef MPAS_OPENACC + type (mpas_pool_type), pointer :: mesh + + real (kind=RKIND), dimension(:), pointer :: dvEdge + integer, dimension(:,:), pointer :: cellsOnCell + integer, dimension(:,:), pointer :: cellsOnEdge + integer, dimension(:,:), pointer :: advCellsForEdge + integer, dimension(:,:), pointer :: edgesOnCell + integer, dimension(:), pointer :: nAdvCellsForEdge + integer, dimension(:), pointer :: nEdgesOnCell + real (kind=RKIND), dimension(:,:), pointer :: adv_coefs + real (kind=RKIND), dimension(:,:), pointer :: adv_coefs_3rd + real (kind=RKIND), dimension(:,:), pointer :: edgesOnCell_sign + real (kind=RKIND), dimension(:), pointer :: invAreaCell + integer, dimension(:), pointer :: bdyMaskCell + integer, dimension(:), pointer :: bdyMaskEdge + real (kind=RKIND), dimension(:), pointer :: specZoneMaskEdge + real (kind=RKIND), dimension(:), pointer :: invDvEdge + real (kind=RKIND), dimension(:), pointer :: dcEdge + real (kind=RKIND), dimension(:), pointer :: invDcEdge + integer, dimension(:,:), pointer :: edgesOnEdge + integer, dimension(:,:), pointer :: edgesOnVertex + real (kind=RKIND), dimension(:,:), pointer :: edgesOnVertex_sign + integer, dimension(:), pointer :: nEdgesOnEdge + real (kind=RKIND), dimension(:,:), pointer :: weightsOnEdge + integer, dimension(:,:), pointer :: cellsOnVertex + integer, dimension(:,:), pointer :: verticesOnCell + integer, dimension(:,:), pointer :: verticesOnEdge + real (kind=RKIND), dimension(:), pointer :: invAreaTriangle + integer, dimension(:,:), pointer :: kiteForCell + real (kind=RKIND), dimension(:,:), pointer :: kiteAreasOnVertex + real (kind=RKIND), dimension(:), pointer :: fEdge + real (kind=RKIND), dimension(:), pointer :: fVertex + real (kind=RKIND), dimension(:,:), pointer :: zz + real (kind=RKIND), dimension(:), pointer :: rdzw + real (kind=RKIND), dimension(:), pointer :: rdzu + real (kind=RKIND), dimension(:,:,:), pointer :: zb_cell + real (kind=RKIND), dimension(:,:,:), pointer :: zb3_cell + real (kind=RKIND), dimension(:), pointer :: fzm + real (kind=RKIND), dimension(:), pointer :: fzp + real (kind=RKIND), dimension(:,:,:), pointer :: zb + real (kind=RKIND), dimension(:,:,:), pointer :: zb3 + integer, dimension(:), pointer :: nearestRelaxationCell + real (kind=RKIND), dimension(:,:), pointer :: zgrid + real (kind=RKIND), dimension(:,:), pointer :: zxu + real (kind=RKIND), dimension(:,:), pointer :: dss + real (kind=RKIND), dimension(:), pointer :: specZoneMaskCell + real (kind=RKIND), dimension(:), pointer :: meshScalingRegionalCell + real (kind=RKIND), dimension(:), pointer :: meshScalingRegionalEdge + real (kind=RKIND), dimension(:), pointer :: latCell + real (kind=RKIND), dimension(:), pointer :: lonCell + real (kind=RKIND), dimension(:,:,:), pointer :: coeffs_reconstruct + real (kind=RKIND), dimension(:,:), pointer :: defc_a + real (kind=RKIND), dimension(:,:), pointer :: defc_b + real (kind=RKIND), dimension(:), pointer :: latEdge + real (kind=RKIND), dimension(:), pointer :: angleEdge + real (kind=RKIND), dimension(:), pointer :: meshScalingDel2 + real (kind=RKIND), dimension(:), pointer :: meshScalingDel4 +#endif + #ifdef MPAS_CAM_DYCORE nullify(tend_physics) @@ -248,6 +563,176 @@ subroutine mpas_atm_dynamics_finalize(domain) call mpas_deallocate_scratch_field(tend_ru_physicsField) #endif +#ifdef MPAS_OPENACC + nullify(mesh) + call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', mesh) + + call mpas_pool_get_array(mesh, 'dvEdge', dvEdge) + !$acc exit data delete(dvEdge) + + call mpas_pool_get_array(mesh, 'cellsOnCell', cellsOnCell) + !$acc exit data delete(cellsOnCell) + + call mpas_pool_get_array(mesh, 'cellsOnEdge', cellsOnEdge) + !$acc exit data delete(cellsOnEdge) + + call mpas_pool_get_array(mesh, 'advCellsForEdge', advCellsForEdge) + !$acc exit data delete(advCellsForEdge) + + call mpas_pool_get_array(mesh, 'edgesOnCell', edgesOnCell) + !$acc exit data delete(edgesOnCell) + + call mpas_pool_get_array(mesh, 'nAdvCellsForEdge', nAdvCellsForEdge) + !$acc exit data delete(nAdvCellsForEdge) + + call mpas_pool_get_array(mesh, 'nEdgesOnCell', nEdgesOnCell) + !$acc exit data delete(nEdgesOnCell) + + call mpas_pool_get_array(mesh, 'adv_coefs', adv_coefs) + !$acc exit data delete(adv_coefs) + + call mpas_pool_get_array(mesh, 'adv_coefs_3rd', adv_coefs_3rd) + !$acc exit data delete(adv_coefs_3rd) + + call mpas_pool_get_array(mesh, 'edgesOnCell_sign', edgesOnCell_sign) + !$acc exit data delete(edgesOnCell_sign) + + call mpas_pool_get_array(mesh, 'invAreaCell', invAreaCell) + !$acc exit data delete(invAreaCell) + + call mpas_pool_get_array(mesh, 'bdyMaskCell', bdyMaskCell) + !$acc exit data delete(bdyMaskCell) + + call mpas_pool_get_array(mesh, 'bdyMaskEdge', bdyMaskEdge) + !$acc exit data delete(bdyMaskEdge) + + call mpas_pool_get_array(mesh, 'specZoneMaskEdge', specZoneMaskEdge) + !$acc exit data delete(specZoneMaskEdge) + + call mpas_pool_get_array(mesh, 'invDvEdge', invDvEdge) + !$acc exit data delete(invDvEdge) + + call mpas_pool_get_array(mesh, 'dcEdge', dcEdge) + !$acc exit data delete(dcEdge) + + call mpas_pool_get_array(mesh, 'invDcEdge', invDcEdge) + !$acc exit data delete(invDcEdge) + + call mpas_pool_get_array(mesh, 'edgesOnEdge', edgesOnEdge) + !$acc exit data delete(edgesOnEdge) + + call mpas_pool_get_array(mesh, 'edgesOnVertex', edgesOnVertex) + !$acc exit data delete(edgesOnVertex) + + call mpas_pool_get_array(mesh, 'edgesOnVertex_sign', edgesOnVertex_sign) + !$acc exit data delete(edgesOnVertex_sign) + + call mpas_pool_get_array(mesh, 'nEdgesOnEdge', nEdgesOnEdge) + !$acc exit data delete(nEdgesOnEdge) + + call mpas_pool_get_array(mesh, 'weightsOnEdge', weightsOnEdge) + !$acc exit data delete(weightsOnEdge) + + call mpas_pool_get_array(mesh, 'cellsOnVertex', cellsOnVertex) + !$acc exit data delete(cellsOnVertex) + + call mpas_pool_get_array(mesh, 'verticesOnCell', verticesOnCell) + !$acc exit data delete(verticesOnCell) + + call mpas_pool_get_array(mesh, 'verticesOnEdge', verticesOnEdge) + !$acc exit data delete(verticesOnEdge) + + call mpas_pool_get_array(mesh, 'invAreaTriangle', invAreaTriangle) + !$acc exit data delete(invAreaTriangle) + + call mpas_pool_get_array(mesh, 'kiteForCell', kiteForCell) + !$acc exit data delete(kiteForCell) + + call mpas_pool_get_array(mesh, 'kiteAreasOnVertex', kiteAreasOnVertex) + !$acc exit data delete(kiteAreasOnVertex) + + call mpas_pool_get_array(mesh, 'fVertex', fVertex) + !$acc exit data delete(fVertex) + + call mpas_pool_get_array(mesh, 'fEdge', fEdge) + !$acc exit data delete(fEdge) + + call mpas_pool_get_array(mesh, 'zz', zz) + !$acc exit data delete(zz) + + call mpas_pool_get_array(mesh, 'rdzw', rdzw) + !$acc exit data delete(rdzw) + + call mpas_pool_get_array(mesh, 'rdzu', rdzu) + !$acc exit data delete(rdzu) + + call mpas_pool_get_array(mesh, 'zb_cell', zb_cell) + !$acc exit data delete(zb_cell) + + call mpas_pool_get_array(mesh, 'zb3_cell', zb3_cell) + !$acc exit data delete(zb3_cell) + + call mpas_pool_get_array(mesh, 'fzm', fzm) + !$acc exit data delete(fzm) + + call mpas_pool_get_array(mesh, 'fzp', fzp) + !$acc exit data delete(fzp) + + call mpas_pool_get_array(mesh, 'zb', zb) + !$acc exit data delete(zb) + + call mpas_pool_get_array(mesh, 'zb3', zb3) + !$acc exit data delete(zb3) + + call mpas_pool_get_array(mesh, 'nearestRelaxationCell', nearestRelaxationCell) + !$acc exit data delete(nearestRelaxationCell) + + call mpas_pool_get_array(mesh, 'zgrid', zgrid) + !$acc exit data delete(zgrid) + + call mpas_pool_get_array(mesh, 'zxu', zxu) + !$acc exit data delete(zxu) + + call mpas_pool_get_array(mesh, 'dss', dss) + !$acc exit data delete(dss) + + call mpas_pool_get_array(mesh, 'specZoneMaskCell', specZoneMaskCell) + !$acc exit data delete(specZoneMaskCell) + + call mpas_pool_get_array(mesh, 'meshScalingRegionalCell', meshScalingRegionalCell) + !$acc exit data delete(meshScalingRegionalCell) + + call mpas_pool_get_array(mesh, 'meshScalingRegionalEdge', meshScalingRegionalEdge) + !$acc exit data delete(meshScalingRegionalEdge) + + call mpas_pool_get_array(mesh, 'latCell', latCell) + !$acc exit data delete(latCell) + + call mpas_pool_get_array(mesh, 'lonCell', lonCell) + !$acc exit data delete(lonCell) + + call mpas_pool_get_array(mesh, 'coeffs_reconstruct', coeffs_reconstruct) + !$acc exit data delete(coeffs_reconstruct) + + call mpas_pool_get_array(mesh, 'defc_a', defc_a) + !$acc exit data delete(defc_a) + + call mpas_pool_get_array(mesh, 'defc_b', defc_b) + !$acc exit data delete(defc_b) + + call mpas_pool_get_array(mesh, 'latEdge', latEdge) + !$acc exit data delete(latEdge) + + call mpas_pool_get_array(mesh, 'angleEdge', angleEdge) + !$acc exit data delete(angleEdge) + + call mpas_pool_get_array(mesh, 'meshScalingDel2', meshScalingDel2) + !$acc exit data delete(meshScalingDel2) + + call mpas_pool_get_array(mesh, 'meshScalingDel4', meshScalingDel4) + !$acc exit data delete(meshScalingDel4) +#endif + end subroutine mpas_atm_dynamics_finalize @@ -278,13 +763,16 @@ subroutine atm_timestep(domain, dt, nowTime, itimestep, exchange_halo_group) real (kind=RKIND) :: Time_new type (mpas_pool_type), pointer :: state character (len=StrKIND), pointer :: config_time_integration + logical, pointer :: config_apply_lbcs_ptr clock => domain % clock block => domain % blocklist call mpas_pool_get_config(block % configs, 'config_time_integration', config_time_integration) - call mpas_pool_get_config(block % configs, 'config_apply_lbcs', config_apply_lbcs) + call mpas_pool_get_config(block % configs, 'config_apply_lbcs', config_apply_lbcs_ptr) + + config_apply_lbcs = config_apply_lbcs_ptr if (trim(config_time_integration) == 'SRK3') then call atm_srk3(domain, dt, itimestep, exchange_halo_group) @@ -362,13 +850,13 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) logical, pointer :: config_scalar_advection logical, pointer :: config_positive_definite logical, pointer :: config_monotonic - real (kind=RKIND), pointer :: config_dt character (len=StrKIND), pointer :: config_microp_scheme 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 - integer, pointer :: index_buoyx, index_cnvcf + integer, pointer :: index_qv, nCellsSolve, nVertices_ptr, nVerticesSolve + integer, pointer :: nCells_ptr, nEdges_ptr, nEdgesSolve_ptr + integer, pointer :: nVertLevels_ptr, num_scalars_ptr + integer :: nCells, nEdges, nVertices, nEdgesSolve, nVertLevels, num_scalars character(len=StrKIND), pointer :: config_IAU_option @@ -404,7 +892,6 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) call mpas_pool_get_config(block % configs, 'config_scalar_advection', config_scalar_advection) call mpas_pool_get_config(block % configs, 'config_positive_definite', config_positive_definite) call mpas_pool_get_config(block % configs, 'config_monotonic', config_monotonic) - call mpas_pool_get_config(block % configs, 'config_dt', config_dt) call mpas_pool_get_config(block % configs, 'config_IAU_option', config_IAU_option) ! config variables for dynamics-transport splitting, WCS 18 November 2014 call mpas_pool_get_config(block % configs, 'config_split_dynamics_transport', config_split_dynamics_transport) @@ -431,16 +918,25 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) ! Retrieve dimensions ! Note: nCellsSolve and nVerticesSolve are not currently used in this function ! - call mpas_pool_get_dimension(mesh, 'nCells', nCells) + call mpas_pool_get_dimension(mesh, 'nCells', nCells_ptr) call mpas_pool_get_dimension(mesh, 'nCellsSolve', nCellsSolve) - call mpas_pool_get_dimension(mesh, 'nEdges', nEdges) - call mpas_pool_get_dimension(mesh, 'nVertices', nVertices) - call mpas_pool_get_dimension(mesh, 'nVertLevels', nVertLevels) + call mpas_pool_get_dimension(mesh, 'nEdges', nEdges_ptr) + call mpas_pool_get_dimension(mesh, 'nVertices', nVertices_ptr) + call mpas_pool_get_dimension(mesh, 'nVertLevels', nVertLevels_ptr) !call mpas_pool_get_dimension(mesh, 'nCellsSolve', nCellsSolve) - call mpas_pool_get_dimension(mesh, 'nEdgesSolve', nEdgesSolve) + call mpas_pool_get_dimension(mesh, 'nEdgesSolve', nEdgesSolve_ptr) !call mpas_pool_get_dimension(mesh, 'nVerticesSolve', nVerticesSolve) + ! For OpenACC parallel regions, use regular scalar integers for loop + ! bounds rather than pointers to integers, as the former are implicitly + ! copied to the device + nEdges = nEdges_ptr + nCells = nCells_ptr + nVertices = nVertices_ptr + nEdgesSolve = nEdgesSolve_ptr + nVertLevels = nVertLevels_ptr + call mpas_pool_get_dimension(block % dimensions, 'nThreads', nThreads) call mpas_pool_get_dimension(block % dimensions, 'cellThreadStart', cellThreadStart) @@ -462,26 +958,19 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) #ifdef DO_PHYSICS call mpas_pool_get_dimension(state, 'index_qv', index_qv) #endif - if (config_apply_lbcs) then - call mpas_pool_get_dimension(state, 'num_scalars', num_scalars) - 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(state, 'index_buoyx', index_buoyx) - call mpas_pool_get_dimension(state, 'index_cnvcf', index_cnvcf) - - endif + call mpas_pool_get_dimension(state, 'num_scalars', num_scalars_ptr) + num_scalars = num_scalars_ptr ! ! allocate storage for physics tendency save ! allocate(qtot(nVertLevels,nCells+1)) - qtot(:,nCells+1) = 0.0_RKIND + !$acc parallel default(present) + !$acc loop vector + do k = 1, nVertLevels + qtot(k,nCells+1) = 0.0_RKIND + end do + !$acc end parallel #ifndef MPAS_CAM_DYCORE call mpas_pool_get_field(tend_physics, 'tend_rtheta_physics', tend_rtheta_physicsField) @@ -557,7 +1046,7 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) !$OMP PARALLEL DO do thread=1,nThreads - call atm_rk_integration_setup(state, diag, & + call atm_rk_integration_setup(state, diag, nVertLevels, num_scalars, & cellThreadStart(thread), cellThreadEnd(thread), & vertexThreadStart(thread), vertexThreadEnd(thread), & edgeThreadStart(thread), edgeThreadEnd(thread), & @@ -589,7 +1078,7 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) call mpas_timer_start('physics_get_tend') rk_step = 1 dynamics_substep = 1 - call physics_get_tend( block, mesh, state, diag, diag_physics,tend, tend_physics, & + call physics_get_tend( block, mesh, state, diag, tend, tend_physics, & block % configs, rk_step, dynamics_substep, & tend_ru_physics, tend_rtheta_physics, tend_rho_physics, & exchange_halo_group ) @@ -660,19 +1149,25 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) call mpas_timer_start('atm_compute_dyn_tend') allocate(delsq_theta(nVertLevels,nCells+1)) - delsq_theta(:,nCells+1) = 0.0_RKIND allocate(delsq_w(nVertLevels,nCells+1)) - delsq_w(:,nCells+1) = 0.0_RKIND -!! allocate(qtot(nVertLevels,nCells+1)) ! initializing this earlier in solution sequence + !! allocate(qtot(nVertLevels,nCells+1)) ! initializing this earlier in solution sequence allocate(delsq_divergence(nVertLevels,nCells+1)) - delsq_divergence(:,nCells+1) = 0.0_RKIND allocate(delsq_u(nVertLevels,nEdges+1)) - delsq_u(:,nEdges+1) = 0.0_RKIND -!! allocate(delsq_circulation(nVertLevels,nVertices+1)) ! no longer used -> removed + !! allocate(delsq_circulation(nVertLevels,nVertices+1)) ! no longer used -> removed allocate(delsq_vorticity(nVertLevels,nVertices+1)) - delsq_vorticity(:,nVertices+1) = 0.0_RKIND allocate(dpdz(nVertLevels,nCells+1)) - dpdz(:,nCells+1) = 0.0_RKIND + + !$acc parallel default(present) + !$acc loop vector + do k = 1, nVertLevels + delsq_theta(k,nCells+1) = 0.0_RKIND + delsq_w(k,nCells+1) = 0.0_RKIND + delsq_divergence(k,nCells+1) = 0.0_RKIND + delsq_u(k,nEdges+1) = 0.0_RKIND + delsq_vorticity(k,nVertices+1) = 0.0_RKIND + dpdz(k,nCells+1) = 0.0_RKIND + end do + !$acc end parallel !$OMP PARALLEL DO do thread=1,nThreads @@ -711,11 +1206,8 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) !$OMP PARALLEL DO do thread=1,nThreads - call atm_set_smlstep_pert_variables( tend, diag, mesh, block % configs, & - cellThreadStart(thread), cellThreadEnd(thread), & - edgeThreadStart(thread), edgeThreadEnd(thread), & - cellSolveThreadStart(thread), cellSolveThreadEnd(thread), & - edgeSolveThreadStart(thread), edgeSolveThreadEnd(thread)) + call atm_set_smlstep_pert_variables( tend, mesh, & + cellSolveThreadStart(thread), cellSolveThreadEnd(thread)) end do !$OMP END PARALLEL DO call mpas_timer_stop('small_step_prep') @@ -728,9 +1220,9 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) 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, block, nVertLevels, nEdges, 'ru', 0.0_RKIND ) - rt_driving_tend(1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_tend( clock, block, nVertLevels, nCells, 'rtheta_m', 0.0_RKIND ) - rho_driving_tend(1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_tend( clock, block, nVertLevels, nCells, 'rho_zz', 0.0_RKIND ) + call mpas_atm_get_bdy_tend( clock, block, nVertLevels, nEdges, 'ru', 0.0_RKIND, ru_driving_tend) + call mpas_atm_get_bdy_tend( clock, block, nVertLevels, nCells, 'rtheta_m', 0.0_RKIND, rt_driving_tend) + call mpas_atm_get_bdy_tend( clock, block, nVertLevels, nCells, 'rho_zz', 0.0_RKIND, rho_driving_tend) !$OMP PARALLEL DO do thread=1,nThreads call atm_bdy_adjust_dynamics_speczone_tend( tend, mesh, block % configs, nVertLevels, & @@ -753,10 +1245,11 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) 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, block, nVertLevels, nEdges, 'ru', time_dyn_step ) - rt_driving_values(1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, block, nVertLevels, nCells, 'rtheta_m', time_dyn_step ) - rho_driving_values(1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, block, nVertLevels, nCells, 'rho_zz', time_dyn_step ) + call mpas_atm_get_bdy_state(clock, block, nVertLevels, nEdges, 'ru', time_dyn_step, ru_driving_values) + call mpas_atm_get_bdy_state(clock, block, nVertLevels, nCells, 'rtheta_m', time_dyn_step, rt_driving_values) + call mpas_atm_get_bdy_state(clock, block, nVertLevels, nCells, 'rho_zz', time_dyn_step, rho_driving_values) + call mpas_timer_start('atm_bdy_adjust_dynamics_relaxzone_tend') !$OMP PARALLEL DO do thread=1,nThreads call atm_bdy_adjust_dynamics_relaxzone_tend( block % configs, tend, state, diag, mesh, nVertLevels, dt, & @@ -767,6 +1260,7 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) edgeSolveThreadStart(thread), edgeSolveThreadEnd(thread) ) end do !$OMP END PARALLEL DO + call mpas_timer_stop('atm_bdy_adjust_dynamics_relaxzone_tend') deallocate(ru_driving_values) deallocate(rt_driving_values) @@ -857,26 +1351,39 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) 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, block, nVertLevels, nEdges, 'u', time_dyn_step ) + call mpas_atm_get_bdy_state(clock, block, nVertLevels, nEdges, 'u', time_dyn_step, ru_driving_values) + ! do this inline at present - it is simple enough + !$acc enter data copyin(u) + !$acc parallel default(present) + !$acc loop gang worker do iEdge = 1, nEdgesSolve if(bdyMaskEdge(iEdge) > nRelaxZone) then + !$acc loop vector do k = 1, nVertLevels u(k,iEdge) = ru_driving_values(k,iEdge) end do end if end do + !$acc end parallel + !$acc exit data copyout(u) - ru_driving_values(1:nVertLevels,1:nEdges+1) = mpas_atm_get_bdy_state( clock, block, nVertLevels, nEdges, 'ru', time_dyn_step ) + call mpas_atm_get_bdy_state(clock, block, nVertLevels, nEdges, 'ru', time_dyn_step, ru_driving_values) call mpas_pool_get_array(diag, 'ru', u) ! do this inline at present - it is simple enough + !$acc enter data copyin(u) + !$acc parallel default(present) + !$acc loop gang worker do iEdge = 1, nEdges if(bdyMaskEdge(iEdge) > nRelaxZone) then + !$acc loop vector do k = 1, nVertLevels u(k,iEdge) = ru_driving_values(k,iEdge) end do end if end do + !$acc end parallel + !$acc exit data copyout(u) deallocate(ru_driving_values) @@ -905,39 +1412,12 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) allocate(scalars_driving(num_scalars,nVertLevels,nCells+1)) + ! ! get the scalar values driving the regional boundary conditions ! - if (index_qv > 0) then - scalars_driving(index_qv,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, block, 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, block, 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, block, 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, block, 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, block, 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, block, 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, block, 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, block, nVertLevels, nCells, 'ni', rk_timestep(rk_step) ) - end if - if (index_cnvcf > 0) then - scalars_driving(index_cnvcf,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, block, nVertLevels, nCells, 'cnvcf', rk_timestep(rk_step) ) - end if - if (index_buoyx > 0) then - scalars_driving(index_buoyx,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, block, nVertLevels, nCells, 'buoyx', rk_timestep(rk_step) ) - end if - + call mpas_atm_get_bdy_state(clock, block, num_scalars, nVertLevels, nCells, & + 'scalars', rk_timestep(rk_step), scalars_driving) + !$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), & @@ -956,9 +1436,15 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) call mpas_timer_start('atm_compute_solve_diagnostics') allocate(ke_vertex(nVertLevels,nVertices+1)) - ke_vertex(:,nVertices+1) = 0.0_RKIND allocate(ke_edge(nVertLevels,nEdges+1)) - ke_edge(:,nEdges+1) = 0.0_RKIND + + !$acc parallel default(present) + !$acc loop vector + do k = 1, nVertLevels + ke_vertex(k,nVertices+1) = 0.0_RKIND + ke_edge(k,nEdges+1) = 0.0_RKIND + end do + !$acc end parallel !$OMP PARALLEL DO do thread=1,nThreads @@ -1029,7 +1515,7 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) !$OMP PARALLEL DO do thread=1,nThreads - call atm_rk_dynamics_substep_finish(state, diag, dynamics_substep, dynamics_split, & + call atm_rk_dynamics_substep_finish(state, diag, nVertLevels, dynamics_substep, dynamics_split, & cellThreadStart(thread), cellThreadEnd(thread), & vertexThreadStart(thread), vertexThreadEnd(thread), & edgeThreadStart(thread), edgeThreadEnd(thread), & @@ -1078,39 +1564,12 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) allocate(scalars_driving(num_scalars,nVertLevels,nCells+1)) + ! ! get the scalar values driving the regional boundary conditions ! - if (index_qv > 0) then - scalars_driving(index_qv,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, block, 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, block, 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, block, 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, block, 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, block, 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, block, 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, block, 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, block, nVertLevels, nCells, 'ni', rk_timestep(rk_step) ) - end if - if (index_cnvcf > 0) then - scalars_driving(index_cnvcf,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, block, nVertLevels, nCells, 'cnvcf', rk_timestep(rk_step) ) - end if - if (index_buoyx > 0) then - scalars_driving(index_buoyx,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, block, nVertLevels, nCells, 'buoyx', rk_timestep(rk_step) ) - end if - + call mpas_atm_get_bdy_state(clock, block, num_scalars, nVertLevels, nCells, & + 'scalars', rk_timestep(rk_step), scalars_driving) + !$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), & @@ -1175,7 +1634,7 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) !requires that the subroutine atm_advance_scalars_mono was called on the third Runge Kutta step, so that a halo !update for the scalars at time_levs(1) is applied. A halo update for the scalars at time_levs(2) is done above. if (config_monotonic) then - rqvdynten(:,:) = ( scalars_2(index_qv,:,:) - scalars_1(index_qv,:,:) ) / config_dt + rqvdynten(:,:) = ( scalars_2(index_qv,:,:) - scalars_1(index_qv,:,:) ) / dt else rqvdynten(:,:) = 0._RKIND end if @@ -1199,7 +1658,7 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) call mpas_timer_start('microphysics') !$OMP PARALLEL DO do thread=1,nThreads - call driver_microphysics ( block % configs, mesh, state, 2, diag, diag_physics, tend, itimestep, & + call driver_microphysics ( block % configs, mesh, state, 2, diag, diag_physics, tend_physics, tend, itimestep, & cellSolveThreadStart(thread), cellSolveThreadEnd(thread)) end do !$OMP END PARALLEL DO @@ -1221,8 +1680,8 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) 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, block, nVertLevels, nCells, 'rtheta_m', time_dyn_step ) - rho_driving_values(1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, block, nVertLevels, nCells, 'rho_zz', time_dyn_step ) + call mpas_atm_get_bdy_state(clock, block, nVertLevels, nCells, 'rtheta_m', time_dyn_step, rt_driving_values) + call mpas_atm_get_bdy_state(clock, block, nVertLevels, nCells, 'rho_zz', time_dyn_step, rho_driving_values) !$OMP PARALLEL DO do thread=1,nThreads @@ -1245,39 +1704,11 @@ subroutine atm_srk3(domain, dt, itimestep, exchange_halo_group) allocate(scalars_driving(num_scalars,nVertLevels,nCells+1)) + ! ! get the scalar values driving the regional boundary conditions ! - if (index_qv > 0) then - scalars_driving(index_qv,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, block, 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, block, 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, block, 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, block, 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, block, 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, block, 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, block, 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, block, nVertLevels, nCells, 'ni', dt ) - end if - if (index_cnvcf > 0) then - scalars_driving(index_cnvcf,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, block, nVertLevels, nCells, 'cnvcf', dt ) - end if - if (index_buoyx > 0) then - scalars_driving(index_buoyx,1:nVertLevels,1:nCells+1) = mpas_atm_get_bdy_state( clock, block, nVertLevels, nCells, 'buoyx', dt ) - end if - + call mpas_atm_get_bdy_state(clock, block, num_scalars, nVertLevels, nCells, 'scalars', dt, scalars_driving) + !$OMP PARALLEL DO do thread=1,nThreads call atm_bdy_set_scalars( state, mesh, scalars_driving, nVertLevels, & @@ -1343,14 +1774,15 @@ subroutine advance_scalars(field_name, domain, rk_step, rk_timestep, config_mono type (mpas_pool_type), pointer :: tend type (mpas_pool_type), pointer :: state type (mpas_pool_type), pointer :: diag - type (mpas_pool_type), pointer :: diag_physics type (mpas_pool_type), pointer :: mesh type (mpas_pool_type), pointer :: halo_scratch - integer, pointer :: nCells - integer, pointer :: nEdges - integer, pointer :: nVertLevels - integer, pointer :: num_scalars + integer, pointer :: nCells_ptr + integer, pointer :: nEdges_ptr + integer, pointer :: nVertLevels_ptr + integer, pointer :: num_scalars_ptr + integer :: nCells, nEdges, nVertLevels, num_scalars + integer :: iScalar, k integer, pointer :: nThreads integer, dimension(:), pointer :: cellThreadStart @@ -1370,14 +1802,13 @@ subroutine advance_scalars(field_name, domain, rk_step, rk_timestep, config_mono call mpas_pool_get_subpool(block % structs, 'tend', tend) 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, 'diag_physics', diag_physics) call mpas_pool_get_subpool(block % structs, 'mesh', mesh) call mpas_pool_get_subpool(block % structs, 'halo_scratch', halo_scratch) - 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(state, 'num_scalars', num_scalars) + call mpas_pool_get_dimension(mesh, 'nCells', nCells_ptr) + call mpas_pool_get_dimension(mesh, 'nEdges', nEdges_ptr) + call mpas_pool_get_dimension(mesh, 'nVertLevels', nVertLevels_ptr) + call mpas_pool_get_dimension(state, 'num_'//trim(field_name), num_scalars_ptr) call mpas_pool_get_dimension(block % dimensions, 'nThreads', nThreads) @@ -1389,18 +1820,35 @@ subroutine advance_scalars(field_name, domain, rk_step, rk_timestep, config_mono call mpas_pool_get_dimension(block % dimensions, 'edgeThreadStart', edgeThreadStart) call mpas_pool_get_dimension(block % dimensions, 'edgeThreadEnd', edgeThreadEnd) + nCells = nCells_ptr + nEdges = nEdges_ptr + nVertLevels = nVertLevels_ptr + num_scalars = num_scalars_ptr + allocate(scalar_old_arr(nVertLevels,nCells+1)) - scalar_old_arr(:,nCells+1) = 0.0_RKIND allocate(scalar_new_arr(nVertLevels,nCells+1)) - scalar_new_arr(:,nCells+1) = 0.0_RKIND allocate(s_max_arr(nVertLevels,nCells+1)) - s_max_arr(:,nCells+1) = 0.0_RKIND allocate(s_min_arr(nVertLevels,nCells+1)) - s_min_arr(:,nCells+1) = 0.0_RKIND allocate(flux_array(nVertLevels,nEdges+1)) - flux_array(:,nEdges+1) = 0.0_RKIND + !$acc parallel default(present) + !$acc loop vector + do k = 1, nVertLevels + scalar_old_arr(k,nCells+1) = 0.0_RKIND + scalar_new_arr(k,nCells+1) = 0.0_RKIND + s_max_arr(k,nCells+1) = 0.0_RKIND + s_min_arr(k,nCells+1) = 0.0_RKIND + flux_array(k,nEdges+1) = 0.0_RKIND + end do + !$acc end parallel + allocate(wdtn_arr(nVertLevels+1,nCells+1)) - wdtn_arr(:,nCells+1) = 0.0_RKIND + !$acc parallel default(present) + !$acc loop vector + do k = 1, nVertLevels+1 + wdtn_arr(k,nCells+1) = 0.0_RKIND + end do + !$acc end parallel + if (config_split_dynamics_transport) then allocate(rho_zz_int(nVertLevels,nCells+1)) rho_zz_int(:,nCells+1) = 0.0_RKIND @@ -1409,12 +1857,24 @@ subroutine advance_scalars(field_name, domain, rk_step, rk_timestep, config_mono end if if (rk_step < 3 .or. (.not. config_monotonic .and. .not. config_positive_definite)) then allocate(horiz_flux_array(num_scalars,nVertLevels,nEdges+1)) - horiz_flux_array(:,:,nEdges+1) = 0.0_RKIND + !$acc parallel default(present) + !$acc loop gang vector collapse(2) + do k = 1, nVertLevels + do iScalar = 1, num_scalars + horiz_flux_array(iScalar,k,nEdges+1) = 0.0_RKIND + end do + end do + !$acc end parallel else allocate(flux_upwind_tmp_arr(nVertLevels,nEdges+1)) - flux_upwind_tmp_arr(:,nEdges+1) = 0.0_RKIND allocate(flux_tmp_arr(nVertLevels,nEdges+1)) - flux_tmp_arr(:,nEdges+1) = 0.0_RKIND + !$acc parallel default(present) + !$acc loop vector + do k = 1, nVertLevels + flux_upwind_tmp_arr(k,nEdges+1) = 0.0_RKIND + flux_tmp_arr(k,nEdges+1) = 0.0_RKIND + end do + !$acc end parallel end if ! @@ -1425,13 +1885,13 @@ subroutine advance_scalars(field_name, domain, rk_step, rk_timestep, config_mono !$OMP PARALLEL DO do thread=1,nThreads if (rk_step < 3 .or. (.not. config_monotonic .and. .not. config_positive_definite)) then - call atm_advance_scalars(field_name, tend, state, diag, diag_physics, mesh, block % configs, rk_timestep(rk_step), & + call atm_advance_scalars(field_name, tend, state, diag, mesh, block % configs, rk_timestep(rk_step), & edgeThreadStart(thread), edgeThreadEnd(thread), & cellSolveThreadStart(thread), cellSolveThreadEnd(thread), & horiz_flux_array, rk_step, config_time_integration_order, & advance_density=config_split_dynamics_transport) else - call atm_advance_scalars_mono(field_name, block, tend, state, diag, diag_physics, mesh, halo_scratch, & + call atm_advance_scalars_mono(field_name, block, tend, state, diag, mesh, halo_scratch, & block % configs, rk_timestep(rk_step), & cellThreadStart(thread), cellThreadEnd(thread), & edgeThreadStart(thread), edgeThreadEnd(thread), & @@ -1468,7 +1928,7 @@ subroutine advance_scalars(field_name, domain, rk_step, rk_timestep, config_mono end subroutine advance_scalars - subroutine atm_rk_integration_setup( state, diag, & + subroutine atm_rk_integration_setup( state, diag, nVertLevels, num_scalars, & cellStart, cellEnd, vertexStart, vertexEnd, edgeStart, edgeEnd, & cellSolveStart, cellSolveEnd, vertexSolveStart, vertexSolveEnd, edgeSolveStart, edgeSolveEnd) @@ -1476,8 +1936,9 @@ subroutine atm_rk_integration_setup( state, diag, & type (mpas_pool_type), intent(inout) :: state type (mpas_pool_type), intent(inout) :: diag - integer, intent(in) :: cellStart, cellEnd, vertexStart, vertexEnd, edgeStart, edgeEnd + integer, intent(in) :: nVertLevels, num_scalars, cellStart, cellEnd, vertexStart, vertexEnd, edgeStart, edgeEnd integer, intent(in) :: cellSolveStart, cellSolveEnd, vertexSolveStart, vertexSolveEnd, edgeSolveStart, edgeSolveEnd + integer :: iCell, iEdge, j, k real (kind=RKIND), dimension(:,:), pointer :: ru real (kind=RKIND), dimension(:,:), pointer :: ru_save @@ -1516,17 +1977,65 @@ subroutine atm_rk_integration_setup( state, diag, & call mpas_pool_get_array(state, 'scalars', scalars_1, 1) call mpas_pool_get_array(state, 'scalars', scalars_2, 2) - ru_save(:,edgeStart:edgeEnd) = ru(:,edgeStart:edgeEnd) - rw_save(:,cellStart:cellEnd) = rw(:,cellStart:cellEnd) - rtheta_p_save(:,cellStart:cellEnd) = rtheta_p(:,cellStart:cellEnd) - rho_p_save(:,cellStart:cellEnd) = rho_p(:,cellStart:cellEnd) + MPAS_ACC_TIMER_START('atm_rk_integration_setup [ACC_data_xfer]') + !$acc enter data create(ru_save, u_2, rw_save, rtheta_p_save, rho_p_save, & + !$acc w_2, theta_m_2, rho_zz_2, rho_zz_old_split, scalars_2) & + !$acc copyin(ru, rw, rtheta_p, rho_p, u_1, w_1, theta_m_1, & + !$acc rho_zz_1, scalars_1) + MPAS_ACC_TIMER_STOP('atm_rk_integration_setup [ACC_data_xfer]') + + !$acc kernels + theta_m_2(:,cellEnd+1) = 0.0_RKIND + !$acc end kernels + + !$acc parallel default(present) + !$acc loop gang worker + do iEdge = edgeStart,edgeEnd + !$acc loop vector + do k = 1,nVertLevels + ru_save(k,iEdge) = ru(k,iEdge) + u_2(k,iEdge) = u_1(k,iEdge) + end do + end do + + !$acc loop gang worker + do iCell = cellStart,cellEnd + !$acc loop vector + do k = 1,nVertLevels + rtheta_p_save(k,iCell) = rtheta_p(k,iCell) + rho_p_save(k,iCell) = rho_p(k,iCell) + theta_m_2(k,iCell) = theta_m_1(k,iCell) + rho_zz_2(k,iCell) = rho_zz_1(k,iCell) + rho_zz_old_split(k,iCell) = rho_zz_1(k,iCell) + end do + end do - u_2(:,edgeStart:edgeEnd) = u_1(:,edgeStart:edgeEnd) - w_2(:,cellStart:cellEnd) = w_1(:,cellStart:cellEnd) - theta_m_2(:,cellStart:cellEnd) = theta_m_1(:,cellStart:cellEnd) - rho_zz_2(:,cellStart:cellEnd) = rho_zz_1(:,cellStart:cellEnd) - rho_zz_old_split(:,cellStart:cellEnd) = rho_zz_1(:,cellStart:cellEnd) - scalars_2(:,:,cellStart:cellEnd) = scalars_1(:,:,cellStart:cellEnd) + !$acc loop gang worker + do iCell = cellStart,cellEnd + !$acc loop vector + do k = 1,nVertLevels+1 + rw_save(k,iCell) = rw(k,iCell) + w_2(k,iCell) = w_1(k,iCell) + end do + end do + + !$acc loop gang worker + do iCell = cellStart,cellEnd + !$acc loop vector collapse(2) + do k = 1,nVertLevels + do j = 1,num_scalars + scalars_2(j,k,iCell) = scalars_1(j,k,iCell) + end do + end do + end do + !$acc end parallel + + MPAS_ACC_TIMER_START('atm_rk_integration_setup [ACC_data_xfer]') + !$acc exit data copyout(ru_save, rw_save, rtheta_p_save, rho_p_save, u_2, & + !$acc w_2, theta_m_2, rho_zz_2, rho_zz_old_split, scalars_2) & + !$acc delete(ru, rw, rtheta_p, rho_p, u_1, w_1, theta_m_1, & + !$acc rho_zz_1, scalars_1) + MPAS_ACC_TIMER_STOP('atm_rk_integration_setup [ACC_data_xfer]') end subroutine atm_rk_integration_setup @@ -1548,52 +2057,79 @@ subroutine atm_compute_moist_coefficients( dims, state, diag, mesh, & integer, intent(in) :: cellSolveStart, cellSolveEnd, vertexSolveStart, vertexSolveEnd, edgeSolveStart, edgeSolveEnd integer :: iEdge, iCell, k, cell1, cell2, iq - integer, pointer :: nCells, nEdges, nVertLevels, nCellsSolve + integer, pointer :: nCells_ptr, nEdges_ptr, nVertLevels_ptr, nCellsSolve_ptr + integer :: nCells, nEdges, nVertLevels, nCellsSolve real (kind=RKIND) :: qtotal integer, dimension(:,:), pointer :: cellsOnEdge - integer, pointer :: moist_start, moist_end + integer, pointer :: moist_start_ptr, moist_end_ptr + integer :: moist_start, moist_end real (kind=RKIND), dimension(:,:,:), pointer :: scalars real (kind=RKIND), dimension(:,:), pointer :: cqw real (kind=RKIND), dimension(:,:), pointer :: cqu - call mpas_pool_get_dimension(dims, 'nCells', nCells) - call mpas_pool_get_dimension(dims, 'nEdges', nEdges) - call mpas_pool_get_dimension(dims, 'nVertLevels', nVertLevels) - call mpas_pool_get_dimension(dims, 'nCellsSolve', nCellsSolve) - call mpas_pool_get_dimension(state, 'moist_start', moist_start) - call mpas_pool_get_dimension(state, 'moist_end', moist_end) + call mpas_pool_get_dimension(dims, 'nCells', nCells_ptr) + call mpas_pool_get_dimension(dims, 'nEdges', nEdges_ptr) + call mpas_pool_get_dimension(dims, 'nVertLevels', nVertLevels_ptr) + call mpas_pool_get_dimension(dims, 'nCellsSolve', nCellsSolve_ptr) + call mpas_pool_get_dimension(state, 'moist_start', moist_start_ptr) + call mpas_pool_get_dimension(state, 'moist_end', moist_end_ptr) call mpas_pool_get_array(mesh, 'cellsOnEdge', cellsOnEdge) call mpas_pool_get_array(state, 'scalars', scalars, 2) call mpas_pool_get_array(diag, 'cqw', cqw) call mpas_pool_get_array(diag, 'cqu', cqu) + nCells = nCells_ptr + nEdges = nEdges_ptr + nVertLevels = nVertLevels_ptr + nCellsSolve = nCellsSolve_ptr + moist_start = moist_start_ptr + moist_end = moist_end_ptr + + MPAS_ACC_TIMER_START('atm_compute_moist_coefficients [ACC_data_xfer]') + !$acc enter data create(cqw, cqu) & + !$acc copyin(scalars) + MPAS_ACC_TIMER_STOP('atm_compute_moist_coefficients [ACC_data_xfer]') + + !$acc parallel default(present) + !$acc loop gang worker ! do iCell = cellSolveStart,cellSolveEnd do iCell = cellStart,cellEnd - qtot(1:nVertLevels,iCell) = 0.0 + !$acc loop vector do k = 1,nVertLevels + qtot(k,iCell) = 0.0 + !$acc loop seq do iq = moist_start, moist_end qtot(k,iCell) = qtot(k,iCell) + scalars(iq, k, iCell) end do end do end do + !$acc end parallel ! do iCell = cellSolveStart,cellSolveEnd + !$acc parallel default(present) + !$acc loop gang worker do iCell = cellStart,cellEnd + !$acc loop vector do k = 2, nVertLevels qtotal = 0.5*(qtot(k,iCell)+qtot(k-1,iCell)) cqw(k,iCell) = 1.0 / (1.0 + qtotal) end do end do + !$acc end parallel ! would need to compute qtot for all cells and an openmp barrier to use qtot below. + !$acc parallel default(present) + !$acc loop gang worker do iEdge = edgeStart,edgeEnd cell1 = cellsOnEdge(1,iEdge) cell2 = cellsOnEdge(2,iEdge) if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then - do k = 1, nVertLevels + !$acc loop vector + do k = 1, nVertLevels qtotal = 0.0 + !$acc loop seq do iq = moist_start, moist_end qtotal = qtotal + 0.5 * ( scalars(iq, k, cell1) + scalars(iq, k, cell2) ) end do @@ -1601,6 +2137,12 @@ subroutine atm_compute_moist_coefficients( dims, state, diag, mesh, & end do end if end do + !$acc end parallel + + MPAS_ACC_TIMER_START('atm_compute_moist_coefficients [ACC_data_xfer]') + !$acc exit data copyout(cqw, cqu) & + !$acc delete(scalars) + MPAS_ACC_TIMER_STOP('atm_compute_moist_coefficients [ACC_data_xfer]') end subroutine atm_compute_moist_coefficients @@ -1732,25 +2274,37 @@ subroutine atm_compute_vert_imp_coefs_work(nCells, moist_start, moist_end, dts, real (kind=RKIND) :: dtseps, c2, qtotal, rcv real (kind=RKIND), dimension( nVertLevels ) :: b_tri, c_tri + MPAS_ACC_TIMER_START('atm_compute_vert_imp_coefs_work [ACC_data_xfer]') + !$acc enter data copyin(cqw, p, t, rb, rtb, rt, pb) + !$acc enter data create(cofrz, cofwr, cofwz, coftz, cofwt, a_tri, b_tri, & + !$acc c_tri, alpha_tri, gamma_tri) + MPAS_ACC_TIMER_STOP('atm_compute_vert_imp_coefs_work [ACC_data_xfer]') ! set coefficients dtseps = .5*dts*(1.+epssm) rcv = rgas/(cp-rgas) c2 = cp*rcv + !$acc parallel default(present) + !$acc loop gang worker ! MGD bad to have all threads setting this variable? do k=1,nVertLevels cofrz(k) = dtseps*rdzw(k) end do + !$acc end parallel + !$acc parallel default(present) + !$acc loop gang worker private(b_tri,c_tri) do iCell = cellSolveStart,cellSolveEnd ! we only need to do cells we are solving for, not halo cells !DIR$ IVDEP + !$acc loop vector do k=2,nVertLevels cofwr(k,iCell) =.5*dtseps*gravity*(fzm(k)*zz(k,iCell)+fzp(k)*zz(k-1,iCell)) end do coftz(1,iCell) = 0.0 !DIR$ IVDEP + !$acc loop vector do k=2,nVertLevels cofwz(k,iCell) = dtseps*c2*(fzm(k)*zz(k,iCell)+fzp(k)*zz(k-1,iCell)) & *rdzu(k)*cqw(k,iCell)*(fzm(k)*p (k,iCell)+fzp(k)*p (k-1,iCell)) @@ -1758,6 +2312,7 @@ subroutine atm_compute_vert_imp_coefs_work(nCells, moist_start, moist_end, dts, end do coftz(nVertLevels+1,iCell) = 0.0 !DIR$ IVDEP + !$acc loop vector do k=1,nVertLevels ! qtotal = 0. @@ -1778,6 +2333,7 @@ subroutine atm_compute_vert_imp_coefs_work(nCells, moist_start, moist_end, dts, alpha_tri(1,iCell) = 0. ! note, this value is never used !DIR$ IVDEP + !$acc loop vector do k=2,nVertLevels a_tri(k,iCell) = -cofwz(k ,iCell)* coftz(k-1,iCell)*rdzw(k-1)*zz(k-1,iCell) & +cofwr(k ,iCell)* cofrz(k-1 ) & @@ -1793,19 +2349,25 @@ subroutine atm_compute_vert_imp_coefs_work(nCells, moist_start, moist_end, dts, +cofwt(k ,iCell)* coftz(k+1,iCell)*rdzw(k ) end do !MGD VECTOR DEPENDENCE + !$acc loop seq do k=2,nVertLevels alpha_tri(k,iCell) = 1./(b_tri(k)-a_tri(k,iCell)*gamma_tri(k-1,iCell)) gamma_tri(k,iCell) = c_tri(k)*alpha_tri(k,iCell) end do end do ! loop over cells + !$acc end parallel + + MPAS_ACC_TIMER_START('atm_compute_vert_imp_coefs_work [ACC_data_xfer]') + !$acc exit data copyout(cofrz, cofwr, cofwz, coftz, cofwt, a_tri, b_tri, & + !$acc c_tri, alpha_tri, gamma_tri) + !$acc exit data delete(cqw, p, t, rb, rtb, rt, pb) + MPAS_ACC_TIMER_STOP('atm_compute_vert_imp_coefs_work [ACC_data_xfer]') end subroutine atm_compute_vert_imp_coefs_work - subroutine atm_set_smlstep_pert_variables( tend, diag, mesh, configs, & - cellStart, cellEnd, edgeStart, edgeEnd, & - cellSolveStart, cellSolveEnd, edgeSolveStart, edgeSolveEnd) + subroutine atm_set_smlstep_pert_variables( tend, mesh, cellSolveStart, cellSolveEnd) ! following Klemp et al MWR 2007, we use preturbation variables ! in the acoustic-step integration. This routine computes those @@ -1816,91 +2378,58 @@ subroutine atm_set_smlstep_pert_variables( tend, diag, mesh, configs, & implicit none type (mpas_pool_type), intent(inout) :: tend - type (mpas_pool_type), intent(inout) :: diag type (mpas_pool_type), intent(inout) :: mesh - type (mpas_pool_type), intent(in) :: configs - integer, intent(in) :: cellStart, cellEnd, edgeStart, edgeEnd - integer, intent(in) :: cellSolveStart, cellSolveEnd, edgeSolveStart, edgeSolveEnd + integer, intent(in) :: cellSolveStart, cellSolveEnd + + integer, pointer :: nCells, nEdges - integer, pointer :: nCells, nEdges, nCellsSolve integer, dimension(:), pointer :: nEdgesOnCell integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnCell + real (kind=RKIND), dimension(:,:), pointer :: edgesOnCell_sign + integer, dimension(:), pointer :: bdyMaskCell ! regional_MPAS + real (kind=RKIND), dimension(:), pointer :: fzm, fzp - real (kind=RKIND), dimension(:,:), pointer :: ruAvg, wwAvg real (kind=RKIND), dimension(:,:,:), pointer :: zb, zb3, zb_cell, zb3_cell real (kind=RKIND), dimension(:,:), pointer :: zz - real (kind=RKIND), dimension(:,:), pointer :: w_tend, u_tend - real (kind=RKIND), dimension(:,:), pointer :: rho_pp, rho_p_save, rho_p - real (kind=RKIND), dimension(:,:), pointer :: ru_p, ru, ru_save - real (kind=RKIND), dimension(:,:), pointer :: rtheta_pp, rtheta_p_save, rtheta_p, rtheta_pp_old - real (kind=RKIND), dimension(:,:), pointer :: rw_p, rw_save, rw - real (kind=RKIND), dimension(:,:), pointer :: edgesOnCell_sign - integer, dimension(:), pointer :: bdyMaskCell ! regional_MPAS + real (kind=RKIND), dimension(:,:), pointer :: w_tend, u_tend call mpas_pool_get_dimension(mesh, 'nCells', nCells) - call mpas_pool_get_dimension(mesh, 'nCellsSolve', nCellsSolve) call mpas_pool_get_dimension(mesh, 'nEdges', nEdges) + call mpas_pool_get_array(mesh, 'nEdgesOnCell', nEdgesOnCell) + call mpas_pool_get_array(mesh, 'cellsOnEdge', cellsOnEdge) + call mpas_pool_get_array(mesh, 'edgesOnCell', edgesOnCell) + call mpas_pool_get_array(mesh, 'edgesOnCell_sign', edgesOnCell_sign) ! 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, 'fzm', fzm) + call mpas_pool_get_array(mesh, 'fzp', fzp) call mpas_pool_get_array(mesh, 'zb', zb) call mpas_pool_get_array(mesh, 'zb3', zb3) call mpas_pool_get_array(mesh, 'zb_cell', zb_cell) call mpas_pool_get_array(mesh, 'zb3_cell', zb3_cell) - call mpas_pool_get_array(mesh, 'fzm', fzm) - call mpas_pool_get_array(mesh, 'fzp', fzp) - call mpas_pool_get_array(mesh, 'cellsOnEdge', cellsOnEdge) - call mpas_pool_get_array(mesh, 'nEdgesOnCell', nEdgesOnCell) - call mpas_pool_get_array(mesh, 'edgesOnCell', edgesOnCell) - call mpas_pool_get_array(mesh, 'edgesOnCell_sign', edgesOnCell_sign) + call mpas_pool_get_array(mesh, 'zz', zz) call mpas_pool_get_array(tend, 'w', w_tend) call mpas_pool_get_array(tend, 'u', u_tend) - call mpas_pool_get_array(diag, 'ruAvg', ruAvg) - call mpas_pool_get_array(diag, 'wwAvg', wwAvg) - - call mpas_pool_get_array(diag, 'rho_pp', rho_pp) - call mpas_pool_get_array(diag, 'rho_p_save', rho_p_save) - call mpas_pool_get_array(diag, 'rho_p', rho_p) - - call mpas_pool_get_array(diag, 'ru_p', ru_p) - call mpas_pool_get_array(diag, 'ru_save', ru_save) - call mpas_pool_get_array(diag, 'ru', ru) - - call mpas_pool_get_array(diag, 'rtheta_pp', rtheta_pp) - call mpas_pool_get_array(diag, 'rtheta_p_save', rtheta_p_save) - call mpas_pool_get_array(diag, 'rtheta_p', rtheta_p) - call mpas_pool_get_array(diag, 'rtheta_pp_old', rtheta_pp_old) - - call mpas_pool_get_array(diag, 'rw_p', rw_p) - call mpas_pool_get_array(diag, 'rw_save', rw_save) - call mpas_pool_get_array(diag, 'rw', rw) - - 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, & - bdyMaskCell, & ! added for regional_MPAS - edgesOnCell_sign, & - cellStart, cellEnd, edgeStart, edgeEnd, & - cellSolveStart, cellSolveEnd, edgeSolveStart, edgeSolveEnd) + call atm_set_smlstep_pert_variables_work(nCells, nEdges, & + nEdgesOnCell, cellsOnEdge, edgesOnCell, edgesOnCell_sign, bdyMaskCell, & + fzm, fzp, zb, zb3, zb_cell, zb3_cell, zz, & + w_tend, u_tend, & + cellSolveStart, cellSolveEnd) 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, & - bdyMaskCell, & ! added for regional_MPAS - edgesOnCell_sign, & - cellStart, cellEnd, edgeStart, edgeEnd, & - cellSolveStart, cellSolveEnd, edgeSolveStart, edgeSolveEnd) + subroutine atm_set_smlstep_pert_variables_work(nCells, nEdges, & + nEdgesOnCell, cellsOnEdge, edgesOnCell, edgesOnCell_sign, bdyMaskCell, & + fzm, fzp, zb, zb3, zb_cell, zb3_cell, zz, & + w_tend, u_tend, & + cellSolveStart, cellSolveEnd) use mpas_atm_dimensions @@ -1910,41 +2439,26 @@ subroutine atm_set_smlstep_pert_variables_work(nCells, nEdges, nCellsSolve, & ! ! Dummy arguments ! - integer, intent(in) :: nCells, nEdges, nCellsSolve - - integer, intent(in) :: cellStart, cellEnd, edgeStart, edgeEnd - integer, intent(in) :: cellSolveStart, cellSolveEnd, edgeSolveStart, edgeSolveEnd + integer, intent(in) :: nCells, nEdges + integer, intent(in) :: cellSolveStart, cellSolveEnd integer, dimension(nCells+1) :: nEdgesOnCell integer, dimension(2,nEdges+1) :: cellsOnEdge integer, dimension(maxEdges,nCells+1) :: edgesOnCell + real (kind=RKIND), dimension(maxEdges,nCells+1) :: edgesOnCell_sign + integer, dimension(nCells+1), intent(in) :: bdyMaskCell ! added for regional_MPAS + real (kind=RKIND), dimension(nVertLevels) :: fzm real (kind=RKIND), dimension(nVertLevels) :: fzp - real (kind=RKIND), dimension(nVertLevels,nEdges+1) :: ruAvg - real (kind=RKIND), dimension(nVertLevels+1,nCells+1) :: wwAvg real (kind=RKIND), dimension(nVertLevels+1,2,nEdges+1) :: zb real (kind=RKIND), dimension(nVertLevels+1,2,nEdges+1) :: zb3 real (kind=RKIND), dimension(nVertLevels+1,maxEdges,nCells+1) :: zb_cell real (kind=RKIND), dimension(nVertLevels+1,maxEdges,nCells+1) :: zb3_cell real (kind=RKIND), dimension(nVertLevels,nCells+1) :: zz + real (kind=RKIND), dimension(nVertLevels+1,nCells+1) :: w_tend real (kind=RKIND), dimension(nVertLevels,nEdges+1) :: u_tend - real (kind=RKIND), dimension(nVertLevels,nCells+1) :: rho_pp - real (kind=RKIND), dimension(nVertLevels,nCells+1) :: rho_p_save - real (kind=RKIND), dimension(nVertLevels,nCells+1) :: rho_p - real (kind=RKIND), dimension(nVertLevels,nEdges+1) :: ru_p - real (kind=RKIND), dimension(nVertLevels,nEdges+1) :: ru - real (kind=RKIND), dimension(nVertLevels,nEdges+1) :: ru_save - real (kind=RKIND), dimension(nVertLevels,nCells+1) :: rtheta_pp - real (kind=RKIND), dimension(nVertLevels,nCells+1) :: rtheta_p_save - real (kind=RKIND), dimension(nVertLevels,nCells+1) :: rtheta_p - real (kind=RKIND), dimension(nVertLevels,nCells+1) :: rtheta_pp_old - real (kind=RKIND), dimension(nVertLevels+1,nCells+1) :: rw_p - real (kind=RKIND), dimension(nVertLevels+1,nCells+1) :: rw_save - 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 @@ -1952,31 +2466,45 @@ subroutine atm_set_smlstep_pert_variables_work(nCells, nEdges, nCellsSolve, & integer :: iCell, iEdge, i, k real (kind=RKIND) :: flux + MPAS_ACC_TIMER_START('atm_set_smlstep_pert_variables [ACC_data_xfer]') + !$acc enter data copyin(u_tend, w_tend) + MPAS_ACC_TIMER_STOP('atm_set_smlstep_pert_variables [ACC_data_xfer]') + ! we solve for omega instead of w (see Klemp et al MWR 2007), ! so here we change the w_p tendency to an omega_p tendency ! here we need to compute the omega tendency in a manner consistent with our diagnosis of omega. ! this requires us to use the same flux divergence as is used in the theta eqn - see Klemp et al MWR 2003. -!! do iCell=cellStart,cellEnd + !$acc parallel default(present) + !$acc loop gang worker 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) + !$acc loop seq + do i=1,nEdgesOnCell(iCell) + iEdge = edgesOnCell(i,iCell) !DIR$ IVDEP - do k = 2, nVertLevels - flux = edgesOnCell_sign(i,iCell) * (fzm(k) * u_tend(k,iEdge) + fzp(k) * u_tend(k-1,iEdge)) - w_tend(k,iCell) = w_tend(k,iCell) & - - (zb_cell(k,i,iCell) + sign(1.0_RKIND, u_tend(k,iEdge)) * zb3_cell(k,i,iCell)) * flux + !$acc loop vector + do k = 2, nVertLevels + flux = edgesOnCell_sign(i,iCell) * (fzm(k) * u_tend(k,iEdge) + fzp(k) * u_tend(k-1,iEdge)) + w_tend(k,iCell) = w_tend(k,iCell) & + - (zb_cell(k,i,iCell) + sign(1.0_RKIND, u_tend(k,iEdge)) * zb3_cell(k,i,iCell)) * flux + end do end do - end do !DIR$ IVDEP - 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 + !$acc loop vector + 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 + !$acc end parallel + + MPAS_ACC_TIMER_START('atm_set_smlstep_pert_variables [ACC_data_xfer]') + !$acc exit data delete(u_tend) + !$acc exit data copyout(w_tend) + MPAS_ACC_TIMER_STOP('atm_set_smlstep_pert_variables [ACC_data_xfer]') end subroutine atm_set_smlstep_pert_variables_work @@ -2209,6 +2737,18 @@ subroutine atm_advance_acoustic_step_work(nCells, nEdges, nCellsSolve, cellStart resm = (1.0 - epssm) / (1.0 + epssm) rdts = 1./dts + MPAS_ACC_TIMER_START('atm_advance_acoustic_step [ACC_data_xfer]') + !$acc enter data copyin(exner,cqu,cofwt,coftz,cofrz,cofwr,cofwz, & + !$acc a_tri,alpha_tri,gamma_tri,rho_zz,theta_m,w, & + !$acc tend_ru,tend_rho,tend_rt,tend_rw,rw,rw_save) + !$acc enter data create(rtheta_pp_old) + if(small_step == 1) then + !$acc enter data create(ru_p,ruAvg,rho_pp,rtheta_pp,wwAvg,rw_p) + else + !$acc enter data copyin(ru_p,ruAvg,rho_pp,rtheta_pp,wwAvg,rw_p) + end if + MPAS_ACC_TIMER_STOP('atm_advance_acoustic_step [ACC_data_xfer]') + if(small_step /= 1) then ! not needed on first small step ! forward-backward acoustic step integration. @@ -2221,8 +2761,10 @@ subroutine atm_advance_acoustic_step_work(nCells, nEdges, nCellsSolve, cellStart !MGD this loop will not be very load balanced with if-test below + !$acc parallel default(present) + !$acc loop gang worker do iEdge=edgeStart,edgeEnd ! MGD do we really just need edges touching owned cells? - + cell1 = cellsOnEdge(1,iEdge) cell2 = cellsOnEdge(2,iEdge) @@ -2230,6 +2772,7 @@ subroutine atm_advance_acoustic_step_work(nCells, nEdges, nCellsSolve, cellStart if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve ) then !DIR$ IVDEP + !$acc loop vector do k=1,nVertLevels 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 @@ -2239,6 +2782,7 @@ subroutine atm_advance_acoustic_step_work(nCells, nEdges, nCellsSolve, cellStart ! accumulate ru_p for use later in scalar transport !DIR$ IVDEP + !$acc loop vector do k=1,nVertLevels ruAvg(k,iEdge) = ruAvg(k,iEdge) + ru_p(k,iEdge) end do @@ -2246,9 +2790,12 @@ subroutine atm_advance_acoustic_step_work(nCells, nEdges, nCellsSolve, cellStart end if ! end test for block-owned cells end do ! end loop over edges + !$acc end parallel else ! this is all that us needed for ru_p update for first acoustic step in RK substep + !$acc parallel default(present) + !$acc loop gang worker do iEdge=edgeStart,edgeEnd ! MGD do we really just need edges touching owned cells? cell1 = cellsOnEdge(1,iEdge) @@ -2258,129 +2805,163 @@ subroutine atm_advance_acoustic_step_work(nCells, nEdges, nCellsSolve, cellStart if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve ) then !DIR$ IVDEP + !$acc loop vector do k=1,nVertLevels ru_p(k,iEdge) = dts*tend_ru(k,iEdge) end do !DIR$ IVDEP + !$acc loop vector do k=1,nVertLevels - ruAvg(k,iEdge) = ru_p(k,iEdge) + ruAvg(k,iEdge) = ru_p(k,iEdge) end do end if ! end test for block-owned cells end do ! end loop over edges + !$acc end parallel end if ! test for first acoustic step if (small_step == 1) then ! initialize here on first small timestep. + !$acc parallel default(present) + !$acc loop gang worker vector collapse(2) do iCell=cellStart,cellEnd - rtheta_pp_old(1:nVertLevels,iCell) = 0.0 + do k=1,nVertLevels + rtheta_pp_old(k,iCell) = 0.0 + end do end do + !$acc end parallel else + !$acc parallel default(present) + !$acc loop gang worker collapse(2) do iCell=cellStart,cellEnd - rtheta_pp_old(1:nVertLevels,iCell) = rtheta_pp(1:nVertLevels,iCell) + do k=1,nVertLevels + rtheta_pp_old(k,iCell) = rtheta_pp(k,iCell) + end do end do + !$acc end parallel end if !$OMP BARRIER + !$acc parallel default(present) + !$acc loop gang worker private(ts,rs) do iCell=cellSolveStart,cellSolveEnd ! loop over all owned cells to solve 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 - rtheta_pp(1:nVertLevels,iCell) = 0.0 - rw_p(:,iCell) = 0.0 + !$acc loop vector + do k=1,nVertLevels + wwAvg(k,iCell) = 0.0 + rho_pp(k,iCell) = 0.0 + rtheta_pp(k,iCell) = 0.0 + rw_p(k,iCell) = 0.0 + end do + wwAvg(nVertLevels+1,iCell) = 0.0 + rw_p(nVertLevels+1,iCell) = 0.0 end if if(specZoneMaskCell(iCell) == 0.0) then ! not specified zone, compute... - ts(:) = 0.0 - rs(:) = 0.0 + !$acc loop vector + do k=1,nVertLevels + ts(k) = 0.0 + rs(k) = 0.0 + end do - do i=1,nEdgesOnCell(iCell) - iEdge = edgesOnCell(i,iCell) - cell1 = cellsOnEdge(1,iEdge) - cell2 = cellsOnEdge(2,iEdge) + !$acc loop seq + do i=1,nEdgesOnCell(iCell) + iEdge = edgesOnCell(i,iCell) + cell1 = cellsOnEdge(1,iEdge) + cell2 = cellsOnEdge(2,iEdge) !DIR$ IVDEP - do k=1,nVertLevels - flux = edgesOnCell_sign(i,iCell)*dts*dvEdge(iEdge)*ru_p(k,iEdge) * invAreaCell(iCell) - rs(k) = rs(k)-flux - ts(k) = ts(k)-flux*0.5*(theta_m(k,cell2)+theta_m(k,cell1)) + !$acc loop vector + do k=1,nVertLevels + flux = edgesOnCell_sign(i,iCell)*dts*dvEdge(iEdge)*ru_p(k,iEdge) * invAreaCell(iCell) + rs(k) = rs(k)-flux + ts(k) = ts(k)-flux*0.5*(theta_m(k,cell2)+theta_m(k,cell1)) + end do end do - end do - ! vertically implicit acoustic and gravity wave integration. - ! this follows Klemp et al MWR 2007, with the addition of an implicit Rayleigh damping of w - ! serves as a gravity-wave absorbing layer, from Klemp et al 2008. + ! vertically implicit acoustic and gravity wave integration. + ! this follows Klemp et al MWR 2007, with the addition of an implicit Rayleigh damping of w + ! serves as a gravity-wave absorbing layer, from Klemp et al 2008. !DIR$ IVDEP - do k=1, nVertLevels - rs(k) = rho_pp(k,iCell) + dts*tend_rho(k,iCell) + rs(k) & - - cofrz(k)*resm*(rw_p(k+1,iCell)-rw_p(k,iCell)) - ts(k) = rtheta_pp(k,iCell) + dts*tend_rt(k,iCell) + ts(k) & - - resm*rdzw(k)*( coftz(k+1,iCell)*rw_p(k+1,iCell) & - -coftz(k,iCell)*rw_p(k,iCell)) - end do + !$acc loop vector + do k=1, nVertLevels + rs(k) = rho_pp(k,iCell) + dts*tend_rho(k,iCell) + rs(k) & + - cofrz(k)*resm*(rw_p(k+1,iCell)-rw_p(k,iCell)) + ts(k) = rtheta_pp(k,iCell) + dts*tend_rt(k,iCell) + ts(k) & + - resm*rdzw(k)*( coftz(k+1,iCell)*rw_p(k+1,iCell) & + -coftz(k,iCell)*rw_p(k,iCell)) + end do !DIR$ IVDEP - do k=2, nVertLevels - wwavg(k,iCell) = wwavg(k,iCell) + 0.5*(1.0-epssm)*rw_p(k,iCell) - end do + !$acc loop vector + do k=2, nVertLevels + wwAvg(k,iCell) = wwAvg(k,iCell) + 0.5*(1.0-epssm)*rw_p(k,iCell) + end do !DIR$ IVDEP - do k=2, nVertLevels - rw_p(k,iCell) = rw_p(k,iCell) + dts*tend_rw(k,iCell) & - - cofwz(k,iCell)*((zz(k ,iCell)*ts(k) & - -zz(k-1,iCell)*ts(k-1)) & - +resm*(zz(k ,iCell)*rtheta_pp(k ,iCell) & - -zz(k-1,iCell)*rtheta_pp(k-1,iCell))) & - - cofwr(k,iCell)*((rs(k)+rs(k-1)) & - +resm*(rho_pp(k,iCell)+rho_pp(k-1,iCell))) & - + cofwt(k ,iCell)*(ts(k )+resm*rtheta_pp(k ,iCell)) & - + cofwt(k-1,iCell)*(ts(k-1)+resm*rtheta_pp(k-1,iCell)) - end do + !$acc loop vector + do k=2, nVertLevels + rw_p(k,iCell) = rw_p(k,iCell) + dts*tend_rw(k,iCell) & + - cofwz(k,iCell)*((zz(k ,iCell)*ts(k) & + -zz(k-1,iCell)*ts(k-1)) & + +resm*(zz(k ,iCell)*rtheta_pp(k ,iCell) & + -zz(k-1,iCell)*rtheta_pp(k-1,iCell))) & + - cofwr(k,iCell)*((rs(k)+rs(k-1)) & + +resm*(rho_pp(k,iCell)+rho_pp(k-1,iCell))) & + + cofwt(k ,iCell)*(ts(k )+resm*rtheta_pp(k ,iCell)) & + + cofwt(k-1,iCell)*(ts(k-1)+resm*rtheta_pp(k-1,iCell)) + end do - ! tridiagonal solve sweeping up and then down the column + ! tridiagonal solve sweeping up and then down the column !MGD VECTOR DEPENDENCE - do k=2,nVertLevels - rw_p(k,iCell) = (rw_p(k,iCell)-a_tri(k,iCell)*rw_p(k-1,iCell))*alpha_tri(k,iCell) - end do + !$acc loop seq + do k=2,nVertLevels + rw_p(k,iCell) = (rw_p(k,iCell)-a_tri(k,iCell)*rw_p(k-1,iCell))*alpha_tri(k,iCell) + end do !MGD VECTOR DEPENDENCE - do k=nVertLevels,1,-1 - rw_p(k,iCell) = rw_p(k,iCell) - gamma_tri(k,iCell)*rw_p(k+1,iCell) - end do + !$acc loop seq + do k=nVertLevels,1,-1 + rw_p(k,iCell) = rw_p(k,iCell) - gamma_tri(k,iCell)*rw_p(k+1,iCell) + end do - ! the implicit Rayleigh damping on w (gravity-wave absorbing) + ! the implicit Rayleigh damping on w (gravity-wave absorbing) !DIR$ IVDEP - do k=2,nVertLevels - rw_p(k,iCell) = (rw_p(k,iCell) + (rw_save(k ,iCell) - rw(k ,iCell)) -dts*dss(k,iCell)* & - (fzm(k)*zz (k,iCell)+fzp(k)*zz (k-1,iCell)) & - *(fzm(k)*rho_zz(k,iCell)+fzp(k)*rho_zz(k-1,iCell)) & - *w(k,iCell) )/(1.0+dts*dss(k,iCell)) & - - (rw_save(k ,iCell) - rw(k ,iCell)) - end do + !$acc loop vector + do k=2,nVertLevels + rw_p(k,iCell) = (rw_p(k,iCell) + (rw_save(k ,iCell) - rw(k ,iCell)) -dts*dss(k,iCell)* & + (fzm(k)*zz (k,iCell)+fzp(k)*zz (k-1,iCell)) & + *(fzm(k)*rho_zz(k,iCell)+fzp(k)*rho_zz(k-1,iCell)) & + *w(k,iCell) )/(1.0+dts*dss(k,iCell)) & + - (rw_save(k ,iCell) - rw(k ,iCell)) + end do - ! accumulate (rho*omega)' for use later in scalar transport + ! accumulate (rho*omega)' for use later in scalar transport !DIR$ IVDEP - do k=2,nVertLevels - wwAvg(k,iCell) = wwAvg(k,iCell) + 0.5*(1.0+epssm)*rw_p(k,iCell) - end do + !$acc loop vector + do k=2,nVertLevels + wwAvg(k,iCell) = wwAvg(k,iCell) + 0.5*(1.0+epssm)*rw_p(k,iCell) + end do - ! update rho_pp and theta_pp given updated rw_p + ! update rho_pp and theta_pp given updated rw_p !DIR$ IVDEP - do k=1,nVertLevels - rho_pp(k,iCell) = rs(k) - cofrz(k) *(rw_p(k+1,iCell)-rw_p(k ,iCell)) - rtheta_pp(k,iCell) = ts(k) - rdzw(k)*(coftz(k+1,iCell)*rw_p(k+1,iCell) & - -coftz(k ,iCell)*rw_p(k ,iCell)) - end do + !$acc loop vector + do k=1,nVertLevels + rho_pp(k,iCell) = rs(k) - cofrz(k) *(rw_p(k+1,iCell)-rw_p(k ,iCell)) + rtheta_pp(k,iCell) = ts(k) - rdzw(k)*(coftz(k+1,iCell)*rw_p(k+1,iCell) & + -coftz(k ,iCell)*rw_p(k ,iCell)) + end do else ! specifed zone in regional_MPAS + !$acc loop vector 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) @@ -2391,6 +2972,15 @@ subroutine atm_advance_acoustic_step_work(nCells, nEdges, nCellsSolve, cellStart end if end do ! end of loop over cells + !$acc end parallel + + MPAS_ACC_TIMER_START('atm_advance_acoustic_step [ACC_data_xfer]') + !$acc exit data delete(exner,cqu,cofwt,coftz,cofrz,cofwr,cofwz, & + !$acc a_tri,alpha_tri,gamma_tri,rho_zz,theta_m,w, & + !$acc tend_ru,tend_rho,tend_rt,tend_rw,rw,rw_save) + !$acc exit data copyout(rtheta_pp_old,ru_p,ruAvg,rho_pp, & + !$acc rtheta_pp,wwAvg,rw_p) + MPAS_ACC_TIMER_STOP('atm_advance_acoustic_step [ACC_data_xfer]') end subroutine atm_advance_acoustic_step_work @@ -2414,8 +3004,10 @@ subroutine atm_divergence_damping_3d( state, diag, mesh, configs, dts, edgeStart real (kind=RKIND), dimension(:), pointer :: specZoneMaskEdge integer, dimension(:,:), pointer :: cellsOnEdge - integer, pointer :: nCellsSolve - integer, pointer :: nVertLevels + integer, pointer :: nCellsSolve_ptr + integer, pointer :: nVertLevels_ptr + integer :: nCellsSolve + integer :: nVertLevels real (kind=RKIND) :: divCell1, divCell2, rdts, coef_divdamp integer :: cell1, cell2, iEdge, k @@ -2428,8 +3020,8 @@ subroutine atm_divergence_damping_3d( state, diag, mesh, configs, dts, edgeStart call mpas_pool_get_array(diag, 'rtheta_pp_old', rtheta_pp_old) call mpas_pool_get_array(diag, 'ru_p', ru_p) - call mpas_pool_get_dimension(mesh, 'nCellsSolve', nCellsSolve) - call mpas_pool_get_dimension(mesh, 'nVertLevels', nVertLevels) + call mpas_pool_get_dimension(mesh, 'nCellsSolve', nCellsSolve_ptr) + call mpas_pool_get_dimension(mesh, 'nVertLevels', nVertLevels_ptr) call mpas_pool_get_config(configs, 'config_smdiv', smdiv) call mpas_pool_get_config(configs, 'config_len_disp', config_len_disp) @@ -2437,6 +3029,15 @@ subroutine atm_divergence_damping_3d( state, diag, mesh, configs, dts, edgeStart rdts = 1.0_RKIND / dts coef_divdamp = 2.0_RKIND * smdiv * config_len_disp * rdts + nCellsSolve = nCellsSolve_ptr + nVertLevels = nVertLevels_ptr + + MPAS_ACC_TIMER_START('atm_divergence_damping_3d [ACC_data_xfer]') + !$acc enter data copyin(ru_p, rtheta_pp, rtheta_pp_old, theta_m) + MPAS_ACC_TIMER_STOP('atm_divergence_damping_3d [ACC_data_xfer]') + + !$acc parallel default(present) + !$acc loop gang worker do iEdge=edgeStart,edgeEnd ! MGD do we really just need edges touching owned cells? cell1 = cellsOnEdge(1,iEdge) @@ -2446,6 +3047,7 @@ subroutine atm_divergence_damping_3d( state, diag, mesh, configs, dts, edgeStart if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve ) then !DIR$ IVDEP + !$acc loop vector do k=1,nVertLevels !! unscaled 3d divergence damping @@ -2463,6 +3065,13 @@ subroutine atm_divergence_damping_3d( state, diag, mesh, configs, dts, edgeStart end do end if ! edges for block-owned cells end do ! end loop over edges + !$acc end parallel + + MPAS_ACC_TIMER_START('atm_divergence_damping_3d [ACC_data_xfer]') + !$acc exit data copyout(ru_p) & + !$acc delete(rtheta_pp, rtheta_pp_old, theta_m) + MPAS_ACC_TIMER_STOP('atm_divergence_damping_3d [ACC_data_xfer]') + end subroutine atm_divergence_damping_3d @@ -2652,45 +3261,70 @@ subroutine atm_recover_large_step_variables_work(nCells, nEdges, nCellsSolve, nE integer :: i, iCell, iEdge, k, cell1, cell2 real (kind=RKIND) :: invNs, rcv, p0, flux + MPAS_ACC_TIMER_START('atm_recover_large_step_variables [ACC_data_xfer]') + !$acc enter data copyin(rho_p_save,rho_pp,rho_base,rw_save,rw_p, & + !$acc rtheta_p_save,rtheta_pp,rtheta_base, & + !$acc ru_save,ru_p,wwAvg,ruAvg) & + !$acc create(rho_zz,rho_p,rw,w,rtheta_p,theta_m, & + !$acc ru,u) + if (rk_step == 3) then + !$acc enter data copyin(rt_diabatic_tend,exner_base) & + !$acc create(exner,pressure_p) + end if + MPAS_ACC_TIMER_STOP('atm_recover_large_step_variables [ACC_data_xfer]') rcv = rgas/(cp-rgas) p0 = 1.0e+05 ! this should come from somewhere else... ! Avoid FP errors caused by a potential division by zero below by ! initializing the "garbage cell" of rho_zz to a non-zero value + !$acc parallel default(present) + !$acc loop gang vector do k=1,nVertLevels rho_zz(k,nCells+1) = 1.0 end do + !$acc end parallel ! compute new density everywhere so we can compute u from ru. ! we will also need it to compute theta_m below invNs = 1 / real(ns,RKIND) + !$acc parallel default(present) + !$acc loop gang worker do iCell=cellStart,cellEnd !DIR$ IVDEP + !$acc loop vector do k = 1, nVertLevels rho_p(k,iCell) = rho_p_save(k,iCell) + rho_pp(k,iCell) rho_zz(k,iCell) = rho_p(k,iCell) + rho_base(k,iCell) end do + rw(1,iCell) = 0.0 w(1,iCell) = 0.0 !DIR$ IVDEP + !$acc loop vector do k = 2, nVertLevels wwAvg(k,iCell) = rw_save(k,iCell) + (wwAvg(k,iCell) * invNs) rw(k,iCell) = rw_save(k,iCell) + rw_p(k,iCell) ! pick up part of diagnosed w from omega - divide by density later w(k,iCell) = rw(k,iCell)/(fzm(k)*zz(k,iCell)+fzp(k)*zz(k-1,iCell)) - + end do + rw(nVertLevels+1,iCell) = 0.0 w(nVertLevels+1,iCell) = 0.0 + end do + !$acc end parallel - if (rk_step == 3) then + if (rk_step == 3) then + !$acc parallel default(present) + !$acc loop collapse(2) + do iCell=cellStart,cellEnd !DIR$ IVDEP do k = 1, nVertLevels rtheta_p(k,iCell) = rtheta_p_save(k,iCell) + rtheta_pp(k,iCell) & @@ -2701,15 +3335,20 @@ subroutine atm_recover_large_step_variables_work(nCells, nEdges, nCellsSolve, nE pressure_p(k,iCell) = zz(k,iCell) * rgas * (exner(k,iCell)*rtheta_p(k,iCell)+rtheta_base(k,iCell) & * (exner(k,iCell)-exner_base(k,iCell))) end do - else + end do + !$acc end parallel + else + !$acc parallel default(present) + !$acc loop collapse(2) + do iCell=cellStart,cellEnd !DIR$ IVDEP do k = 1, nVertLevels rtheta_p(k,iCell) = rtheta_p_save(k,iCell) + rtheta_pp(k,iCell) theta_m(k,iCell) = (rtheta_p(k,iCell) + rtheta_base(k,iCell))/rho_zz(k,iCell) end do - end if - - end do + end do + !$acc end parallel + end if ! recover time-averaged ruAvg on all edges of owned cells (for upcoming scalar transport). ! we solved for these in the acoustic-step loop. @@ -2717,21 +3356,27 @@ subroutine atm_recover_large_step_variables_work(nCells, nEdges, nCellsSolve, nE !$OMP BARRIER + !$acc parallel default(present) + !$acc loop gang worker do iEdge=edgeStart,edgeEnd cell1 = cellsOnEdge(1,iEdge) cell2 = cellsOnEdge(2,iEdge) !DIR$ IVDEP + !$acc loop vector do k = 1, nVertLevels ruAvg(k,iEdge) = ru_save(k,iEdge) + (ruAvg(k,iEdge) * invNs) ru(k,iEdge) = ru_save(k,iEdge) + ru_p(k,iEdge) u(k,iEdge) = 2.*ru(k,iEdge)/(rho_zz(k,cell1)+rho_zz(k,cell2)) end do end do + !$acc end parallel !$OMP BARRIER + !$acc parallel default(present) + !$acc loop gang worker do iCell=cellStart,cellEnd ! finish recovering w from (rho*omega)_p. as when we formed (rho*omega)_p from u and w, we need @@ -2740,33 +3385,49 @@ subroutine atm_recover_large_step_variables_work(nCells, nEdges, nCellsSolve, nE if (bdyMaskCell(iCell) <= nRelaxZone) then ! addition for regional_MPAS, no spec zone update - do i=1,nEdgesOnCell(iCell) - iEdge=edgesOnCell(i,iCell) + !$acc loop seq + do i=1,nEdgesOnCell(iCell) + iEdge=edgesOnCell(i,iCell) - flux = (cf1*ru(1,iEdge) + cf2*ru(2,iEdge) + cf3*ru(3,iEdge)) - w(1,iCell) = w(1,iCell) + edgesOnCell_sign(i,iCell) * & - (zb_cell(1,i,iCell) + sign(1.0_RKIND,flux)*zb3_cell(1,i,iCell))*flux + flux = (cf1*ru(1,iEdge) + cf2*ru(2,iEdge) + cf3*ru(3,iEdge)) + w(1,iCell) = w(1,iCell) + edgesOnCell_sign(i,iCell) * & + (zb_cell(1,i,iCell) + sign(1.0_RKIND,flux)*zb3_cell(1,i,iCell))*flux !DIR$ IVDEP - do k = 2, nVertLevels - flux = (fzm(k)*ru(k,iEdge)+fzp(k)*ru(k-1,iEdge)) - w(k,iCell) = w(k,iCell) + edgesOnCell_sign(i,iCell) * & - (zb_cell(k,i,iCell)+sign(1.0_RKIND,flux)*zb3_cell(k,i,iCell))*flux - end do + !$acc loop vector + do k = 2, nVertLevels + flux = (fzm(k)*ru(k,iEdge)+fzp(k)*ru(k-1,iEdge)) + w(k,iCell) = w(k,iCell) + edgesOnCell_sign(i,iCell) * & + (zb_cell(k,i,iCell)+sign(1.0_RKIND,flux)*zb3_cell(k,i,iCell))*flux + end do - end do + end do - w(1,iCell) = w(1,iCell)/(cf1*rho_zz(1,iCell)+cf2*rho_zz(2,iCell)+cf3*rho_zz(3,iCell)) + w(1,iCell) = w(1,iCell)/(cf1*rho_zz(1,iCell)+cf2*rho_zz(2,iCell)+cf3*rho_zz(3,iCell)) - !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 + !DIR$ IVDEP + !$acc loop vector + 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 + !$acc end parallel + + MPAS_ACC_TIMER_START('atm_recover_large_step_variables [ACC_data_xfer]') + !$acc exit data delete(rho_p_save,rho_pp,rho_base,rw_save,rw_p, & + !$acc rtheta_p_save,rtheta_pp,rtheta_base, & + !$acc ru_save,ru_p) & + !$acc copyout(rho_zz,rho_p,rw,w,rtheta_p,theta_m, & + !$acc ru,u,wwAvg,ruAvg) + if (rk_step == 3) then + !$acc exit data delete(rt_diabatic_tend,exner_base) & + !$acc copyout(exner,pressure_p) + end if + MPAS_ACC_TIMER_STOP('atm_recover_large_step_variables [ACC_data_xfer]') end subroutine atm_recover_large_step_variables_work @@ -2782,7 +3443,7 @@ end subroutine atm_recover_large_step_variables_work !> to the work routine. ! !----------------------------------------------------------------------- - subroutine atm_advance_scalars(field_name, tend, state, diag, diag_physics, mesh, configs, dt, & + subroutine atm_advance_scalars(field_name, tend, state, diag, mesh, configs, dt, & edgeStart, edgeEnd, & cellSolveStart, cellSolveEnd, & horiz_flux_arr, rk_step, config_time_integration_order, advance_density) @@ -2795,7 +3456,6 @@ subroutine atm_advance_scalars(field_name, tend, state, diag, diag_physics, mesh 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) :: diag_physics type (mpas_pool_type), intent(in) :: mesh type (mpas_pool_type), intent(in) :: configs integer, intent(in) :: rk_step ! rk substep we are integrating @@ -2881,6 +3541,7 @@ subroutine atm_advance_scalars(field_name, tend, state, diag, diag_physics, mesh call mpas_pool_get_dimension(state,'index_buoyx',index_buoyx) call mpas_pool_get_config(configs,'config_gf_cporg',config_gf_cporg) !--srf + call atm_advance_scalars_work(nCells, num_scalars, dt, & edgeStart, edgeEnd, & cellSolveStart, cellSolveEnd, & @@ -3014,7 +3675,7 @@ subroutine atm_advance_scalars_work(nCells, num_scalars, dt, & flux4(q_im2, q_im1, q_i, q_ip1, ua) + & coef3*abs(ua)*((q_ip1 - q_im2)-3.*(q_i-q_im1))/12.0 - !-srf +!-srf !print*,'atm_advance_scalars_work : index_buoyx',index_buoyx !-srf local_advance_density = advance_density @@ -3040,154 +3701,197 @@ subroutine atm_advance_scalars_work(nCells, num_scalars, dt, & weight_time_old = 1. - weight_time_new + MPAS_ACC_TIMER_START('atm_advance_scalars [ACC_data_xfer]') + !$acc enter data copyin(uhAvg, scalar_new) + MPAS_ACC_TIMER_STOP('atm_advance_scalars [ACC_data_xfer]') + + !$acc parallel async + !$acc loop gang worker private(scalar_weight2, ica) do iEdge=edgeStart,edgeEnd - if( (.not.config_apply_lbcs) .or. (bdyMaskEdge(iEdge) .lt. nRelaxZone-1) ) then ! full flux calculation + if ((.not.config_apply_lbcs) & + .or. (bdyMaskEdge(iEdge) < nRelaxZone-1)) then ! full flux calculation - select case(nAdvCellsForEdge(iEdge)) + select case(nAdvCellsForEdge(iEdge)) - case(10) + 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) + !$acc loop vector collapse(2) + do j=1,10 + 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 - 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 ; if(iScalar == index_buoyx) cycle !--srf - 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)) + + !$acc loop vector + do j=1,10 + ica(j) = advCellsForEdge(j,iEdge) end do - end do - case default + !$acc loop vector collapse(2) + do k = 1,nVertLevels + do iScalar = 1,num_scalars ; if(iScalar == index_buoyx) cycle !--srf + 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 - horiz_flux_arr(:,:,iEdge) = 0.0 - do j=1,nAdvCellsForEdge(iEdge) - iAdvCell = advCellsForEdge(j,iEdge) -!DIR$ IVDEP + case default + + !$acc loop vector collapse(2) 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; if(iScalar == index_buoyx) cycle !--srf - horiz_flux_arr(iScalar,k,iEdge) = horiz_flux_arr(iScalar,k,iEdge) + scalar_weight * scalar_new(iScalar,k,iAdvCell) + do iScalar=1,num_scalars + horiz_flux_arr(iScalar,k,iEdge) = 0.0_RKIND end do end do - end do - end select + !$acc loop seq + do j=1,nAdvCellsForEdge(iEdge) + iAdvCell = advCellsForEdge(j,iEdge) - 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 + !$acc loop vector collapse(2) + do k=1,nVertLevels + do iScalar=1,num_scalars; if(iScalar == index_buoyx) cycle !--srf + scalar_weight = adv_coefs(j,iEdge) + sign(1.0_RKIND,uhAvg(k,iEdge))*adv_coefs_3rd(j,iEdge) + 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 + + else if(config_apply_lbcs & + .and. (bdyMaskEdge(iEdge) >= nRelaxZone-1) & + .and. (bdyMaskEdge(iEdge) <= nRelaxZone)) then + + ! upwind flux evaluation for outermost 2 edges in specified zone cell1 = cellsOnEdge(1,iEdge) cell2 = cellsOnEdge(2,iEdge) -!DIR$ IVDEP + + !$acc loop vector collapse(2) 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; if(iScalar == index_buoyx) cycle !--srf + do iScalar=1,num_scalars + 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) + if(iScalar == index_buoyx) cycle !--srf horiz_flux_arr(iScalar,k,iEdge) = u_positive*scalar_new(iScalar,k,cell1) + u_negative*scalar_new(iScalar,k,cell2) end do end do end if ! end of regional MPAS test - end do + !$acc end parallel !$OMP BARRIER -! scalar update, for each column sum fluxes over horizontal edges, add physics tendency, and add vertical flux divergence in update. + ! + ! scalar update, for each column sum fluxes over horizontal edges, add physics tendency, + ! and add vertical flux divergence in update. + ! + + MPAS_ACC_TIMER_START('atm_advance_scalars [ACC_data_xfer]') +#ifndef DO_PHYSICS + !$acc enter data create(scalar_tend_save) +#else + !$acc enter data copyin(scalar_tend_save) +#endif + !$acc enter data copyin(scalar_old, fnm, fnp, rdnw, wwAvg, rho_zz_old, rho_zz_new) + !$acc enter data create(scalar_tend_column) + MPAS_ACC_TIMER_STOP('atm_advance_scalars [ACC_data_xfer]') - + !$acc parallel wait + !$acc loop gang worker private(scalar_tend_column, wdtn) do iCell=cellSolveStart,cellSolveEnd if(bdyMaskCell(iCell) <= nRelaxZone) then ! specified zone for regional_MPAS is not updated in this routine + !$acc loop vector collapse(2) + do k=1,nVertLevels + do iScalar=1,num_scalars + scalar_tend_column(iScalar,k) = 0.0_RKIND #ifndef DO_PHYSICS - scalar_tend_save(:,:,iCell) = 0.0 ! testing purposes - we have no sources or sinks + scalar_tend_save(iScalar,k,iCell) = 0.0_RKIND ! testing purposes - we have no sources or sinks #endif - scalar_tend_column(1:num_scalars,1:nVertlevels) = 0. + end do + end do + !$acc loop seq 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 + !$acc loop vector collapse(2) do k=1,nVertLevels -!DIR$ IVDEP do iScalar=1,num_scalars; if(iScalar == index_buoyx) cycle !--srf 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 + !$acc loop vector collapse(2) do k=1,nVertLevels -!DIR$ IVDEP do iScalar=1,num_scalars; if(iScalar == index_buoyx) cycle !--srf - scalar_tend_column(iScalar,k) = scalar_tend_column(iScalar,k) * invAreaCell(iCell) + scalar_tend_save(iScalar,k,iCell) + 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; if(iScalar == index_buoyx) cycle !--srf - 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 + ! + ! vertical flux divergence and update of the scalars + ! + + !$acc loop vector do iScalar=1,num_scalars; if(iScalar == index_buoyx) cycle !--srf - 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 ) + wdtn(iScalar,1) = 0.0 + wdtn(iScalar,2) = wwAvg(2,iCell)*(fnm(2)*scalar_new(iScalar,2,iCell)+fnp(2)*scalar_new(iScalar,2-1,iCell)) + wdtn(iScalar,nVertLevels) = wwAvg(nVertLevels,iCell) * & + ( fnm(nVertLevels)*scalar_new(iScalar,nVertLevels,iCell) & + +fnp(nVertLevels)*scalar_new(iScalar,nVertLevels-1,iCell) ) + wdtn(iScalar,nVertLevels+1) = 0.0 end do - end do - k = nVertLevels - do iScalar=1,num_scalars; if(iScalar == index_buoyx) cycle !--srf - 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; if(iScalar == index_buoyx) cycle !--srf - 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 + !$acc loop vector collapse(2) + do k=3,nVertLevels-1 + do iScalar=1,num_scalars; if(iScalar == index_buoyx) cycle !--srf + 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 - end do - end if ! specified zone regional_MPAS test + !$acc loop vector collapse(2) + do k=1,nVertLevels + do iScalar=1,num_scalars; if(iScalar == index_buoyx) cycle !--srf + rho_zz_new_inv = 1.0_RKIND / (weight_time_old*rho_zz_old(k,iCell) + weight_time_new*rho_zz_new(k,iCell)) + 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 if ! specified zone regional_MPAS test end do + !$acc end parallel + + MPAS_ACC_TIMER_START('atm_advance_scalars [ACC_data_xfer]') + !$acc exit data copyout(scalar_new) + !$acc exit data delete(scalar_tend_column, uhAvg, wwAvg, scalar_old, fnm, fnp, & + !$acc rdnw, rho_zz_old, rho_zz_new, scalar_tend_save) + MPAS_ACC_TIMER_STOP('atm_advance_scalars [ACC_data_xfer]') end subroutine atm_advance_scalars_work @@ -3203,7 +3907,7 @@ end subroutine atm_advance_scalars_work !> to the work routine. ! !----------------------------------------------------------------------- - subroutine atm_advance_scalars_mono(field_name, block, tend, state, diag, diag_physics, mesh, halo_scratch, configs, dt, & + subroutine atm_advance_scalars_mono(field_name, block, tend, state, diag, mesh, halo_scratch, configs, dt, & cellStart, cellEnd, edgeStart, edgeEnd, & cellSolveStart, cellSolveEnd, & scalar_old, scalar_new, s_max, s_min, wdtn, flux_arr, & @@ -3218,7 +3922,6 @@ subroutine atm_advance_scalars_mono(field_name, block, tend, state, diag, diag_p 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) :: diag_physics type (mpas_pool_type), intent(in) :: mesh type (mpas_pool_type), intent(in) :: halo_scratch type (mpas_pool_type), intent(in) :: configs @@ -3310,7 +4013,7 @@ subroutine atm_advance_scalars_mono(field_name, block, tend, state, diag, diag_p call mpas_pool_get_dimension(state,'index_buoyx',index_buoyx) call mpas_pool_get_config(configs,'config_gf_cporg',config_gf_cporg) !--srf - call atm_advance_scalars_mono_work(block, state, nCells, nEdges, num_scalars, dt, & + call atm_advance_scalars_mono_work(field_name, block, state, nCells, nEdges, num_scalars, dt, & cellStart, cellEnd, edgeStart, edgeEnd, & cellSolveStart, cellSolveEnd, & coef_3rd_order, nCellsSolve, uhAvg, wwAvg, scalar_tend, rho_zz_old, & @@ -3327,7 +4030,7 @@ subroutine atm_advance_scalars_mono(field_name, block, tend, state, diag, diag_p call mpas_pool_get_array(diag, 'rumcl', rumcl) ! = umcl,vmcl if(.not. allocated(wwAvg_local)) allocate(wwAvg_local(nVertLevels+1,nCells+1)); wwAvg_local = 0.0_RKIND - call atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, num_scalars, dt, & + call atm_advance_scalars_mono_work_coldpool(field_name, block, state, nCells, nEdges, num_scalars, dt, & cellStart, cellEnd, edgeStart, edgeEnd, & cellSolveStart, cellSolveEnd, & coef_3rd_order, nCellsSolve, & @@ -3381,7 +4084,7 @@ end subroutine atm_advance_scalars_mono !> as used in the RK3 scheme as described in Wang et al MWR 2009 ! !----------------------------------------------------------------------- - subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, num_scalars, dt, & + subroutine atm_advance_scalars_mono_work(field_name, block, state, nCells, nEdges, num_scalars, dt, & cellStart, cellEnd, edgeStart, edgeEnd, & cellSolveStart, cellSolveEnd, & coef_3rd_order, nCellsSolve, uhAvg, wwAvg, scalar_tend, rho_zz_old, & @@ -3396,6 +4099,7 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, num_scala implicit none + character(len=*), intent(in) :: field_name type (block_type), intent(inout), target :: block type (mpas_pool_type), intent(inout) :: state integer, intent(in) :: index_buoyx !--srf @@ -3407,7 +4111,7 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, num_scala integer, intent(in) :: cellSolveStart, cellSolveEnd procedure (halo_exchange_routine) :: exchange_halo_group logical, intent(in), optional :: advance_density - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(inout), optional :: rho_zz_int + real (kind=RKIND), dimension(:,:), intent(inout), optional :: rho_zz_int integer :: ii,jj integer, dimension(10) :: ica @@ -3467,10 +4171,10 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, num_scala 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 - !-srf + +!-srf !print*,'atm_advance_scalars_work_mono : index_buoyx',index_buoyx !-srf - if (present(advance_density)) then local_advance_density = advance_density else @@ -3484,30 +4188,61 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, num_scala ! Note, however, that we enforce positive-definiteness in this update. ! The transport will maintain this positive definite solution and optionally, shape preservation (monotonicity). + + MPAS_ACC_TIMER_START('atm_advance_scalars_mono [ACC_data_xfer]') + !$acc data present(nEdgesOnCell, edgesOnCell, edgesOnCell_sign, & + !$acc invAreaCell, cellsOnCell, cellsOnEdge, nAdvCellsForEdge, & + !$acc advCellsForEdge, adv_coefs, adv_coefs_3rd, dvEdge, bdyMaskCell) + +#ifdef DO_PHYSICS + !$acc enter data copyin(scalar_tend) +#else + !$acc enter data create(scalar_tend) +#endif + if (local_advance_density) then + !$acc enter data copyin(rho_zz_int) + end if + !$acc enter data copyin(scalars_old, rho_zz_old, rdnw, uhAvg, wwAvg) + MPAS_ACC_TIMER_STOP('atm_advance_scalars_mono [ACC_data_xfer]') + + !$acc parallel + + !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd -!DIR$ IVDEP - do k = 1,nVertLevels -!DIR$ IVDEP - do iScalar = 1,num_scalars ; if(iScalar == index_buoyx) cycle !--srf + + !$acc loop vector collapse(2) + do k = 1,nVertLevels + do iScalar = 1,num_scalars; if(iScalar == index_buoyx) cycle !--srf #ifndef DO_PHYSICS !TBH: Michael, would you please check this change? Our test uses -DDO_PHYSICS !TBH: so this code is not executed. The change avoids redundant work. - scalar_tend(iScalar,k,iCell) = 0.0 ! testing purposes - we have no sources or sinks + scalar_tend(iScalar,k,iCell) = 0.0_RKIND ! testing purposes - we have no sources or sinks #endif - scalars_old(iScalar,k,iCell) = scalars_old(iScalar,k,iCell)+dt*scalar_tend(iScalar,k,iCell) / rho_zz_old(k,iCell) - scalar_tend(iScalar,k,iCell) = 0.0 - end do + scalars_old(iScalar,k,iCell) = scalars_old(iScalar,k,iCell)+dt*scalar_tend(iScalar,k,iCell) / rho_zz_old(k,iCell) + scalar_tend(iScalar,k,iCell) = 0.0_RKIND + end do end do + end do + !$acc end parallel + + MPAS_ACC_TIMER_START('atm_advance_scalars_mono [ACC_data_xfer]') + !$acc exit data copyout(scalar_tend) + + !$acc update self(scalars_old) + MPAS_ACC_TIMER_STOP('atm_advance_scalars_mono [ACC_data_xfer]') !$OMP BARRIER !$OMP MASTER - call exchange_halo_group(block % domain, 'dynamics:scalars_old') + call exchange_halo_group(block % domain, 'dynamics:'//trim(field_name)//'_old') !$OMP END MASTER !$OMP BARRIER + MPAS_ACC_TIMER_START('atm_advance_scalars_mono [ACC_data_xfer]') + !$acc update device(scalars_old) + MPAS_ACC_TIMER_STOP('atm_advance_scalars_mono [ACC_data_xfer]') ! ! Runge Kutta integration, so we compute fluxes from scalar_new values, update starts from scalar_old @@ -3518,53 +4253,82 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, num_scala call mpas_log_write('Error: rho_zz_int not supplied to atm_advance_scalars_mono_work( ) when advance_density=.true.', messageType=MPAS_LOG_CRIT) end if + !$acc parallel + ! begin with update of density + + !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd - rho_zz_int(:,iCell) = 0.0 + + !$acc loop vector + do k=1,nVertLevels + rho_zz_int(k,iCell) = 0.0_RKIND + end do + + !$acc loop seq do i=1,nEdgesOnCell(iCell) iEdge = edgesOnCell(i,iCell) -!DIR$ IVDEP + !$acc loop vector 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) + rho_zz_int(k,iCell) = rho_zz_int(k,iCell) - edgesOnCell_sign(i,iCell) & + * uhAvg(k,iEdge) * dvEdge(iEdge) * invAreaCell(iCell) end do end do end do + + !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd -!DIR$ IVDEP + + !$acc loop vector 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)) ) + 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 + + !$acc end parallel + !$OMP BARRIER + end if - ! next, do one scalar at a time + MPAS_ACC_TIMER_START('atm_advance_scalars_mono [ACC_data_xfer]') + if (.not. local_advance_density) then + !$acc enter data copyin(rho_zz_new) + end if + !$acc enter data copyin(scalars_new, fnm, fnp) + !$acc enter data create(scale_arr) + MPAS_ACC_TIMER_STOP('atm_advance_scalars_mono [ACC_data_xfer]') - do iScalar = 1, num_scalars ; if(iScalar == index_buoyx) cycle !--srf - !srf - !print*,'scalars',iScalar,maxval(scalars_new(iScalar,:,:)) - ! + do iScalar = 1, num_scalars; if(iScalar == index_buoyx) cycle !--srf + + !$acc parallel + !$acc loop gang worker do iCell=cellStart,cellEnd -!DIR$ IVDEP + + !$acc loop vector do k=1,nVertLevels scalar_old(k,iCell) = scalars_old(iScalar,k,iCell) scalar_new(k,iCell) = scalars_new(iScalar,k,iCell) 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 +#ifndef MPAS_OPENACC + do k=1,nVertLevels + scalar_old(k,nCells+1) = 0.0_RKIND + scalar_new(k,nCells+1) = 0.0_RKIND + end do +#endif + !$acc end parallel !$OMP BARRIER #ifdef DEBUG_TRANSPORT + !$acc update self(scalar_old) + scmin = scalar_old(1,1) scmax = scalar_old(1,1) do iCell = 1, nCells @@ -3575,6 +4339,8 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, num_scala end do call mpas_log_write(' scmin, scmin old in $r $r', realArgs=(/scmin,scmax/)) + !$acc update self(scalar_new) + scmin = scalar_new(1,1) scmax = scalar_new(1,1) do iCell = 1, nCells @@ -3586,15 +4352,17 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, num_scala call mpas_log_write(' scmin, scmin new in ', realArgs=(/scmin,scmax/)) #endif + !$acc parallel ! ! vertical flux divergence, and min and max bounds for flux limiter ! + !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd ! zero flux at top and bottom - wdtn(1,iCell) = 0.0 - wdtn(nVertLevels+1,iCell) = 0.0 + wdtn(1,iCell) = 0.0_RKIND + wdtn(nVertLevels+1,iCell) = 0.0_RKIND k = 1 s_max(k,iCell) = max(scalar_old(1,iCell),scalar_old(2,iCell)) @@ -3605,7 +4373,7 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, num_scala s_max(k,iCell) = max(scalar_old(k-1,iCell),scalar_old(k,iCell),scalar_old(k+1,iCell)) s_min(k,iCell) = min(scalar_old(k-1,iCell),scalar_old(k,iCell),scalar_old(k+1,iCell)) -!DIR$ IVDEP + !$acc loop vector do k=3,nVertLevels-1 wdtn(k,iCell) = flux3( scalar_new(k-2,iCell),scalar_new(k-1,iCell), & scalar_new(k ,iCell),scalar_new(k+1,iCell), & @@ -3627,7 +4395,7 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, num_scala ! original code retained in select "default" case select case(nEdgesOnCell(iCell)) case(6) -!DIR$ IVDEP + !$acc loop vector do k=1, nVertLevels s_max(k,iCell) = max(s_max(k,iCell), & scalar_old(k, cellsOnCell(1,iCell)), & @@ -3643,11 +4411,13 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, num_scala scalar_old(k, cellsOnCell(4,iCell)), & scalar_old(k, cellsOnCell(5,iCell)), & scalar_old(k, cellsOnCell(6,iCell))) - enddo + end do case default + !$acc loop seq do i=1, nEdgesOnCell(iCell) -!DIR$ IVDEP + + !$acc loop vector do k=1, nVertLevels s_max(k,iCell) = max(s_max(k,iCell),scalar_old(k, cellsOnCell(i,iCell))) s_min(k,iCell) = min(s_min(k,iCell),scalar_old(k, cellsOnCell(i,iCell))) @@ -3657,12 +4427,16 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, num_scala end do + !$acc end parallel + !$OMP BARRIER + !$acc parallel + ! ! horizontal flux divergence ! - + !$acc loop gang worker private(ica, swa) do iEdge=edgeStart,edgeEnd cell1 = cellsOnEdge(1,iEdge) @@ -3675,11 +4449,14 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, num_scala ! be sure to see additional declarations near top of subroutine select case(nAdvCellsForEdge(iEdge)) case(10) + !$acc loop vector do jj=1,10 ica(jj) = advCellsForEdge(jj,iEdge) swa(jj,1) = adv_coefs(jj,iEdge) + adv_coefs_3rd(jj,iEdge) swa(jj,2) = adv_coefs(jj,iEdge) - adv_coefs_3rd(jj,iEdge) - enddo + end do + + !$acc loop vector do k=1,nVertLevels ii = merge(1, 2, uhAvg(k,iEdge) > 0) flux_arr(k,iEdge) = uhAvg(k,iEdge)*( & @@ -3688,15 +4465,19 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, num_scala swa(5,ii)*scalar_new(k,ica(5)) + swa(6,ii)*scalar_new(k,ica(6)) + & swa(7,ii)*scalar_new(k,ica(7)) + swa(8,ii)*scalar_new(k,ica(8)) + & swa(9,ii)*scalar_new(k,ica(9)) + swa(10,ii)*scalar_new(k,ica(10))) - enddo + end do case default + !$acc loop vector do k=1,nVertLevels flux_arr(k,iEdge) = 0.0_RKIND - enddo + end do + + !$acc loop seq do i=1,nAdvCellsForEdge(iEdge) iCell = advCellsForEdge(i,iEdge) -!DIR$ IVDEP + + !$acc loop vector do k=1,nVertLevels scalar_weight = uhAvg(k,iEdge)*(adv_coefs(i,iEdge) + sign(1.0_RKIND,uhAvg(k,iEdge))*adv_coefs_3rd(i,iEdge)) flux_arr(k,iEdge) = flux_arr(k,iEdge) + scalar_weight* scalar_new(k,iCell) @@ -3705,43 +4486,55 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, num_scala end select else - flux_arr(:,iEdge) = 0.0_RKIND + + !$acc loop vector + do k=1,nVertLevels + flux_arr(k,iEdge) = 0.0_RKIND + end do + end if end do + !$acc end parallel + !$OMP BARRIER + !$acc parallel + ! ! vertical flux divergence for upwind update, we will put upwind update into scalar_new, and put factor of dt in fluxes ! + !$acc loop gang worker private(flux_upwind_arr) do iCell=cellSolveStart,cellSolveEnd k = 1 scalar_new(k,iCell) = scalar_old(k,iCell) * rho_zz_old(k,iCell) -!DIR$ IVDEP + !$acc loop vector do k = 2, nVertLevels scalar_new(k,iCell) = scalar_old(k,iCell)*rho_zz_old(k,iCell) flux_upwind_arr(k) = dt*(max(0.0_RKIND,wwAvg(k,iCell))*scalar_old(k-1,iCell) + min(0.0_RKIND,wwAvg(k,iCell))*scalar_old(k,iCell)) end do + + !$acc loop vector do k = 1, nVertLevels-1 scalar_new(k,iCell) = scalar_new(k,iCell) - flux_upwind_arr(k+1)*rdnw(k) end do -!DIR$ IVDEP + + !$acc loop vector do k = 2, nVertLevels scalar_new(k ,iCell) = scalar_new(k ,iCell) + flux_upwind_arr(k)*rdnw(k) wdtn(k,iCell) = dt*wdtn(k,iCell) - flux_upwind_arr(k) end do - ! ! scale_arr(SCALE_IN,:,:) and scale_arr(SCALE_OUT:,:) are used here to store the incoming and outgoing perturbation flux ! contributions to the update: first the vertical flux component, then the horizontal ! -!DIR$ IVDEP + !$acc loop vector do k=1,nVertLevels scale_arr(k,SCALE_IN, iCell) = - rdnw(k)*(min(0.0_RKIND,wdtn(k+1,iCell))-max(0.0_RKIND,wdtn(k,iCell))) scale_arr(k,SCALE_OUT,iCell) = - rdnw(k)*(max(0.0_RKIND,wdtn(k+1,iCell))-min(0.0_RKIND,wdtn(k,iCell))) @@ -3754,28 +4547,43 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, num_scala ! ! upwind flux computation + !$acc loop gang worker do iEdge=edgeStart,edgeEnd + cell1 = cellsOnEdge(1,iEdge) cell2 = cellsOnEdge(2,iEdge) -!DIR$ IVDEP - do k=1, nVertLevels + + !$acc loop vector + do k=1,nVertLevels flux_upwind_tmp(k,iEdge) = dvEdge(iEdge) * dt * & (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) + !$acc loop vector + do k=1,nVertLevels + flux_tmp(k,iEdge) = 0.0_RKIND + flux_arr(k,iEdge) = flux_upwind_tmp(k,iEdge) + end do end if end do + + !$acc end parallel + !$OMP BARRIER + + !$acc parallel + + !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd + + !$acc loop seq do i=1,nEdgesOnCell(iCell) iEdge = edgesOnCell(i,iCell) -!DIR$ IVDEP + !$acc loop vector do k=1, nVertLevels scalar_new(k,iCell) = scalar_new(k,iCell) - edgesOnCell_sign(i,iCell) * flux_upwind_tmp(k,iEdge) * invAreaCell(iCell) @@ -3788,6 +4596,7 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, num_scala end do end do + ! ! next, the limiter ! @@ -3795,51 +4604,69 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, num_scala ! simplification of limiter calculations ! worked through algebra and found equivalent form ! added benefit that it should address ifort single prec overflow issue - if (local_advance_density) then - do iCell=cellSolveStart,cellSolveEnd -!DIR$ IVDEP - do k = 1, nVertLevels + if (local_advance_density) then + !$acc loop gang worker + do iCell=cellSolveStart,cellSolveEnd - scale_factor = (s_max(k,iCell)*rho_zz_int(k,iCell) - scalar_new(k,iCell)) / & - (scale_arr(k,SCALE_IN,iCell) + eps) - scale_arr(k,SCALE_IN,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) ) + !$acc loop vector + do k = 1, nVertLevels + scale_factor = (s_max(k,iCell)*rho_zz_int(k,iCell) - scalar_new(k,iCell)) / & + (scale_arr(k,SCALE_IN,iCell) + eps) + scale_arr(k,SCALE_IN,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) ) - scale_factor = (s_min(k,iCell)*rho_zz_int(k,iCell) - scalar_new(k,iCell)) / & - (scale_arr(k,SCALE_OUT,iCell) - eps) - scale_arr(k,SCALE_OUT,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) ) + scale_factor = (s_min(k,iCell)*rho_zz_int(k,iCell) - scalar_new(k,iCell)) / & + (scale_arr(k,SCALE_OUT,iCell) - eps) + scale_arr(k,SCALE_OUT,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) ) + end do end do - end do - else - do iCell=cellSolveStart,cellSolveEnd -!DIR$ IVDEP - do k = 1, nVertLevels + else + !$acc loop gang worker + do iCell=cellSolveStart,cellSolveEnd - scale_factor = (s_max(k,iCell)*rho_zz_new(k,iCell) - scalar_new(k,iCell)) / & - (scale_arr(k,SCALE_IN,iCell) + eps) - scale_arr(k,SCALE_IN,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) ) + !$acc loop vector + do k = 1, nVertLevels + scale_factor = (s_max(k,iCell)*rho_zz_new(k,iCell) - scalar_new(k,iCell)) / & + (scale_arr(k,SCALE_IN,iCell) + eps) + scale_arr(k,SCALE_IN,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) ) - scale_factor = (s_min(k,iCell)*rho_zz_new(k,iCell) - scalar_new(k,iCell)) / & - (scale_arr(k,SCALE_OUT,iCell) - eps) - scale_arr(k,SCALE_OUT,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) ) + scale_factor = (s_min(k,iCell)*rho_zz_new(k,iCell) - scalar_new(k,iCell)) / & + (scale_arr(k,SCALE_OUT,iCell) - eps) + scale_arr(k,SCALE_OUT,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) ) + end do end do - end do - end if + end if + + !$acc end parallel ! ! communicate scale factors here. ! communicate only first halo row in these next two exchanges ! + + MPAS_ACC_TIMER_START('atm_advance_scalars_mono [ACC_data_xfer]') + !$acc update self(scale_arr) + MPAS_ACC_TIMER_STOP('atm_advance_scalars_mono [ACC_data_xfer]') + !$OMP BARRIER !$OMP MASTER call exchange_halo_group(block % domain, 'dynamics:scale') !$OMP END MASTER !$OMP BARRIER + MPAS_ACC_TIMER_START('atm_advance_scalars_mono [ACC_data_xfer]') + !$acc update device(scale_arr) + MPAS_ACC_TIMER_STOP('atm_advance_scalars_mono [ACC_data_xfer]') + + !$acc parallel + + !$acc loop gang worker do iEdge=edgeStart,edgeEnd cell1 = cellsOnEdge(1,iEdge) cell2 = cellsOnEdge(2,iEdge) + if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then ! only for owned cells -!DIR$ IVDEP + + !$acc loop vector do k=1, nVertLevels flux_upwind = dvEdge(iEdge) * dt * & (max(0.0_RKIND,uhAvg(k,iEdge))*scalar_old(k,cell1) + min(0.0_RKIND,uhAvg(k,iEdge))*scalar_old(k,cell2)) @@ -3847,7 +4674,10 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, num_scala end do if( config_apply_lbcs .and. (bdyMaskEdge(iEdge) == nRelaxZone) .or. (bdyMaskEdge(iEdge) == nRelaxZone-1) ) then - flux_arr(:,iEdge) = 0. + !$acc loop vector + do k=1,nVertLevels + flux_arr(k,iEdge) = 0.0_RKIND + end do end if end if @@ -3859,11 +4689,14 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, num_scala ! moved assignment to scalar_new from separate loop (see commented code below) ! into the following loops. Avoids having to save elements of flux array + !$acc loop gang worker do iEdge=edgeStart,edgeEnd cell1 = cellsOnEdge(1,iEdge) cell2 = cellsOnEdge(2,iEdge) + if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then -!DIR$ IVDEP + + !$acc loop vector do k = 1, nVertLevels flux = flux_arr(k,iEdge) flux = max(0.0_RKIND,flux) * min(scale_arr(k,SCALE_OUT,cell1), scale_arr(k,SCALE_IN, cell2)) & @@ -3872,14 +4705,21 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, num_scala end do end if end do - - ! - ! rescale the vertical flux - ! + + !$acc end parallel + + ! + ! rescale the vertical flux + ! + !$OMP BARRIER + + !$acc parallel + !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd -!DIR$ IVDEP + + !$acc loop vector do k = 2, nVertLevels flux = wdtn(k,iCell) flux = max(0.0_RKIND,flux) * min(scale_arr(k-1,SCALE_OUT,iCell), scale_arr(k ,SCALE_IN,iCell)) & @@ -3888,33 +4728,42 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, num_scala end do end do - ! ! do the scalar update now that we have the fluxes ! + !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd + + !$acc loop seq do i=1,nEdgesOnCell(iCell) iEdge = edgesOnCell(i,iCell) -!DIR$ IVDEP + + !$acc loop vector do k=1,nVertLevels scalar_new(k,iCell) = scalar_new(k,iCell) - edgesOnCell_sign(i,iCell)*flux_arr(k,iEdge) * invAreaCell(iCell) end do end do - if (local_advance_density) then -!DIR$ IVDEP - do k=1,nVertLevels - scalar_new(k,iCell) = ( scalar_new(k,iCell) + (-rdnw(k)*(wdtn(k+1,iCell)-wdtn(k,iCell)) ) )/rho_zz_int(k,iCell) - end do - else -!DIR$ IVDEP - do k=1,nVertLevels - scalar_new(k,iCell) = ( scalar_new(k,iCell) + (-rdnw(k)*(wdtn(k+1,iCell)-wdtn(k,iCell)) ) )/rho_zz_new(k,iCell) - end do - end if + if (local_advance_density) then + !$acc loop vector + do k=1,nVertLevels + scalar_new(k,iCell) = (scalar_new(k,iCell) + (-rdnw(k)*(wdtn(k+1,iCell)-wdtn(k,iCell)) ) )/rho_zz_int(k,iCell) + end do + else + !$acc loop vector + do k=1,nVertLevels + scalar_new(k,iCell) = (scalar_new(k,iCell) + (-rdnw(k)*(wdtn(k+1,iCell)-wdtn(k,iCell)) ) )/rho_zz_new(k,iCell) + end do + end if end do + !$acc end parallel + #ifdef DEBUG_TRANSPORT + !$acc update self(scalar_new) + !$acc update self(s_max) + !$acc update self(s_min) + scmin = scalar_new(1,1) scmax = scalar_new(1,1) do iCell = 1, nCellsSolve @@ -3937,16 +4786,35 @@ subroutine atm_advance_scalars_mono_work(block, state, nCells, nEdges, num_scala ! hence the enforcement of PD in the copy back to the model state. !$OMP BARRIER + !$acc parallel + + !$acc loop gang worker do iCell=cellStart,cellEnd if(bdyMaskCell(iCell) <= nSpecZone) then ! regional_MPAS does spec zone update after transport. - do k=1, nVertLevels + !$acc loop vector + do k=1,nVertLevels scalars_new(iScalar,k,iCell) = max(0.0_RKIND,scalar_new(k,iCell)) end do end if end do + !$acc end parallel + end do ! loop over scalars + MPAS_ACC_TIMER_START('atm_advance_scalars_mono [ACC_data_xfer]') + if (local_advance_density) then + !$acc exit data copyout(rho_zz_int) + else + !$acc exit data delete(rho_zz_new) + end if + !$acc exit data copyout(scalars_new) + !$acc exit data delete(scalars_old, scale_arr, rho_zz_old, wwAvg, & + !$acc uhAvg, fnm, fnp, rdnw) + + !$acc end data + MPAS_ACC_TIMER_STOP('atm_advance_scalars_mono [ACC_data_xfer]') + end subroutine atm_advance_scalars_mono_work @@ -4376,6 +5244,47 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm flux4(q_im2, q_im1, q_i, q_ip1, ua) + & coef3*abs(ua)*((q_ip1 - q_im2)-3.*(q_i-q_im1))/12.0 + + MPAS_ACC_TIMER_START('atm_compute_dyn_tend_work [ACC_data_xfer]') + if (rk_step == 1) then + !$acc enter data create(tend_w_euler) + !$acc enter data create(tend_u_euler) + !$acc enter data create(tend_theta_euler) + !$acc enter data create(tend_rho) + + !$acc enter data create(kdiff) + !$acc enter data copyin(tend_rho_physics) + !$acc enter data copyin(rb, rr_save) + !$acc enter data copyin(divergence, vorticity) + !$acc enter data copyin(v) + !$acc enter data copyin(u_init, v_init) + else + !$acc enter data copyin(tend_w_euler) + !$acc enter data copyin(tend_u_euler) + !$acc enter data copyin(tend_theta_euler) + !$acc enter data copyin(tend_rho) + end if + !$acc enter data create(tend_u) + !$acc enter data copyin(cqu, pp, u, w, pv_edge, rho_edge, ke) + !$acc enter data create(h_divergence) + !$acc enter data copyin(ru, rw) + !$acc enter data create(rayleigh_damp_coef) + !$acc enter data copyin(tend_ru_physics) + !$acc enter data create(tend_w) + !$acc enter data copyin(rho_zz) + !$acc enter data create(tend_theta) + !$acc enter data copyin(theta_m) + !$acc enter data copyin(ru_save, theta_m_save) + !$acc enter data copyin(cqw) + !$acc enter data copyin(tend_rtheta_physics) + !$acc enter data copyin(rw_save, rt_diabatic_tend) + !$acc enter data create(rthdynten) + !$acc enter data copyin(t_init) +#ifdef CURVATURE + !$acc enter data copyin(ur_cell, vr_cell) +#endif + MPAS_ACC_TIMER_STOP('atm_compute_dyn_tend_work [ACC_data_xfer]') + prandtl_inv = 1.0_RKIND / prandtl invDt = 1.0_RKIND / dt inv_r_earth = 1.0_RKIND / r_earth @@ -4385,16 +5294,34 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm if (rk_step == 1) then -! tend_u_euler(1:nVertLevels,edgeStart:edgeEnd) = 0.0 + !$acc parallel default(present) + !$acc loop gang worker + do iEdge = edgeStart, edgeEnd + !$acc loop vector + do k = 1, nVertLevels + tend_u_euler(k,iEdge) = 0.0_RKIND + end do + end do + !$acc end parallel ! Smagorinsky eddy viscosity, based on horizontal deformation (in this case on model coordinate surfaces). ! The integration coefficients were precomputed and stored in defc_a and defc_b if(config_horiz_mixing == "2d_smagorinsky") then + + !$acc parallel default(present) + !$acc loop gang worker private(d_diag, d_off_diag) do iCell = cellStart,cellEnd - d_diag(1:nVertLevels) = 0.0 - d_off_diag(1:nVertLevels) = 0.0 + + !$acc loop vector + do k = 1, nVertLevels + d_diag(k) = 0.0_RKIND + d_off_diag(k) = 0.0_RKIND + end do + + !$acc loop seq do iEdge=1,nEdgesOnCell(iCell) + !$acc loop vector do k=1,nVertLevels d_diag(k) = d_diag(k) + defc_a(iEdge,iCell)*u(k,EdgesOnCell(iEdge,iCell)) & - defc_b(iEdge,iCell)*v(k,EdgesOnCell(iEdge,iCell)) @@ -4403,19 +5330,30 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm end do end do !DIR$ IVDEP + !$acc loop vector do k=1, nVertLevels ! here is the Smagorinsky formulation, ! followed by imposition of an upper bound on the eddy viscosity kdiff(k,iCell) = min((c_s * config_len_disp)**2 * sqrt(d_diag(k)**2 + d_off_diag(k)**2),(0.01*config_len_disp**2) * invDt) end do end do + !$acc end parallel h_mom_eddy_visc4 = config_visc4_2dsmag * config_len_disp**3 h_theta_eddy_visc4 = h_mom_eddy_visc4 else if(config_horiz_mixing == "2d_fixed") then - kdiff(1:nVertLevels,cellStart:cellEnd) = config_h_theta_eddy_visc2 + !$acc parallel default(present) + !$acc loop gang worker + do iCell = cellStart, cellEnd + !$acc loop vector + do k = 1, nVertLevels + kdiff(k,iCell) = config_h_theta_eddy_visc2 + end do + end do + !$acc end parallel + h_mom_eddy_visc4 = config_h_mom_eddy_visc4 h_theta_eddy_visc4 = config_h_theta_eddy_visc4 @@ -4423,17 +5361,21 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm if (config_mpas_cam_coef > 0.0) then + !$acc parallel default(present) + !$acc loop gang worker do iCell = cellStart,cellEnd ! ! 2nd-order filter for top absorbing layer similar to that in CAM-SE : WCS 10 May 2017, modified 7 April 2023 ! From MPAS-CAM V4.0 code, with addition to config-specified coefficient (V4.0_coef = 0.2; SE_coef = 1.0) ! + !$acc loop vector do k = nVertLevels-config_number_cam_damping_levels + 1, nVertLevels visc2cam = 4.0*2.0833*config_len_disp*config_mpas_cam_coef visc2cam = visc2cam*(1.0-real(nVertLevels-k)/real(config_number_cam_damping_levels)) - kdiff(k ,iCell) = max(kdiff(nVertLevels ,iCell),visc2cam) + kdiff(k ,iCell) = max(kdiff(k ,iCell),visc2cam) end do end do + !$acc end parallel end if @@ -4444,26 +5386,40 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm ! accumulate horizontal mass-flux + !$acc parallel default(present) + !$acc loop gang worker do iCell=cellStart,cellEnd - h_divergence(1:nVertLevels,iCell) = 0.0 + + !$acc loop vector + do k=1,nVertLevels + h_divergence(k,iCell) = 0.0_RKIND + end do + + !$acc loop seq do i=1,nEdgesOnCell(iCell) iEdge = edgesOnCell(i,iCell) edge_sign = edgesOnCell_sign(i,iCell) * dvEdge(iEdge) !DIR$ IVDEP + !$acc loop vector do k=1,nVertLevels h_divergence(k,iCell) = h_divergence(k,iCell) + edge_sign * ru(k,iEdge) end do end do end do + !$acc end parallel ! compute horiontal mass-flux divergence, add vertical mass flux divergence to complete tend_rho + !$acc parallel default(present) + !$acc loop gang worker do iCell = cellStart,cellEnd r = invAreaCell(iCell) + !$acc loop vector do k = 1,nVertLevels h_divergence(k,iCell) = h_divergence(k,iCell) * r end do end do + !$acc end parallel ! ! dp / dz and tend_rho @@ -4473,14 +5429,20 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm if(rk_step == 1) then rgas_cprcv = rgas*cp/cv + + !$acc parallel default(present) + !$acc loop gang worker do iCell = cellStart,cellEnd !DIR$ IVDEP + !$acc loop vector do k = 1,nVertLevels tend_rho(k,iCell) = -h_divergence(k,iCell)-rdzw(k)*(rw(k+1,iCell)-rw(k,iCell)) + tend_rho_physics(k,iCell) dpdz(k,iCell) = -gravity*(rb(k,iCell)*(qtot(k,iCell)) + rr_save(k,iCell)*(1.+qtot(k,iCell))) end do end do + !$acc end parallel + end if !$OMP BARRIER @@ -4489,6 +5451,8 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm ! Compute u (normal) velocity tendency for each edge (cell face) ! + !$acc parallel default(present) + !$acc loop gang worker private(wduz, q) do iEdge=edgeSolveStart,edgeSolveEnd cell1 = cellsOnEdge(1,iEdge) @@ -4498,6 +5462,7 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm if(rk_step == 1) then !DIR$ IVDEP + !$acc loop vector do k=1,nVertLevels tend_u_euler(k,iEdge) = - cqu(k,iEdge)*( (pp(k,cell2)-pp(k,cell1))*invDcEdge(iEdge)/(.5*(zz(k,cell2)+zz(k,cell1))) & -0.5*zxu(k,iEdge)*(dpdz(k,cell1)+dpdz(k,cell2)) ) @@ -4511,6 +5476,7 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm k = 2 wduz(k) = 0.5*( rw(k,cell1)+rw(k,cell2))*(fzm(k)*u(k,iEdge)+fzp(k)*u(k-1,iEdge)) + !$acc loop vector do k=3,nVertLevels-1 wduz(k) = flux3( u(k-2,iEdge),u(k-1,iEdge),u(k,iEdge),u(k+1,iEdge),0.5*(rw(k,cell1)+rw(k,cell2)), 1.0_RKIND ) end do @@ -4520,15 +5486,23 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm wduz(nVertLevels+1) = 0. !DIR$ IVDEP + !$acc loop vector do k=1,nVertLevels tend_u(k,iEdge) = - rdzw(k)*(wduz(k+1)-wduz(k)) ! first use of tend_u end do ! Next, nonlinear Coriolis term (q) following Ringler et al JCP 2009 - q(:) = 0.0 + !$acc loop vector + do k=1,nVertLevels + q(k) = 0.0_RKIND + end do + + !$acc loop seq do j = 1,nEdgesOnEdge(iEdge) eoe = edgesOnEdge(j,iEdge) + + !$acc loop vector do k=1,nVertLevels workpv = 0.5 * (pv_edge(k,iEdge) + pv_edge(k,eoe)) ! the original definition of pv_edge had a factor of 1/density. We have removed that factor @@ -4538,6 +5512,7 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm end do !DIR$ IVDEP + !$acc loop vector do k=1,nVertLevels ! horizontal ke gradient and vorticity terms in the vector invariant formulation @@ -4556,7 +5531,7 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm end do end do - + !$acc end parallel ! ! horizontal mixing for u @@ -4571,8 +5546,18 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm ! del^4 horizontal filter. We compute this as del^2 ( del^2 (u) ). ! First, storage to hold the result from the first del^2 computation. - delsq_u(1:nVertLevels,edgeStart:edgeEnd) = 0.0 + !$acc parallel default(present) + !$acc loop gang worker + do iEdge = edgeStart, edgeEnd + !$acc loop vector + do k = 1, nVertLevels + delsq_u(k,iEdge) = 0.0_RKIND + end do + end do + !$acc end parallel + !$acc parallel default(present) + !$acc loop gang worker do iEdge=edgeStart,edgeEnd cell1 = cellsOnEdge(1,iEdge) cell2 = cellsOnEdge(2,iEdge) @@ -4582,6 +5567,7 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm r_dv = min(invDvEdge(iEdge), 4*invDcEdge(iEdge)) !DIR$ IVDEP + !$acc loop vector do k=1,nVertLevels ! Compute diffusion, computed as \nabla divergence - k \times \nabla vorticity @@ -4599,39 +5585,60 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm end do end do + !$acc end parallel if (h_mom_eddy_visc4 > 0.0) then ! 4th order mixing is active !$OMP BARRIER + !$acc parallel default(present) + !$acc loop gang worker do iVertex=vertexStart,vertexEnd - delsq_vorticity(1:nVertLevels,iVertex) = 0.0 + + !$acc loop vector + do k=1,nVertLevels + delsq_vorticity(k,iVertex) = 0.0_RKIND + end do + + !$acc loop seq do i=1,vertexDegree iEdge = edgesOnVertex(i,iVertex) edge_sign = invAreaTriangle(iVertex) * dcEdge(iEdge) * edgesOnVertex_sign(i,iVertex) + + !$acc loop vector do k=1,nVertLevels delsq_vorticity(k,iVertex) = delsq_vorticity(k,iVertex) + edge_sign * delsq_u(k,iEdge) end do end do end do + !$acc loop gang worker do iCell=cellStart,cellEnd - delsq_divergence(1:nVertLevels,iCell) = 0.0 + + !$acc loop vector + do k=1,nVertLevels + delsq_divergence(k,iCell) = 0.0_RKIND + end do + r = invAreaCell(iCell) + + !$acc loop seq do i=1,nEdgesOnCell(iCell) iEdge = edgesOnCell(i,iCell) edge_sign = r * dvEdge(iEdge) * edgesOnCell_sign(i,iCell) + + !$acc loop vector do k=1,nVertLevels delsq_divergence(k,iCell) = delsq_divergence(k,iCell) + edge_sign * delsq_u(k,iEdge) end do end do end do - - - + !$acc end parallel !$OMP BARRIER + !$acc parallel default(present) + !$acc loop gang worker do iEdge=edgeSolveStart,edgeSolveEnd cell1 = cellsOnEdge(1,iEdge) cell2 = cellsOnEdge(2,iEdge) @@ -4643,6 +5650,7 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm r_dv = u_mix_scale * min(invDvEdge(iEdge), 4*invDcEdge(iEdge)) !DIR$ IVDEP + !$acc loop vector do k=1,nVertLevels ! Compute diffusion, computed as \nabla divergence - k \times \nabla vorticity @@ -4658,6 +5666,7 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm end do end do + !$acc end parallel end if ! 4th order mixing is active @@ -4668,11 +5677,14 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm if (config_mix_full) then ! mix full state + !$acc parallel default(present) + !$acc loop gang worker do iEdge=edgeSolveStart,edgeSolveEnd cell1 = cellsOnEdge(1,iEdge) cell2 = cellsOnEdge(2,iEdge) + !$acc loop vector do k=2,nVertLevels-1 z1 = 0.5*(zgrid(k-1,cell1)+zgrid(k-1,cell2)) @@ -4689,19 +5701,24 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm -(u(k ,iEdge)-u(k-1,iEdge))/(z0-zm) )/(0.5*(zp-zm)) end do end do + !$acc end parallel else ! idealized cases where we mix on the perturbation from the initial 1-D state + !$acc parallel default(present) + !$acc loop gang worker private(u_mix) do iEdge=edgeSolveStart,edgeSolveEnd cell1 = cellsOnEdge(1,iEdge) cell2 = cellsOnEdge(2,iEdge) + !$acc loop vector do k=1,nVertLevels u_mix(k) = u(k,iEdge) - u_init(k) * cos( angleEdge(iEdge) ) & - v_init(k) * sin( angleEdge(iEdge) ) end do + !$acc loop vector do k=2,nVertLevels-1 z1 = 0.5*(zgrid(k-1,cell1)+zgrid(k-1,cell2)) @@ -4718,6 +5735,7 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm -(u_mix(k )-u_mix(k-1))/(z0-zm) )/(0.5*(zp-zm)) end do end do + !$acc end parallel end if ! mix perturbation state @@ -4731,52 +5749,81 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm ! Rayleigh damping on u if (config_rayleigh_damp_u) then + + !$acc parallel default(present) rayleigh_coef_inverse = 1.0 / ( real(config_number_rayleigh_damp_u_levels) & * (config_rayleigh_damp_u_timescale_days*seconds_per_day) ) + + !$acc loop gang vector 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 + !$acc end parallel + !$acc parallel default(present) + !$acc loop gang worker do iEdge=edgeSolveStart,edgeSolveEnd !DIR$ IVDEP + !$acc loop vector 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 + !$acc end parallel + end if + !$acc parallel default(present) + !$acc loop gang worker do iEdge=edgeSolveStart,edgeSolveEnd !DIR$ IVDEP + !$acc loop vector do k=1,nVertLevels ! tend_u(k,iEdge) = tend_u(k,iEdge) + tend_u_euler(k,iEdge) tend_u(k,iEdge) = tend_u(k,iEdge) + tend_u_euler(k,iEdge) + tend_ru_physics(k,iEdge) end do end do + !$acc end parallel !----------- rhs for w - ! ! horizontal advection for w ! + !$acc parallel default(present) + !$acc loop gang worker private(ru_edge_w, flux_arr) do iCell=cellSolveStart,cellSolveEnd ! Technically updating fewer cells than before... - tend_w(1:nVertLevels+1,iCell) = 0.0 + + !$acc loop vector + do k=1,nVertLevels+1 + tend_w(k,iCell) = 0.0_RKIND + end do + + !$acc loop seq do i=1,nEdgesOnCell(iCell) + iEdge = edgesOnCell(i,iCell) edge_sign = edgesOnCell_sign(i,iCell) * dvEdge(iEdge) * 0.5 + !$acc loop vector do k=2,nVertLevels ru_edge_w(k) = fzm(k)*ru(k,iEdge) + fzp(k)*ru(k-1,iEdge) end do - flux_arr(1:nVertLevels) = 0.0 + !$acc loop vector + do k=1,nVertLevels + flux_arr(k) = 0.0_RKIND + end do ! flux_arr stores the value of w at the cell edge used in the horizontal transport + !$acc loop seq do j=1,nAdvCellsForEdge(iEdge) iAdvCell = advCellsForEdge(j,iEdge) + + !$acc loop vector do k=2,nVertLevels scalar_weight = adv_coefs(j,iEdge) + sign(1.0_RKIND,ru_edge_w(k)) * adv_coefs_3rd(j,iEdge) flux_arr(k) = flux_arr(k) + scalar_weight * w(k,iAdvCell) @@ -4784,16 +5831,21 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm end do !DIR$ IVDEP + !$acc loop vector do k=2,nVertLevels tend_w(k,iCell) = tend_w(k,iCell) - edgesOnCell_sign(i,iCell) * ru_edge_w(k)*flux_arr(k) end do end do end do + !$acc end parallel #ifdef CURVATURE + !$acc parallel default(present) + !$acc loop gang worker do iCell = cellSolveStart, cellSolveEnd !DIR$ IVDEP + !$acc loop vector do k=2,nVertLevels tend_w(k,iCell) = tend_w(k,iCell) + (rho_zz(k,iCell)*fzm(k)+rho_zz(k-1,iCell)*fzp(k))* & ( (fzm(k)*ur_cell(k,iCell)+fzp(k)*ur_cell(k-1,iCell))**2. & @@ -4804,9 +5856,10 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm end do end do + !$acc end parallel + #endif - ! ! horizontal mixing for w - we could combine this with advection directly (i.e. as a turbulent flux), ! but here we can also code in hyperdiffusion if we wish (2nd order at present) @@ -4821,12 +5874,23 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm ! First, storage to hold the result from the first del^2 computation. ! we copied code from the theta mixing, hence the theta* names. + !$acc parallel default(present) + !$acc loop gang worker + do iCell=cellStart,cellEnd - delsq_w(1:nVertLevels,cellStart:cellEnd) = 0.0 + !$acc loop vector + do k=1,nVertLevels + delsq_w(k,iCell) = 0.0_RKIND + end do + + !$acc loop vector + do k=1,nVertLevels+1 + tend_w_euler(k,iCell) = 0.0_RKIND + end do - do iCell=cellStart,cellEnd - tend_w_euler(1:nVertLevels+1,iCell) = 0.0 r_areaCell = invAreaCell(iCell) + + !$acc loop seq do i=1,nEdgesOnCell(iCell) iEdge = edgesOnCell(i,iCell) @@ -4836,6 +5900,7 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm cell2 = cellsOnEdge(2,iEdge) !DIR$ IVDEP + !$acc loop vector do k=2,nVertLevels w_turb_flux = edge_sign*(rho_edge(k,iEdge)+rho_edge(k-1,iEdge))*(w(k,cell2) - w(k,cell1)) @@ -4846,13 +5911,19 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm end do end do end do + !$acc end parallel !$OMP BARRIER if (h_mom_eddy_visc4 > 0.0) then ! 4th order mixing is active + !$acc parallel default(present) + !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd ! Technically updating fewer cells than before... + r_areaCell = h_mom_eddy_visc4 * invAreaCell(iCell) + + !$acc loop seq do i=1,nEdgesOnCell(iCell) iEdge = edgesOnCell(i,iCell) cell1 = cellsOnEdge(1,iEdge) @@ -4860,12 +5931,14 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm edge_sign = meshScalingDel4(iEdge)*r_areaCell*dvEdge(iEdge)*edgesOnCell_sign(i,iCell) * invDcEdge(iEdge) + !$acc loop vector do k=2,nVertLevels tend_w_euler(k,iCell) = tend_w_euler(k,iCell) - edge_sign * (delsq_w(k,cell2) - delsq_w(k,cell1)) end do end do end do + !$acc end parallel end if ! 4th order mixing is active @@ -4882,15 +5955,20 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm ! vertical advection, pressure gradient and buoyancy for w ! + !$acc parallel default(present) + !$acc loop gang worker private(wdwz) do iCell=cellSolveStart,cellSolveEnd wdwz(1) = 0.0 k = 2 wdwz(k) = 0.25*(rw(k,icell)+rw(k-1,iCell))*(w(k,iCell)+w(k-1,iCell)) + + !$acc loop vector do k=3,nVertLevels-1 wdwz(k) = flux3( w(k-2,iCell),w(k-1,iCell),w(k,iCell),w(k+1,iCell),0.5*(rw(k,iCell)+rw(k-1,iCell)), 1.0_RKIND ) end do + k = nVertLevels wdwz(k) = 0.25*(rw(k,icell)+rw(k-1,iCell))*(w(k,iCell)+w(k-1,iCell)) @@ -4899,12 +5977,14 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm ! Note: next we are also dividing through by the cell area after the horizontal flux divergence !DIR$ IVDEP + !$acc loop vector do k=2,nVertLevels tend_w(k,iCell) = tend_w(k,iCell) * invAreaCell(iCell) -rdzu(k)*(wdwz(k+1)-wdwz(k)) end do if(rk_step == 1) then !DIR$ IVDEP + !$acc loop vector do k=2,nVertLevels tend_w_euler(k,iCell) = tend_w_euler(k,iCell) - cqw(k,iCell)*( & rdzu(k)*(pp(k,iCell)-pp(k-1,iCell)) & @@ -4913,19 +5993,24 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm end if end do + !$acc end parallel if (rk_step == 1) then if ( v_mom_eddy_visc2 > 0.0 ) then + !$acc parallel default(present) + !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd !DIR$ IVDEP + !$acc loop vector do k=2,nVertLevels tend_w_euler(k,iCell) = tend_w_euler(k,iCell) + v_mom_eddy_visc2*0.5*(rho_zz(k,iCell)+rho_zz(k-1,iCell))*( & (w(k+1,iCell)-w(k ,iCell))*rdzw(k) & -(w(k ,iCell)-w(k-1,iCell))*rdzw(k-1) )*rdzu(k) end do end do + !$acc end parallel end if @@ -4933,12 +6018,16 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm ! add in mixing terms for w + !$acc parallel default(present) + !$acc loop gang worker do iCell = cellSolveStart,cellSolveEnd !DIR$ IVDEP + !$acc loop vector do k=2,nVertLevels tend_w(k,iCell) = tend_w(k,iCell) + tend_w_euler(k,iCell) end do end do + !$acc end parallel !----------- rhs for theta @@ -4946,15 +6035,29 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm ! horizontal advection for theta ! + !$acc parallel default(present) + !$acc loop gang worker private(flux_arr) do iCell=cellSolveStart,cellSolveEnd ! Technically updating fewer cells than before... - tend_theta(1:nVertLevels,iCell) = 0.0 + + !$acc loop vector + do k=1,nVertLevels + tend_theta(k,iCell) = 0.0_RKIND + end do + + !$acc loop seq do i=1,nEdgesOnCell(iCell) iEdge = edgesOnCell(i,iCell) - flux_arr(1:nVertLevels) = 0.0 + !$acc loop vector + do k=1,nVertLevels + flux_arr(k) = 0.0_RKIND + end do + !$acc loop seq do j=1,nAdvCellsForEdge(iEdge) iAdvCell = advCellsForEdge(j,iEdge) + + !$acc loop vector do k=1,nVertLevels scalar_weight = adv_coefs(j,iEdge) + sign(1.0_RKIND,ru(k,iEdge))*adv_coefs_3rd(j,iEdge) flux_arr(k) = flux_arr(k) + scalar_weight* theta_m(k,iAdvCell) @@ -4962,28 +6065,38 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm end do !DIR$ IVDEP + !$acc loop vector do k=1,nVertLevels tend_theta(k,iCell) = tend_theta(k,iCell) - edgesOnCell_sign(i,iCell) * ru(k,iEdge) * flux_arr(k) end do end do end do + !$acc end parallel ! addition to pick up perturbation flux for rtheta_pp equation if(rk_step > 1) then + + !$acc parallel default(present) + !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd + + !$acc loop seq do i=1,nEdgesOnCell(iCell) iEdge = edgesOnCell(i,iCell) cell1 = cellsOnEdge(1,iEdge) cell2 = cellsOnEdge(2,iEdge) !DIR$ IVDEP + !$acc loop vector do k=1,nVertLevels flux = edgesOnCell_sign(i,iCell)*dvEdge(iEdge)*(ru_save(k,iEdge)-ru(k,iEdge))*0.5*(theta_m_save(k,cell2)+theta_m_save(k,cell1)) tend_theta(k,iCell) = tend_theta(k,iCell)-flux ! division by areaCell picked up down below end do end do end do + !$acc end parallel + end if ! @@ -4993,11 +6106,19 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm if (rk_step == 1) then - delsq_theta(1:nVertLevels,cellStart:cellEnd) = 0.0 - + !$acc parallel default(present) + !$acc loop gang worker do iCell=cellStart,cellEnd - tend_theta_euler(1:nVertLevels,iCell) = 0.0 + + !$acc loop vector + do k=1,nVertLevels + delsq_theta(k,iCell) = 0.0_RKIND + tend_theta_euler(k,iCell) = 0.0_RKIND + end do + r_areaCell = invAreaCell(iCell) + + !$acc loop seq do i=1,nEdgesOnCell(iCell) iEdge = edgesOnCell(i,iCell) edge_sign = r_areaCell*edgesOnCell_sign(i,iCell) * dvEdge(iEdge) * invDcEdge(iEdge) @@ -5005,6 +6126,7 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm cell1 = cellsOnEdge(1,iEdge) cell2 = cellsOnEdge(2,iEdge) !DIR$ IVDEP + !$acc loop vector do k=1,nVertLevels ! we are computing the Smagorinsky filter at more points than needed here so as to pick up the delsq_theta for 4th order filter below @@ -5017,13 +6139,19 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm end do end do end do + !$acc end parallel !$OMP BARRIER if (h_theta_eddy_visc4 > 0.0) then ! 4th order mixing is active + !$acc parallel default(present) + !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd ! Technically updating fewer cells than before... + r_areaCell = h_theta_eddy_visc4 * prandtl_inv * invAreaCell(iCell) + + !$acc loop seq do i=1,nEdgesOnCell(iCell) iEdge = edgesOnCell(i,iCell) @@ -5032,11 +6160,13 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm cell1 = cellsOnEdge(1,iEdge) cell2 = cellsOnEdge(2,iEdge) + !$acc loop vector do k=1,nVertLevels tend_theta_euler(k,iCell) = tend_theta_euler(k,iCell) - edge_sign*(delsq_theta(k,cell2) - delsq_theta(k,cell1)) end do end do end do + !$acc end parallel end if ! 4th order mixing is active @@ -5046,6 +6176,10 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm ! vertical advection plus diabatic term ! Note: we are also dividing through by the cell area after the horizontal flux divergence ! + + + !$acc parallel default(present) + !$acc loop gang worker private(wdtz) do iCell = cellSolveStart,cellSolveEnd wdtz(1) = 0.0 @@ -5053,22 +6187,27 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm k = 2 wdtz(k) = rw(k,icell)*(fzm(k)*theta_m(k,iCell)+fzp(k)*theta_m(k-1,iCell)) wdtz(k) = wdtz(k)+(rw_save(k,icell)-rw(k,icell))*(fzm(k)*theta_m_save(k,iCell)+fzp(k)*theta_m_save(k-1,iCell)) + + !$acc loop vector do k=3,nVertLevels-1 wdtz(k) = flux3( theta_m(k-2,iCell),theta_m(k-1,iCell),theta_m(k,iCell),theta_m(k+1,iCell), rw(k,iCell), coef_3rd_order ) wdtz(k) = wdtz(k) + (rw_save(k,icell)-rw(k,iCell))*(fzm(k)*theta_m_save(k,iCell)+fzp(k)*theta_m_save(k-1,iCell)) ! rtheta_pp redefinition end do + k = nVertLevels wdtz(k) = rw_save(k,icell)*(fzm(k)*theta_m(k,iCell)+fzp(k)*theta_m(k-1,iCell)) ! rtheta_pp redefinition wdtz(nVertLevels+1) = 0.0 !DIR$ IVDEP + !$acc loop vector do k=1,nVertLevels tend_theta(k,iCell) = tend_theta(k,iCell)*invAreaCell(iCell) -rdzw(k)*(wdtz(k+1)-wdtz(k)) rthdynten(k,iCell) = (tend_theta(k,iCell)-tend_rho(k,iCell)*theta_m(k,iCell))/rho_zz(k,iCell) tend_theta(k,iCell) = tend_theta(k,iCell) + rho_zz(k,iCell)*rt_diabatic_tend(k,iCell) end do end do + !$acc end parallel ! ! vertical mixing for theta - 2nd order @@ -5080,7 +6219,11 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm if (config_mix_full) then + !$acc parallel default(present) + !$acc loop gang worker do iCell = cellSolveStart,cellSolveEnd + + !$acc loop vector do k=2,nVertLevels-1 z1 = zgrid(k-1,iCell) z2 = zgrid(k ,iCell) @@ -5096,9 +6239,12 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm -(theta_m(k ,iCell)-theta_m(k-1,iCell))/(z0-zm) )/(0.5*(zp-zm)) end do end do + !$acc end parallel else ! idealized cases where we mix on the perturbation from the initial 1-D state + !$acc parallel default(present) + !$acc loop gang worker do iCell = cellSolveStart,cellSolveEnd do k=2,nVertLevels-1 z1 = zgrid(k-1,iCell) @@ -5115,6 +6261,7 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm -((theta_m(k ,iCell)-t_init(k,iCell))-(theta_m(k-1,iCell)-t_init(k-1,iCell)))/(z0-zm) )/(0.5*(zp-zm)) end do end do + !$acc end parallel end if @@ -5122,13 +6269,57 @@ subroutine atm_compute_dyn_tend_work(nCells, nEdges, nVertices, nVertLevels_dumm end if ! compute vertical theta mixing on first rk_step + !$acc parallel default(present) + !$acc loop gang worker do iCell = cellSolveStart,cellSolveEnd !DIR$ IVDEP + !$acc loop vector do k=1,nVertLevels ! tend_theta(k,iCell) = tend_theta(k,iCell) + tend_theta_euler(k,iCell) tend_theta(k,iCell) = tend_theta(k,iCell) + tend_theta_euler(k,iCell) + tend_rtheta_physics(k,iCell) end do end do + !$acc end parallel + + MPAS_ACC_TIMER_START('atm_compute_dyn_tend_work [ACC_data_xfer]') + if (rk_step == 1) then + !$acc exit data copyout(tend_w_euler) + !$acc exit data copyout(tend_u_euler) + !$acc exit data copyout(tend_theta_euler) + !$acc exit data copyout(tend_rho) + + !$acc exit data delete(kdiff) + !$acc exit data delete(tend_rho_physics) + !$acc exit data delete(rb, rr_save) + !$acc exit data delete(divergence, vorticity) + !$acc exit data delete(v) + !$acc exit data delete(u_init, v_init) + else + !$acc exit data delete(tend_w_euler) + !$acc exit data delete(tend_u_euler) + !$acc exit data delete(tend_theta_euler) + !$acc exit data delete(tend_rho) + end if + !$acc exit data copyout(tend_u) + !$acc exit data delete(cqu, pp, u, w, pv_edge, rho_edge, ke) + !$acc exit data copyout(h_divergence) + !$acc exit data delete(ru, rw) + !$acc exit data delete(rayleigh_damp_coef) + !$acc exit data delete(tend_ru_physics) + !$acc exit data copyout(tend_w) + !$acc exit data delete(rho_zz) + !$acc exit data copyout(tend_theta) + !$acc exit data delete(theta_m) + !$acc exit data delete(ru_save, theta_m_save) + !$acc exit data delete(cqw) + !$acc exit data delete(tend_rtheta_physics) + !$acc exit data delete(rw_save, rt_diabatic_tend) + !$acc exit data copyout(rthdynten) + !$acc exit data delete(t_init) +#ifdef CURVATURE + !$acc exit data delete(ur_cell, vr_cell) +#endif + MPAS_ACC_TIMER_STOP('atm_compute_dyn_tend_work [ACC_data_xfer]') end subroutine atm_compute_dyn_tend_work @@ -5296,13 +6487,33 @@ subroutine atm_compute_solve_diagnostics_work(nCells, nEdges, nVertices, & logical :: reconstruct_v + MPAS_ACC_TIMER_START('atm_compute_solve_diagnostics [ACC_data_xfer]') + !$acc enter data copyin(cellsOnEdge,dcEdge,dvEdge, & + !$acc edgesOnVertex,edgesOnVertex_sign,invAreaTriangle, & + !$acc nEdgesOnCell,edgesOnCell, & + !$acc edgesOnCell_sign,invAreaCell, & + !$acc invAreaTriangle,edgesOnVertex, & + !$acc verticesOnCell,kiteForCell,kiteAreasOnVertex, & + !$acc nEdgesOnEdge,edgesOnEdge,weightsOnEdge, & + !$acc fVertex, & + !$acc verticesOnEdge, & + !$acc invDvEdge,invDcEdge) + !$acc enter data copyin(u,h) + MPAS_ACC_TIMER_STOP('atm_compute_solve_diagnostics [ACC_data_xfer]') + ! ! Compute height on cell edges at velocity locations ! + MPAS_ACC_TIMER_START('atm_compute_solve_diagnostics [ACC_data_xfer]') + !$acc enter data create(h_edge,vorticity,divergence) + MPAS_ACC_TIMER_STOP('atm_compute_solve_diagnostics [ACC_data_xfer]') + !$acc parallel default(present) + !$acc loop gang do iEdge=edgeStart,edgeEnd cell1 = cellsOnEdge(1,iEdge) cell2 = cellsOnEdge(2,iEdge) !DIR$ IVDEP + !$acc loop vector do k=1,nVertLevels h_edge(k,iEdge) = 0.5 * (h(k,cell1) + h(k,cell2)) end do @@ -5311,6 +6522,7 @@ subroutine atm_compute_solve_diagnostics_work(nCells, nEdges, nVertices, & ! it would be good to move this somewhere else? efac = dcEdge(iEdge)*dvEdge(iEdge) + !$acc loop vector do k=1,nVertLevels ke_edge(k,iEdge) = efac*u(k,iEdge)**2 end do @@ -5320,17 +6532,24 @@ subroutine atm_compute_solve_diagnostics_work(nCells, nEdges, nVertices, & ! ! Compute circulation and relative vorticity at each vertex ! + !$acc loop gang do iVertex=vertexStart,vertexEnd - vorticity(1:nVertLevels,iVertex) = 0.0 + !$acc loop vector + do k=1,nVertLevels + vorticity(k,iVertex) = 0.0_RKIND + end do + !$acc loop seq do i=1,vertexDegree iEdge = edgesOnVertex(i,iVertex) s = edgesOnVertex_sign(i,iVertex) * dcEdge(iEdge) !DIR$ IVDEP + !$acc loop vector do k=1,nVertLevels vorticity(k,iVertex) = vorticity(k,iVertex) + s * u(k,iEdge) end do end do !DIR$ IVDEP + !$acc loop vector do k=1,nVertLevels vorticity(k,iVertex) = vorticity(k,iVertex) * invAreaTriangle(iVertex) end do @@ -5340,21 +6559,29 @@ subroutine atm_compute_solve_diagnostics_work(nCells, nEdges, nVertices, & ! ! Compute the divergence at each cell center ! + !$acc loop gang do iCell=cellStart,cellEnd - divergence(1:nVertLevels,iCell) = 0.0 + !$acc loop vector + do k=1,nVertLevels + divergence(k,iCell) = 0.0_RKIND + end do + !$acc loop seq do i=1,nEdgesOnCell(iCell) iEdge = edgesOnCell(i,iCell) s = edgesOnCell_sign(i,iCell) * dvEdge(iEdge) !DIR$ IVDEP + !$acc loop vector do k=1,nVertLevels divergence(k,iCell) = divergence(k,iCell) + s * u(k,iEdge) end do end do r = invAreaCell(iCell) + !$acc loop vector do k = 1,nVertLevels divergence(k,iCell) = divergence(k,iCell) * r end do end do + !$acc end parallel !$OMP BARRIER @@ -5364,20 +6591,32 @@ subroutine atm_compute_solve_diagnostics_work(nCells, nEdges, nVertices, & ! ! Replace 2.0 with 2 in exponentiation to avoid outside chance that ! compiler will actually allow "float raised to float" operation + MPAS_ACC_TIMER_START('atm_compute_solve_diagnostics [ACC_data_xfer]') + !$acc enter data create(ke) + MPAS_ACC_TIMER_STOP('atm_compute_solve_diagnostics [ACC_data_xfer]') + !$acc parallel default(present) + !$acc loop gang do iCell=cellStart,cellEnd - ke(1:nVertLevels,iCell) = 0.0 + !$acc loop vector + do k=1,nVertLevels + ke(k,iCell) = 0.0_RKIND + end do + !$acc loop seq do i=1,nEdgesOnCell(iCell) iEdge = edgesOnCell(i,iCell) + !$acc loop vector do k=1,nVertLevels ! ke(k,iCell) = ke(k,iCell) + 0.25 * dcEdge(iEdge) * dvEdge(iEdge) * u(k,iEdge)**2 ke(k,iCell) = ke(k,iCell) + 0.25 * ke_edge(k,iEdge) end do end do !DIR$ IVDEP + !$acc loop vector do k=1,nVertLevels ke(k,iCell) = ke(k,iCell) * invAreaCell(iCell) end do end do + !$acc end parallel if (hollingsworth) then @@ -5388,8 +6627,11 @@ subroutine atm_compute_solve_diagnostics_work(nCells, nEdges, nVertices, & ! Replace 2.0 with 2 in exponentiation to avoid outside chance that ! compiler will actually allow "float raised to float" operation + !$acc parallel default(present) + !$acc loop gang do iVertex=vertexStart,vertexEnd r = 0.25 * invAreaTriangle(iVertex) + !$acc loop vector do k=1,nVertLevels ! ke_vertex(k,iVertex) = ( dcEdge(EdgesOnVertex(1,iVertex))*dvEdge(EdgesOnVertex(1,iVertex))*u(k,EdgesOnVertex(1,iVertex))**2 & @@ -5401,6 +6643,7 @@ subroutine atm_compute_solve_diagnostics_work(nCells, nEdges, nVertices, & end do end do + !$acc end parallel !$OMP BARRIER @@ -5409,6 +6652,8 @@ subroutine atm_compute_solve_diagnostics_work(nCells, nEdges, nVertices, & ke_fact = 1.0 - .375 + !$acc parallel default(present) + !$acc loop collapse(2) do iCell=cellStart,cellEnd do k=1,nVertLevels ke(k,iCell) = ke_fact * ke(k,iCell) @@ -5416,17 +6661,21 @@ subroutine atm_compute_solve_diagnostics_work(nCells, nEdges, nVertices, & end do + !$acc loop gang do iCell=cellStart,cellEnd r = invAreaCell(iCell) + !$acc loop seq do i=1,nEdgesOnCell(iCell) iVertex = verticesOnCell(i,iCell) j = kiteForCell(i,iCell) !DIR$ IVDEP + !$acc loop vector do k = 1,nVertLevels ke(k,iCell) = ke(k,iCell) + (1.-ke_fact)*kiteAreasOnVertex(j,iVertex) * ke_vertex(k,iVertex) * r end do end do end do + !$acc end parallel end if @@ -5439,17 +6688,33 @@ subroutine atm_compute_solve_diagnostics_work(nCells, nEdges, nVertices, & if(rk_step /= 3) reconstruct_v = .false. end if + MPAS_ACC_TIMER_START('atm_compute_solve_diagnostics [ACC_data_xfer]') + if (reconstruct_v) then + !$acc enter data create(v) + else + !$acc enter data copyin(v) + end if + MPAS_ACC_TIMER_STOP('atm_compute_solve_diagnostics [ACC_data_xfer]') + if (reconstruct_v) then + !$acc parallel default(present) + !$acc loop gang do iEdge = edgeStart,edgeEnd - v(1:nVertLevels,iEdge) = 0.0 + !$acc loop vector + do k = 1,nVertLevels + v(k,iEdge) = 0.0_RKIND + end do + !$acc loop seq do i=1,nEdgesOnEdge(iEdge) eoe = edgesOnEdge(i,iEdge) !DIR$ IVDEP + !$acc loop vector do k = 1,nVertLevels v(k,iEdge) = v(k,iEdge) + weightsOnEdge(i,iEdge) * u(k, eoe) end do end do end do + !$acc end parallel end if ! @@ -5458,6 +6723,11 @@ subroutine atm_compute_solve_diagnostics_work(nCells, nEdges, nVertices, & ! ! Avoid dividing h_vertex by areaTriangle and move areaTriangle into ! numerator for the pv_vertex calculation + MPAS_ACC_TIMER_START('atm_compute_solve_diagnostics [ACC_data_xfer]') + !$acc enter data create(pv_vertex) + MPAS_ACC_TIMER_STOP('atm_compute_solve_diagnostics [ACC_data_xfer]') + !$acc parallel default(present) + !$acc loop collapse(2) do iVertex = vertexStart,vertexEnd !DIR$ IVDEP do k=1,nVertLevels @@ -5471,6 +6741,7 @@ subroutine atm_compute_solve_diagnostics_work(nCells, nEdges, nVertices, & pv_vertex(k,iVertex) = (fVertex(iVertex) + vorticity(k,iVertex)) end do end do + !$acc end parallel !$OMP BARRIER @@ -5478,32 +6749,49 @@ subroutine atm_compute_solve_diagnostics_work(nCells, nEdges, nVertices, & ! Compute pv at the edges ! ( this computes pv_edge at all edges bounding real cells ) ! + MPAS_ACC_TIMER_START('atm_compute_solve_diagnostics [ACC_data_xfer]') + !$acc enter data create(pv_edge) + MPAS_ACC_TIMER_STOP('atm_compute_solve_diagnostics [ACC_data_xfer]') + !$acc parallel default(present) + !$acc loop collapse(2) do iEdge = edgeStart,edgeEnd !DIR$ IVDEP do k=1,nVertLevels pv_edge(k,iEdge) = 0.5 * (pv_vertex(k,verticesOnEdge(1,iEdge)) + pv_vertex(k,verticesOnEdge(2,iEdge))) end do end do + !$acc end parallel if (config_apvm_upwinding > 0.0) then - ! - ! Compute pv at cell centers - ! ( this computes pv_cell for all real cells ) - ! only needed for APVM upwinding - ! - do iCell=cellStart,cellEnd - pv_cell(1:nVertLevels,iCell) = 0.0 - r = invAreaCell(iCell) - do i=1,nEdgesOnCell(iCell) - iVertex = verticesOnCell(i,iCell) - j = kiteForCell(i,iCell) -!DIR$ IVDEP + ! + ! Compute pv at cell centers + ! ( this computes pv_cell for all real cells ) + ! only needed for APVM upwinding + ! + MPAS_ACC_TIMER_START('atm_compute_solve_diagnostics [ACC_data_xfer]') + !$acc enter data create(pv_cell) + MPAS_ACC_TIMER_STOP('atm_compute_solve_diagnostics [ACC_data_xfer]') + !$acc parallel default(present) + !$acc loop gang + do iCell=cellStart,cellEnd + !$acc loop vector do k = 1,nVertLevels - pv_cell(k,iCell) = pv_cell(k,iCell) + kiteAreasOnVertex(j,iVertex) * pv_vertex(k,iVertex) * r + pv_cell(k,iCell) = 0.0_RKIND + end do + r = invAreaCell(iCell) + !$acc loop seq + do i=1,nEdgesOnCell(iCell) + iVertex = verticesOnCell(i,iCell) + j = kiteForCell(i,iCell) +!DIR$ IVDEP + !$acc loop vector + do k = 1,nVertLevels + pv_cell(k,iCell) = pv_cell(k,iCell) + kiteAreasOnVertex(j,iVertex) * pv_vertex(k,iVertex) * r + end do end do end do - end do + !$acc end parallel !$OMP BARRIER @@ -5522,20 +6810,50 @@ subroutine atm_compute_solve_diagnostics_work(nCells, nEdges, nVertices, & ! Merged loops for calculating gradPVt, gradPVn and pv_edge ! Also precomputed inverses of dvEdge and dcEdge to avoid repeated divisions ! + MPAS_ACC_TIMER_START('atm_compute_solve_diagnostics [ACC_data_xfer]') + !$acc enter data create(gradPVt,gradPVn) + MPAS_ACC_TIMER_STOP('atm_compute_solve_diagnostics [ACC_data_xfer]') r = config_apvm_upwinding * dt + !$acc parallel default(present) + !$acc loop gang do iEdge = edgeStart,edgeEnd r1 = 1.0_RKIND * invDvEdge(iEdge) r2 = 1.0_RKIND * invDcEdge(iEdge) !DIR$ IVDEP + !$acc loop vector do k = 1,nVertLevels gradPVt(k,iEdge) = (pv_vertex(k,verticesOnEdge(2,iEdge)) - pv_vertex(k,verticesOnEdge(1,iEdge))) * r1 gradPVn(k,iEdge) = (pv_cell(k,cellsOnEdge(2,iEdge)) - pv_cell(k,cellsOnEdge(1,iEdge))) * r2 pv_edge(k,iEdge) = pv_edge(k,iEdge) - r * (v(k,iEdge) * gradPVt(k,iEdge) + u(k,iEdge) * gradPVn(k,iEdge)) end do end do + !$acc end parallel + + MPAS_ACC_TIMER_START('atm_compute_solve_diagnostics [ACC_data_xfer]') + !$acc exit data delete(pv_cell,gradPVt,gradPVn) + MPAS_ACC_TIMER_STOP('atm_compute_solve_diagnostics [ACC_data_xfer]') end if ! apvm upwinding + + MPAS_ACC_TIMER_START('atm_compute_solve_diagnostics [ACC_data_xfer]') + !$acc exit data delete(cellsOnEdge,dcEdge,dvEdge, & + !$acc edgesOnVertex,edgesOnVertex_sign,invAreaTriangle, & + !$acc nEdgesOnCell,edgesOnCell, & + !$acc edgesOnCell_sign,invAreaCell, & + !$acc invAreaTriangle,edgesOnVertex, & + !$acc verticesOnCell,kiteForCell,kiteAreasOnVertex, & + !$acc nEdgesOnEdge,edgesOnEdge,weightsOnEdge, & + !$acc verticesOnEdge, & + !$acc fVertex,invDvEdge,invDcEdge) + !$acc exit data delete(u,h) + !$acc exit data copyout(h_edge,vorticity,divergence, & + !$acc ke, & + !$acc v, & + !$acc pv_vertex, & + !$acc pv_edge) + MPAS_ACC_TIMER_STOP('atm_compute_solve_diagnostics [ACC_data_xfer]') + end subroutine atm_compute_solve_diagnostics_work @@ -5554,8 +6872,10 @@ subroutine atm_init_coupled_diagnostics(state, time_lev, diag, mesh, configs, & integer, intent(in) :: cellSolveStart, cellSolveEnd, vertexSolveStart, vertexSolveEnd, edgeSolveStart, edgeSolveEnd integer :: i, k, iCell, iEdge, cell1, cell2 - integer, pointer :: nCells, nEdges, nVertLevels - integer, pointer :: index_qv + integer, pointer :: nVertLevels_ptr + integer, pointer :: index_qv_ptr + integer :: nVertLevels + integer :: index_qv real (kind=RKIND) :: p0, rcv, flux integer, dimension(:), pointer :: nEdgesOnCell integer, dimension(:,:), pointer :: cellsOnEdge, edgesOnCell @@ -5583,10 +6903,12 @@ subroutine atm_init_coupled_diagnostics(state, time_lev, diag, mesh, configs, & real (kind=RKIND), dimension(:,:,:), pointer :: zb, zb3, zb_cell, zb3_cell - 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(state, 'index_qv', index_qv) + call mpas_pool_get_dimension(mesh, 'nVertLevels', nVertLevels_ptr) + call mpas_pool_get_dimension(state, 'index_qv', index_qv_ptr) + + ! Dereference integer pointers for OpenACC + nVertLevels = nVertLevels_ptr + index_qv = index_qv_ptr call mpas_pool_get_array(mesh, 'cellsOnEdge', cellsOnEdge) call mpas_pool_get_array(mesh, 'nEdgesOnCell', nEdgesOnCell) @@ -5619,46 +6941,79 @@ subroutine atm_init_coupled_diagnostics(state, time_lev, diag, mesh, configs, & call mpas_pool_get_array(mesh, 'zb_cell', zb_cell) call mpas_pool_get_array(mesh, 'zb3_cell', zb3_cell) + MPAS_ACC_TIMER_START('atm_init_coupled_diagnostics [ACC_data_xfer]') + ! copyin invariant fields + !$acc enter data copyin(cellsOnEdge,nEdgesOnCell,edgesOnCell, & + !$acc edgesOnCell_sign,zz,fzm,fzp,zb,zb3, & + !$acc zb_cell,zb3_cell) + + ! copyin the data that is only on the right-hand side + !$acc enter data copyin(scalars(index_qv,:,:),u,w,rho,theta, & + !$acc rho_base,theta_base) + + ! copyin the data that will be modified in this routine + !$acc enter data create(theta_m,rho_zz,ru,rw,rho_p,rtheta_base, & + !$acc rtheta_p,exner,exner_base,pressure_p, & + !$acc pressure_base) + MPAS_ACC_TIMER_STOP('atm_init_coupled_diagnostics [ACC_data_xfer]') + + rcv = rgas / (cp-rgas) p0 = 1.e5 ! this should come from somewhere else... + !$acc parallel default(present) + !$acc loop gang do iCell=cellStart,cellEnd + !$acc loop vector do k=1,nVertLevels theta_m(k,iCell) = theta(k,iCell) * (1._RKIND + rvord * scalars(index_qv,k,iCell)) rho_zz(k,iCell) = rho(k,iCell) / zz(k,iCell) end do end do + !$acc end parallel !$OMP BARRIER + !$acc parallel default(present) + !$acc loop gang do iEdge=edgeStart,edgeEnd cell1 = cellsOnEdge(1,iEdge) cell2 = cellsOnEdge(2,iEdge) + !$acc loop vector do k=1,nVertLevels ru(k,iEdge) = 0.5 * u(k,iEdge) * (rho_zz(k,cell1) + rho_zz(k,cell2)) end do end do + !$acc end parallel !$OMP BARRIER ! Compute rw (i.e. rho_zz * omega) from rho_zz, w, and ru. ! We are reversing the procedure we use in subroutine atm_recover_large_step_variables. ! first, the piece that depends on w. + !$acc parallel default(present) + !$acc loop gang do iCell=cellStart,cellEnd rw(1,iCell) = 0.0 rw(nVertLevels+1,iCell) = 0.0 + !$acc loop vector do k=2,nVertLevels rw(k,iCell) = w(k,iCell) & * (fzp(k) * rho_zz(k-1,iCell) + fzm(k) * rho_zz(k,iCell)) & * (fzp(k) * zz(k-1,iCell) + fzm(k) * zz(k,iCell)) end do end do + !$acc end parallel ! next, the piece that depends on ru + !$acc parallel default(present) + !$acc loop gang do iCell=cellStart,cellEnd + !$acc loop seq do i=1,nEdgesOnCell(iCell) iEdge = edgesOnCell(i,iCell) + !$acc loop vector do k = 2,nVertLevels flux = (fzm(k)*ru(k,iEdge) + fzp(k)*ru(k-1,iEdge)) rw(k,iCell) = rw(k,iCell) & @@ -5667,33 +7022,48 @@ subroutine atm_init_coupled_diagnostics(state, time_lev, diag, mesh, configs, & end do end do end do + !$acc end parallel + !$acc parallel default(present) + !$acc loop collapse(2) do iCell=cellStart,cellEnd do k=1,nVertLevels rho_p(k,iCell) = rho_zz(k,iCell) - rho_base(k,iCell) end do end do + !$acc end parallel + !$acc parallel default(present) + !$acc loop collapse(2) do iCell=cellStart,cellEnd do k=1,nVertLevels rtheta_base(k,iCell) = theta_base(k,iCell) * rho_base(k,iCell) end do end do + !$acc end parallel + !$acc parallel default(present) + !$acc loop collapse(2) do iCell=cellStart,cellEnd do k=1,nVertLevels rtheta_p(k,iCell) = theta_m(k,iCell) * rho_p(k,iCell) & + rho_base(k,iCell) * (theta_m(k,iCell) - theta_base(k,iCell)) end do end do + !$acc end parallel + !$acc parallel default(present) + !$acc loop collapse(2) do iCell=cellStart,cellEnd do k=1,nVertLevels exner(k,iCell) = (zz(k,iCell) * (rgas/p0) * (rtheta_p(k,iCell) + rtheta_base(k,iCell)))**rcv exner_base(k,iCell) = (zz(k,iCell) * (rgas/p0) * (rtheta_base(k,iCell)))**rcv ! WCS addition 20180403 end do end do + !$acc end parallel + !$acc parallel default(present) + !$acc loop collapse(2) do iCell=cellStart,cellEnd do k=1,nVertLevels pressure_p(k,iCell) = zz(k,iCell) * rgas & @@ -5703,11 +7073,28 @@ subroutine atm_init_coupled_diagnostics(state, time_lev, diag, mesh, configs, & pressure_base(k,iCell) = zz(k,iCell) * rgas * exner_base(k,iCell) * rtheta_base(k,iCell) ! WCS addition 20180403 end do end do + !$acc end parallel + + MPAS_ACC_TIMER_START('atm_init_coupled_diagnostics [ACC_data_xfer]') + ! delete invariant fields + !$acc exit data delete(cellsOnEdge,nEdgesOnCell,edgesOnCell, & + !$acc edgesOnCell_sign,zz,fzm,fzp,zb,zb3, & + !$acc zb_cell,zb3_cell) + + ! delete the data that is only on the right-hand side + !$acc exit data delete(scalars(index_qv,:,:),u,w,rho,theta, & + !$acc rho_base,theta_base) + + ! copyout the data that will be modified in this routine + !$acc exit data copyout(theta_m,rho_zz,ru,rw,rho_p,rtheta_base, & + !$acc rtheta_p,exner,exner_base,pressure_p, & + !$acc pressure_base) + MPAS_ACC_TIMER_STOP('atm_init_coupled_diagnostics [ACC_data_xfer]') end subroutine atm_init_coupled_diagnostics - subroutine atm_rk_dynamics_substep_finish( state, diag, dynamics_substep, dynamics_split, & + subroutine atm_rk_dynamics_substep_finish( state, diag, nVertLevels, dynamics_substep, dynamics_split, & cellStart, cellEnd, vertexStart, vertexEnd, edgeStart, edgeEnd, & cellSolveStart, cellSolveEnd, vertexSolveStart, vertexSolveEnd, edgeSolveStart, edgeSolveEnd) @@ -5721,7 +7108,7 @@ subroutine atm_rk_dynamics_substep_finish( state, diag, dynamics_substep, dynami type (mpas_pool_type), intent(inout) :: state type (mpas_pool_type), intent(inout) :: diag - integer, intent(in) :: dynamics_substep, dynamics_split + integer, intent(in) :: nVertLevels, dynamics_substep, dynamics_split integer, intent(in) :: cellStart, cellEnd, vertexStart, vertexEnd, edgeStart, edgeEnd integer, intent(in) :: cellSolveStart, cellSolveEnd, vertexSolveStart, vertexSolveEnd, edgeSolveStart, edgeSolveEnd @@ -5741,6 +7128,7 @@ subroutine atm_rk_dynamics_substep_finish( state, diag, dynamics_substep, dynami real (kind=RKIND), dimension(:,:), pointer :: theta_m_1, theta_m_2 real (kind=RKIND), dimension(:,:), pointer :: rho_zz_1, rho_zz_2, rho_zz_old_split real (kind=RKIND), dimension(:,:), pointer :: ruAvg, wwAvg, ruAvg_split, wwAvg_split + integer :: iCell, iEdge, j, k call mpas_pool_get_array(diag, 'ru', ru) call mpas_pool_get_array(diag, 'ru_save', ru_save) @@ -5765,36 +7153,125 @@ subroutine atm_rk_dynamics_substep_finish( state, diag, dynamics_substep, dynami call mpas_pool_get_array(state, 'rho_zz', rho_zz_1, 1) call mpas_pool_get_array(state, 'rho_zz', rho_zz_2, 2) + MPAS_ACC_TIMER_START('atm_rk_dynamics_substep_finish [ACC_data_xfer]') + !$acc enter data create(ru_save, u_1, rtheta_p_save, theta_m_1, rho_p_save, rw_save, & + !$acc w_1, rho_zz_1) & + !$acc copyin(ru, u_2, rtheta_p, rho_p, theta_m_2, rho_zz_2, rw, & + !$acc w_2, ruAvg, wwAvg, ruAvg_split, wwAvg_split, rho_zz_old_split) + MPAS_ACC_TIMER_STOP('atm_rk_dynamics_substep_finish [ACC_data_xfer]') + + ! Interim fix for the atm_compute_dyn_tend_work subroutine accessing uninitialized values + ! in garbage cells of theta_m + !$acc kernels + theta_m_1(:,cellEnd+1) = 0.0_RKIND + !$acc end kernels + inv_dynamics_split = 1.0_RKIND / real(dynamics_split) if (dynamics_substep < dynamics_split) then + !$acc parallel default(present) + !$acc loop gang worker + do iEdge = edgeStart,edgeEnd + !$acc loop vector + do k = 1,nVertLevels + ru_save(k,iEdge) = ru(k,iEdge) + u_1(k,iEdge) = u_2(k,iEdge) + end do + end do - ru_save(:,edgeStart:edgeEnd) = ru(:,edgeStart:edgeEnd) - rw_save(:,cellStart:cellEnd) = rw(:,cellStart:cellEnd) - rtheta_p_save(:,cellStart:cellEnd) = rtheta_p(:,cellStart:cellEnd) - rho_p_save(:,cellStart:cellEnd) = rho_p(:,cellStart:cellEnd) - u_1(:,edgeStart:edgeEnd) = u_2(:,edgeStart:edgeEnd) - w_1(:,cellStart:cellEnd) = w_2(:,cellStart:cellEnd) - theta_m_1(:,cellStart:cellEnd) = theta_m_2(:,cellStart:cellEnd) - rho_zz_1(:,cellStart:cellEnd) = rho_zz_2(:,cellStart:cellEnd) + !$acc loop gang worker + do iCell = cellStart,cellEnd + !$acc loop vector + do k = 1,nVertLevels + rtheta_p_save(k,iCell) = rtheta_p(k,iCell) + rho_p_save(k,iCell) = rho_p(k,iCell) + theta_m_1(k,iCell) = theta_m_2(k,iCell) + rho_zz_1(k,iCell) = rho_zz_2(k,iCell) + end do + end do + !$acc loop gang worker + do iCell = cellStart,cellEnd + !$acc loop vector + do k = 1,nVertLevels+1 + rw_save(k,iCell) = rw(k,iCell) + w_1(k,iCell) = w_2(k,iCell) + end do + end do + !$acc end parallel end if if (dynamics_substep == 1) then - ruAvg_split(:,edgeStart:edgeEnd) = ruAvg(:,edgeStart:edgeEnd) - wwAvg_split(:,cellStart:cellEnd) = wwAvg(:,cellStart:cellEnd) + !$acc parallel default(present) + !$acc loop gang worker + do iEdge = edgeStart,edgeEnd + !$acc loop vector + do k = 1,nVertLevels + ruAvg_split(k,iEdge) = ruAvg(k,iEdge) + end do + end do + !$acc loop gang worker + do iCell = cellStart,cellEnd + !$acc loop vector + do k = 1,nVertLevels+1 + wwAvg_split(k,iCell) = wwAvg(k,iCell) + end do + end do + !$acc end parallel else - ruAvg_split(:,edgeStart:edgeEnd) = ruAvg(:,edgeStart:edgeEnd)+ruAvg_split(:,edgeStart:edgeEnd) - wwAvg_split(:,cellStart:cellEnd) = wwAvg(:,cellStart:cellEnd)+wwAvg_split(:,cellStart:cellEnd) + !$acc parallel default(present) + !$acc loop gang worker + do iEdge = edgeStart,edgeEnd + !$acc loop vector + do k = 1,nVertLevels + ruAvg_split(k,iEdge) = ruAvg(k,iEdge) + ruAvg_split(k,iEdge) + end do + end do + !$acc loop gang worker + do iCell = cellStart,cellEnd + !$acc loop vector + do k = 1,nVertLevels+1 + wwAvg_split(k,iCell) = wwAvg(k,iCell) + wwAvg_split(k,iCell) + end do + end do + !$acc end parallel end if if (dynamics_substep == dynamics_split) then - ruAvg(:,edgeStart:edgeEnd) = ruAvg_split(:,edgeStart:edgeEnd) * inv_dynamics_split - wwAvg(:,cellStart:cellEnd) = wwAvg_split(:,cellStart:cellEnd) * inv_dynamics_split - rho_zz_1(:,cellStart:cellEnd) = rho_zz_old_split(:,cellStart:cellEnd) + !$acc parallel default(present) + !$acc loop gang worker + do iEdge = edgeStart,edgeEnd + !$acc loop vector + do k = 1,nVertLevels + ruAvg(k,iEdge) = ruAvg_split(k,iEdge) * inv_dynamics_split + end do + end do + !$acc loop gang worker + do iCell = cellStart,cellEnd + !$acc loop vector + do k = 1,nVertLevels+1 + wwAvg(k,iCell) = wwAvg_split(k,iCell) * inv_dynamics_split + end do + end do + !$acc loop gang worker + do iCell = cellStart,cellEnd + !$acc loop vector + do k = 1,nVertLevels + rho_zz_1(k,iCell) = rho_zz_old_split(k,iCell) + end do + end do + !$acc end parallel end if + MPAS_ACC_TIMER_START('atm_rk_dynamics_substep_finish [ACC_data_xfer]') + !$acc exit data copyout(ru_save, u_1, rtheta_p_save, rho_p_save, rw_save, & + !$acc w_1, theta_m_1, rho_zz_1, ruAvg, wwAvg, ruAvg_split, & + !$acc wwAvg_split) & + !$acc delete(ru, u_2, rtheta_p, rho_p, theta_m_2, rho_zz_2, rw, & + !$acc w_2, rho_zz_old_split) + MPAS_ACC_TIMER_STOP('atm_rk_dynamics_substep_finish [ACC_data_xfer]') + end subroutine atm_rk_dynamics_substep_finish @@ -5848,14 +7325,28 @@ subroutine atm_zero_gradient_w_bdy_work( w, bdyMaskCell, nearestRelaxationCell, integer :: iCell, k + MPAS_ACC_TIMER_START('atm_zero_gradient_w_bdy_work [ACC_data_xfer]') + !$acc enter data copyin(w) + MPAS_ACC_TIMER_STOP('atm_zero_gradient_w_bdy_work [ACC_data_xfer]') + + !$acc parallel default(present) + !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd if (bdyMaskCell(iCell) > nRelaxZone) then !DIR$ IVDEP + !$acc loop vector do k = 2, nVertLevels - w(k,iCell) = w(k,nearestRelaxationCell(iCell)) + ! w(k,iCell) = w(k,nearestRelaxationCell(iCell)) + w(k,iCell) = 0.0 ! WCS fix for instabilities caused by zero-gradient condition on inflow, 20240806 end do end if end do + !$acc end parallel + + MPAS_ACC_TIMER_START('atm_zero_gradient_w_bdy_work [ACC_data_xfer]') + !$acc exit data copyout(w) + MPAS_ACC_TIMER_STOP('atm_zero_gradient_w_bdy_work [ACC_data_xfer]') + end subroutine atm_zero_gradient_w_bdy_work @@ -5895,8 +7386,16 @@ subroutine atm_bdy_adjust_dynamics_speczone_tend( tend, mesh, config, nVertLevel call mpas_pool_get_array(mesh, 'bdyMaskEdge', bdyMaskEdge) call mpas_pool_get_array(tend, 'rt_diabatic_tend', rt_diabatic_tend) + MPAS_ACC_TIMER_START('atm_bdy_adjust_dynamics_speczone_tend [ACC_data_xfer]') + !$acc enter data copyin(tend_ru,tend_rho,tend_rt,tend_rw, & + !$acc rt_diabatic_tend) + MPAS_ACC_TIMER_STOP('atm_bdy_adjust_dynamics_speczone_tend [ACC_data_xfer]') + + !$acc parallel default(present) + !$acc loop gang worker do iCell = cellSolveStart, cellSolveEnd if(bdyMaskCell(iCell) > nRelaxZone) then + !$acc loop vector do k=1, nVertLevels tend_rho(k,iCell) = rho_driving_tend(k,iCell) tend_rt(k,iCell) = rt_driving_tend(k,iCell) @@ -5905,14 +7404,24 @@ subroutine atm_bdy_adjust_dynamics_speczone_tend( tend, mesh, config, nVertLevel end do end if end do + !$acc end parallel + !$acc parallel default(present) + !$acc loop gang worker do iEdge = edgeSolveStart, edgeSolveEnd if(bdyMaskEdge(iEdge) > nRelaxZone) then + !$acc loop vector do k=1, nVertLevels tend_ru(k,iEdge) = ru_driving_tend(k,iEdge) end do end if end do + !$acc end parallel + + MPAS_ACC_TIMER_START('atm_bdy_adjust_dynamics_speczone_tend [ACC_data_xfer]') + !$acc exit data copyout(tend_ru,tend_rho,tend_rt, & + !$acc tend_rw,rt_diabatic_tend) + MPAS_ACC_TIMER_STOP('atm_bdy_adjust_dynamics_speczone_tend [ACC_data_xfer]') end subroutine atm_bdy_adjust_dynamics_speczone_tend @@ -5949,11 +7458,13 @@ subroutine atm_bdy_adjust_dynamics_relaxzone_tend( config, tend, state, diag, me 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 + integer, pointer :: vertexDegree_ptr + integer :: vertexDegree real (kind=RKIND) :: edge_sign, laplacian_filter_coef, rayleigh_damping_coef, r_dc, r_dv, invArea - real (kind=RKIND), pointer :: divdamp_coef + real (kind=RKIND), pointer :: divdamp_coef_ptr + real (kind=RKIND) :: divdamp_coef real (kind=RKIND), dimension(nVertLevels) :: divergence1, divergence2, vorticity1, vorticity2 integer :: iCell, iEdge, i, k, cell1, cell2, iEdge_vort, iEdge_div integer :: vertex1, vertex2, iVertex @@ -5974,7 +7485,7 @@ subroutine atm_bdy_adjust_dynamics_relaxzone_tend( config, tend, state, diag, me 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_dimension(mesh, 'vertexDegree', vertexDegree_ptr) call mpas_pool_get_array(mesh, 'dcEdge', dcEdge) call mpas_pool_get_array(mesh, 'dvEdge', dvEdge) call mpas_pool_get_array(mesh, 'invDcEdge', invDcEdge) @@ -5989,13 +7500,25 @@ subroutine atm_bdy_adjust_dynamics_relaxzone_tend( config, tend, state, diag, me call mpas_pool_get_array(mesh, 'nEdgesOnCell',nEdgesOnCell) call mpas_pool_get_array(mesh, 'verticesOnEdge', verticesOnEdge) - call mpas_pool_get_config(config, 'config_relax_zone_divdamp_coef', divdamp_coef) + call mpas_pool_get_config(config, 'config_relax_zone_divdamp_coef', divdamp_coef_ptr) - ! First, Rayleigh damping terms for ru, rtheta_m and rho_zz + ! De-referencing scalar pointers so that acc parallel regions correctly copy the + ! scalars onto the device + divdamp_coef = divdamp_coef_ptr + vertexDegree = vertexDegree_ptr + + MPAS_ACC_TIMER_START('atm_bdy_adjust_dynamics_relaxzone_tend [ACC_data_xfer]') + !$acc enter data copyin(tend_rho, tend_rt, rho_zz, theta_m, tend_ru, ru) + !$acc enter data create(divergence1, divergence2, vorticity1, vorticity2) + MPAS_ACC_TIMER_STOP('atm_bdy_adjust_dynamics_relaxzone_tend [ACC_data_xfer]') + ! First, Rayleigh damping terms for ru, rtheta_m and rho_zz + !$acc parallel default(present) + !$acc loop gang worker 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)) + !$acc loop vector 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)) @@ -6003,23 +7526,28 @@ subroutine atm_bdy_adjust_dynamics_relaxzone_tend( config, tend, state, diag, me end if end do + !$acc loop gang worker 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)) + !$acc loop vector 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 + !$acc end parallel ! Second, the horizontal filter for rtheta_m and rho_zz - + !$acc parallel default(present) + !$acc loop gang worker 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)) ! + !$acc loop seq do i=1,nEdgesOnCell(iCell) iEdge = edgesOnCell(i,iCell) ! edge_sign = r_areaCell*edgesOnCell_sign(i,iCell) * dvEdge(iEdge) * invDcEdge(iEdge) * laplacian_filter_coef @@ -6028,6 +7556,7 @@ subroutine atm_bdy_adjust_dynamics_relaxzone_tend( config, tend, state, diag, me cell1 = cellsOnEdge(1,iEdge) cell2 = cellsOnEdge(2,iEdge) !DIR$ IVDEP + !$acc loop vector 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)) ) @@ -6039,9 +7568,11 @@ subroutine atm_bdy_adjust_dynamics_relaxzone_tend( config, tend, state, diag, me end if end do + !$acc end parallel ! Third (and last), the horizontal filter for ru - + !$acc parallel default(present) + !$acc loop gang worker private(divergence1, divergence2, vorticity1, vorticity2) do iEdge = edgeStart, edgeEnd if ( (bdyMaskEdge(iEdge) > 1) .and. (bdyMaskEdge(iEdge) <= nRelaxZone) ) then ! relaxation zone @@ -6058,10 +7589,19 @@ subroutine atm_bdy_adjust_dynamics_relaxzone_tend( config, tend, state, diag, me iCell = cell1 invArea = invAreaCell(iCell) - divergence1(1:nVertLevels) = 0. + !$acc loop vector + do k=1,nVertLevels + divergence1(k) = 0. + divergence2(k) = 0. + vorticity1(k) = 0. + vorticity2(k) = 0. + end do + + !$acc loop seq do i=1,nEdgesOnCell(iCell) iEdge_div = edgesOnCell(i,iCell) edge_sign = invArea * dvEdge(iEdge_div) * edgesOnCell_sign(i,iCell) + !$acc loop vector do k=1,nVertLevels divergence1(k) = divergence1(k) + edge_sign * (ru(k,iEdge_div) - ru_driving_values(k,iEdge_div)) end do @@ -6069,30 +7609,33 @@ subroutine atm_bdy_adjust_dynamics_relaxzone_tend( config, tend, state, diag, me iCell = cell2 invArea = invAreaCell(iCell) - divergence2(1:nVertLevels) = 0. + !$acc loop seq do i=1,nEdgesOnCell(iCell) iEdge_div = edgesOnCell(i,iCell) edge_sign = invArea * dvEdge(iEdge_div) * edgesOnCell_sign(i,iCell) + !$acc loop vector 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. + !$acc loop seq do i=1,vertexDegree iEdge_vort = edgesOnVertex(i,iVertex) edge_sign = invAreaTriangle(iVertex) * dcEdge(iEdge_vort) * edgesOnVertex_sign(i,iVertex) + !$acc loop vector 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. + !$acc loop seq do i=1,vertexDegree iEdge_vort = edgesOnVertex(i,iVertex) edge_sign = invAreaTriangle(iVertex) * dcEdge(iEdge_vort) * edgesOnVertex_sign(i,iVertex) + !$acc loop vector do k=1,nVertLevels vorticity2(k) = vorticity2(k) + edge_sign * (ru(k,iEdge_vort) - ru_driving_values(k,iEdge_vort)) end do @@ -6100,6 +7643,7 @@ subroutine atm_bdy_adjust_dynamics_relaxzone_tend( config, tend, state, diag, me ! Compute diffusion, computed as \nabla divergence - k \times \nabla vorticity ! + !$acc loop vector do k=1,nVertLevels tend_ru(k,iEdge) = tend_ru(k,iEdge) + laplacian_filter_coef & * (divdamp_coef * (divergence2(k) - divergence1(k)) * r_dc & @@ -6109,7 +7653,14 @@ subroutine atm_bdy_adjust_dynamics_relaxzone_tend( config, tend, state, diag, me end if ! end test for relaxation-zone edge end do ! end of loop over edges - + !$acc end parallel + + MPAS_ACC_TIMER_START('atm_bdy_adjust_dynamics_relaxzone_tend [ACC_data_xfer]') + !$acc exit data copyout(tend_rho, tend_rt, tend_ru) + !$acc exit data delete(rho_zz, theta_m, ru, & + !$acc divergence1, divergence2, vorticity1, vorticity2) + MPAS_ACC_TIMER_STOP('atm_bdy_adjust_dynamics_relaxzone_tend [ACC_data_xfer]') + end subroutine atm_bdy_adjust_dynamics_relaxzone_tend @@ -6143,14 +7694,27 @@ subroutine atm_bdy_reset_speczone_values( state, diag, mesh, nVertLevels, & call mpas_pool_get_array(diag, 'rtheta_p', rtheta_p) call mpas_pool_get_array(diag, 'rtheta_base', rtheta_base) + MPAS_ACC_TIMER_START('atm_bdy_reset_speczone_values [ACC_data_xfer]') + !$acc enter data copyin(rtheta_base, theta_m, rtheta_p) + MPAS_ACC_TIMER_STOP('atm_bdy_reset_speczone_values [ACC_data_xfer]') + + !$acc parallel default(present) + !$acc loop gang worker do iCell = cellSolveStart, cellSolveEnd if( bdyMaskCell(iCell) > nRelaxZone) then + !$acc loop vector 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 + !$acc end parallel + + MPAS_ACC_TIMER_START('atm_bdy_reset_speczone_values [ACC_data_xfer]') + !$acc exit data copyout(theta_m, rtheta_p) & + !$acc delete(rtheta_base) + MPAS_ACC_TIMER_STOP('atm_bdy_reset_speczone_values [ACC_data_xfer]') end subroutine atm_bdy_reset_speczone_values @@ -6240,17 +7804,29 @@ subroutine atm_bdy_adjust_scalars_work( scalars_new, scalars_driving, dt, dt_rk, integer :: iCell, iEdge, iScalar, i, k, cell1, cell2 !--- + MPAS_ACC_TIMER_START('atm_bdy_adjust_scalars [ACC_data_xfer]') + !$acc enter data create(scalars_tmp) & + !$acc copyin(scalars_new) + MPAS_ACC_TIMER_STOP('atm_bdy_adjust_scalars [ACC_data_xfer]') + !$acc parallel default(present) + !$acc loop gang worker 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) + !$acc loop vector collapse(2) + do k=1,nVertLevels + do iScalar=1,num_scalars + scalars_tmp(iScalar,k,iCell) = scalars_new(iScalar,k,iCell) + end do + end do ! first, we compute the 2nd-order laplacian filter ! + !$acc loop seq do i=1,nEdgesOnCell(iCell) iEdge = edgesOnCell(i,iCell) ! edge_sign = r_areaCell*edgesOnCell_sign(i,iCell) * dvEdge(iEdge) * invDcEdge(iEdge) * laplacian_filter_coef @@ -6259,6 +7835,7 @@ subroutine atm_bdy_adjust_scalars_work( scalars_new, scalars_driving, dt, dt_rk, cell1 = cellsOnEdge(1,iEdge) cell2 = cellsOnEdge(2,iEdge) !DIR$ IVDEP + !$acc loop vector collapse(2) do k=1,nVertLevels do iScalar = 1, num_scalars filter_flux = edge_sign*( (scalars_new(iScalar,k,cell2)-scalars_driving(iScalar,k,cell2)) & @@ -6271,6 +7848,7 @@ subroutine atm_bdy_adjust_scalars_work( scalars_new, scalars_driving, dt, dt_rk, ! second, we compute the Rayleigh damping component ! !DIR$ IVDEP + !$acc loop vector collapse(2) 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)) @@ -6282,6 +7860,7 @@ subroutine atm_bdy_adjust_scalars_work( scalars_new, scalars_driving, dt, dt_rk, ! update the specified-zone values ! !DIR$ IVDEP + !$acc loop vector collapse(2) do k=1,nVertLevels do iScalar = 1, num_scalars scalars_tmp(iScalar,k,iCell) = scalars_driving(iScalar,k,iCell) @@ -6291,12 +7870,16 @@ subroutine atm_bdy_adjust_scalars_work( scalars_new, scalars_driving, dt, dt_rk, end if end do ! updates now in temp storage + !$acc end parallel !$OMP BARRIER + !$acc parallel default(present) + !$acc loop gang worker do iCell = cellSolveStart, cellSolveEnd ! threaded over cells if (bdyMaskCell(iCell) > 1) then ! update values !DIR$ IVDEP + !$acc loop vector collapse(2) do k=1,nVertLevels do iScalar = 1, num_scalars scalars_new(iScalar,k,iCell) = scalars_tmp(iScalar,k,iCell) @@ -6304,6 +7887,12 @@ subroutine atm_bdy_adjust_scalars_work( scalars_new, scalars_driving, dt, dt_rk, end do end if end do + !$acc end parallel + + MPAS_ACC_TIMER_START('atm_bdy_adjust_scalars [ACC_data_xfer]') + !$acc exit data delete(scalars_tmp) & + !$acc copyout(scalars_new) + MPAS_ACC_TIMER_STOP('atm_bdy_adjust_scalars [ACC_data_xfer]') end subroutine atm_bdy_adjust_scalars_work @@ -6373,6 +7962,12 @@ subroutine atm_bdy_set_scalars_work( scalars_driving, scalars_new, & !--- + MPAS_ACC_TIMER_START('atm_bdy_set_scalars_work [ACC_data_xfer]') + !$acc enter data copyin(scalars_new) + MPAS_ACC_TIMER_STOP('atm_bdy_set_scalars_work [ACC_data_xfer]') + + !$acc parallel default(present) + !$acc loop gang worker do iCell = cellSolveStart, cellSolveEnd ! threaded over cells if ( bdyMaskCell(iCell) > nRelaxZone) then ! specified zone @@ -6380,6 +7975,7 @@ subroutine atm_bdy_set_scalars_work( scalars_driving, scalars_new, & ! update the specified-zone values ! !DIR$ IVDEP + !$acc loop vector collapse(2) do k=1,nVertLevels do iScalar = 1, num_scalars scalars_new(iScalar,k,iCell) = scalars_driving(iScalar,k,iCell) @@ -6389,6 +7985,11 @@ subroutine atm_bdy_set_scalars_work( scalars_driving, scalars_new, & end if end do ! updates now in temp storage + !$acc end parallel + + MPAS_ACC_TIMER_START('atm_bdy_set_scalars_work [ACC_data_xfer]') + !$acc exit data copyout(scalars_new) + MPAS_ACC_TIMER_STOP('atm_bdy_set_scalars_work [ACC_data_xfer]') end subroutine atm_bdy_set_scalars_work @@ -6409,7 +8010,8 @@ subroutine summarize_timestep(domain) logical, pointer :: config_print_global_minmax_sca integer :: iCell, k, iEdge, iScalar - integer, pointer :: num_scalars, nCellsSolve, nEdgesSolve, nVertLevels + integer, pointer :: num_scalars_ptr, nCellsSolve_ptr, nEdgesSolve_ptr, nVertLevels_ptr + integer :: num_scalars, nCellsSolve, nEdgesSolve, nVertLevels type (mpas_pool_type), pointer :: state type (mpas_pool_type), pointer :: diag @@ -6425,54 +8027,94 @@ subroutine summarize_timestep(domain) integer, dimension(:), pointer :: indexToCellID integer :: indexMax, indexMax_global integer :: kMax, kMax_global + integer :: offset_1d ! Offset into a multi-dimensional array, as if it were a contiguous 1-d array real (kind=RKIND) :: latMax, latMax_global real (kind=RKIND) :: lonMax, lonMax_global real (kind=RKIND), dimension(5) :: localVals, globalVals - real (kind=RKIND) :: spd + real (kind=RKIND), dimension(:,:), allocatable :: spd + !$acc declare create(spd) real (kind=RKIND), dimension(:,:), pointer :: w real (kind=RKIND), dimension(:,:), pointer :: u, v, uReconstructZonal, uReconstructMeridional, uReconstructX, uReconstructY, uReconstructZ real (kind=RKIND), dimension(:,:,:), pointer :: scalars, scalars_1, scalars_2 + logical :: found_NaN + call mpas_pool_get_config(block % configs, 'config_print_global_minmax_vel', config_print_global_minmax_vel) call mpas_pool_get_config(block % configs, 'config_print_detailed_minmax_vel', config_print_detailed_minmax_vel) call mpas_pool_get_config(block % configs, 'config_print_global_minmax_sca', config_print_global_minmax_sca) + call mpas_pool_get_subpool(block % structs, 'state', state) + call mpas_pool_get_subpool(block % structs, 'diag', diag) + call mpas_pool_get_array(state, 'w', w, 2) + call mpas_pool_get_array(state, 'u', u, 2) + call mpas_pool_get_array(diag, 'v', v) + call mpas_pool_get_array(state, 'scalars', scalars, 2) + call mpas_pool_get_dimension(state, 'nCellsSolve', nCellsSolve_ptr) + call mpas_pool_get_dimension(state, 'nEdgesSolve', nEdgesSolve_ptr) + call mpas_pool_get_dimension(state, 'nVertLevels', nVertLevels_ptr) + call mpas_pool_get_dimension(state, 'num_scalars', num_scalars_ptr) + nCellsSolve = nCellsSolve_ptr + nEdgesSolve = nEdgesSolve_ptr + nVertLevels = nVertLevels_ptr + num_scalars = num_scalars_ptr + + MPAS_ACC_TIMER_START('summarize_timestep [ACC_data_xfer]') + if (config_print_detailed_minmax_vel) then + !$acc enter data copyin(w,u,v) + else if (config_print_global_minmax_vel) then + !$acc enter data copyin(w,u) + end if + if (config_print_global_minmax_sca) then + !$acc enter data copyin(scalars) + end if + MPAS_ACC_TIMER_STOP('summarize_timestep [ACC_data_xfer]') + if (config_print_detailed_minmax_vel) then call mpas_log_write('') - 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_array(state, 'w', w, 2) - call mpas_pool_get_array(state, 'u', u, 2) - call mpas_pool_get_array(diag, 'v', v) call mpas_pool_get_array(mesh, 'indexToCellID', indexToCellID) 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_dimension(state, 'nCellsSolve', nCellsSolve) - call mpas_pool_get_dimension(state, 'nEdgesSolve', nEdgesSolve) - call mpas_pool_get_dimension(state, 'nVertLevels', nVertLevels) + + allocate(spd(nVertLevels,nEdgesSolve)) scalar_min = 1.0e20 + offset_1d = huge(1) indexMax = -1 kMax = -1 latMax = 0.0 lonMax = 0.0 + !$acc parallel default(present) + !$acc loop collapse(2) gang vector reduction(min:scalar_min) + do iCell = 1, nCellsSolve + do k = 1, nVertLevels + scalar_min = min(scalar_min, w(k,iCell)) + end do + end do + !$acc end parallel + + ! This second loop using offset_1d ensures the same (kMax,indexMax) are reported with the scalar_min + ! Especially when using OpenACC + !$acc parallel default(present) + !$acc loop collapse(2) gang vector reduction(min:offset_1d) do iCell = 1, nCellsSolve do k = 1, nVertLevels - if (w(k,iCell) < scalar_min) then - scalar_min = w(k,iCell) - indexMax = iCell - kMax = k - latMax = latCell(iCell) - lonMax = lonCell(iCell) + if (w(k,iCell) == scalar_min) then + ! In case 2 locations tie, only save the minimum value + offset_1d = min(offset_1d, (k-1) + size(w,1)*(iCell-1)) end if end do end do + !$acc end parallel + kMax = mod(offset_1d, size(w,1)) + 1 + indexMax = (offset_1d / size(w,1)) + 1 ! Integer divide + latMax = latCell(indexMax) + lonMax = lonCell(indexMax) localVals(1) = scalar_min localVals(2) = real(indexMax,kind=RKIND) localVals(3) = real(kMax,kind=RKIND) @@ -6494,21 +8136,34 @@ subroutine summarize_timestep(domain) realArgs=(/global_scalar_min, latMax_global, lonMax_global/)) scalar_max = -1.0e20 + offset_1d = huge(1) indexMax = -1 kMax = -1 latMax = 0.0 lonMax = 0.0 + !$acc parallel default(present) + !$acc loop collapse(2) gang vector reduction(max:scalar_max) + do iCell = 1, nCellsSolve + do k = 1, nVertLevels + scalar_max = max(scalar_max, w(k,iCell)) + end do + end do + !$acc end parallel + + !$acc parallel default(present) + !$acc loop collapse(2) gang vector reduction(min:offset_1d) do iCell = 1, nCellsSolve do k = 1, nVertLevels - if (w(k,iCell) > scalar_max) then - scalar_max = w(k,iCell) - indexMax = iCell - kMax = k - latMax = latCell(iCell) - lonMax = lonCell(iCell) + if (w(k,iCell) == scalar_max) then + offset_1d = min(offset_1d, (k-1) + size(w,1)*(iCell-1)) end if end do end do + !$acc end parallel + kMax = mod(offset_1d, size(w,1)) + 1 + indexMax = (offset_1d / size(w,1)) + 1 + latMax = latCell(indexMax) + lonMax = lonCell(indexMax) localVals(1) = scalar_max localVals(2) = real(indexMax,kind=RKIND) localVals(3) = real(kMax,kind=RKIND) @@ -6530,21 +8185,34 @@ subroutine summarize_timestep(domain) realArgs=(/global_scalar_max, latMax_global, lonMax_global/)) scalar_min = 1.0e20 + offset_1d = huge(1) indexMax = -1 kMax = -1 latMax = 0.0 lonMax = 0.0 + !$acc parallel default(present) + !$acc loop collapse(2) gang vector reduction(min:scalar_min) + do iEdge = 1, nEdgesSolve + do k = 1, nVertLevels + scalar_min = min(scalar_min, u(k,iEdge)) + end do + end do + !$acc end parallel + + !$acc parallel default(present) + !$acc loop collapse(2) gang vector reduction(min:offset_1d) do iEdge = 1, nEdgesSolve do k = 1, nVertLevels - if (u(k,iEdge) < scalar_min) then - scalar_min = u(k,iEdge) - indexMax = iEdge - kMax = k - latMax = latEdge(iEdge) - lonMax = lonEdge(iEdge) + if (u(k,iEdge) == scalar_min) then + offset_1d = min(offset_1d, (k-1) + size(u,1)*(iEdge-1)) end if end do end do + !$acc end parallel + kMax = mod(offset_1d, size(u,1)) + 1 + indexMax = (offset_1d / size(u,1)) + 1 + latMax = latEdge(indexMax) + lonMax = lonEdge(indexMax) localVals(1) = scalar_min localVals(2) = real(indexMax,kind=RKIND) localVals(3) = real(kMax,kind=RKIND) @@ -6566,21 +8234,34 @@ subroutine summarize_timestep(domain) realArgs=(/global_scalar_min, latMax_global, lonMax_global/)) scalar_max = -1.0e20 + offset_1d = huge(1) indexMax = -1 kMax = -1 latMax = 0.0 lonMax = 0.0 + !$acc parallel default(present) + !$acc loop collapse(2) gang vector reduction(max:scalar_max) do iEdge = 1, nEdgesSolve do k = 1, nVertLevels - if (u(k,iEdge) > scalar_max) then - scalar_max = u(k,iEdge) - indexMax = iEdge - kMax = k - latMax = latEdge(iEdge) - lonMax = lonEdge(iEdge) + scalar_max = max(scalar_max, u(k,iEdge)) + end do + end do + !$acc end parallel + + !$acc parallel default(present) + !$acc loop collapse(2) gang vector reduction(min:offset_1d) + do iEdge = 1, nEdgesSolve + do k = 1, nVertLevels + if (u(k,iEdge) == scalar_max) then + offset_1d = min(offset_1d, (k-1) + size(u,1)*(iEdge-1)) end if end do end do + !$acc end parallel + kMax = mod(offset_1d, size(u,1)) + 1 + indexMax = (offset_1d / size(u,1)) + 1 + latMax = latEdge(indexMax) + lonMax = lonEdge(indexMax) localVals(1) = scalar_max localVals(2) = real(indexMax,kind=RKIND) localVals(3) = real(kMax,kind=RKIND) @@ -6602,22 +8283,35 @@ subroutine summarize_timestep(domain) realArgs=(/global_scalar_max, latMax_global, lonMax_global/)) scalar_max = -1.0e20 + offset_1d = huge(1) indexMax = -1 kMax = -1 latMax = 0.0 lonMax = 0.0 + !$acc parallel default(present) + !$acc loop collapse(2) gang vector reduction(max:scalar_max) + do iEdge = 1, nEdgesSolve + do k = 1, nVertLevels + spd(k,iEdge) = sqrt(u(k,iEdge)*u(k,iEdge) + v(k,iEdge)*v(k,iEdge)) + scalar_max = max(scalar_max, spd(k,iEdge)) + end do + end do + !$acc end parallel + + !$acc parallel default(present) + !$acc loop collapse(2) gang vector reduction(min:offset_1d) do iEdge = 1, nEdgesSolve do k = 1, nVertLevels - spd = sqrt(u(k,iEdge)*u(k,iEdge) + v(k,iEdge)*v(k,iEdge)) - if (spd > scalar_max) then - scalar_max = spd - indexMax = iEdge - kMax = k - latMax = latEdge(iEdge) - lonMax = lonEdge(iEdge) + if (spd(k,iEdge) == scalar_max) then + offset_1d = min(offset_1d, (k-1) + size(spd,1)*(iEdge-1)) end if end do end do + !$acc end parallel + kMax = mod(offset_1d, size(spd,1)) + 1 + indexMax = (offset_1d / size(spd,1)) + 1 + latMax = latEdge(indexMax) + lonMax = lonEdge(indexMax) localVals(1) = scalar_max localVals(2) = real(indexMax,kind=RKIND) localVals(3) = real(kMax,kind=RKIND) @@ -6641,52 +8335,69 @@ subroutine summarize_timestep(domain) ! ! Check for NaNs ! + found_NaN = .false. + + !$acc parallel default(present) + !$acc loop collapse(2) gang vector reduction(.or.:found_NaN) do iCell = 1, nCellsSolve do k = 1, nVertLevels if (ieee_is_nan(w(k,iCell))) then - call mpas_log_write('NaN detected in ''w'' field.', messageType=MPAS_LOG_CRIT) + found_NaN = .true. end if end do end do + !$acc end parallel + if (found_NaN) then + call mpas_log_write('NaN detected in ''w'' field.', messageType=MPAS_LOG_CRIT) + end if + + found_NaN = .false. + !$acc parallel default(present) + !$acc loop collapse(2) gang vector reduction(.or.:found_NaN) do iEdge = 1, nEdgesSolve do k = 1, nVertLevels if (ieee_is_nan(u(k,iEdge))) then - call mpas_log_write('NaN detected in ''u'' field.', messageType=MPAS_LOG_CRIT) + found_NaN = .true. end if end do end do + !$acc end parallel + if (found_NaN) then + call mpas_log_write('NaN detected in ''u'' field.', messageType=MPAS_LOG_CRIT) + end if + + deallocate(spd) else if (config_print_global_minmax_vel) then call mpas_log_write('') - call mpas_pool_get_subpool(block % structs, 'state', state) - call mpas_pool_get_array(state, 'w', w, 2) - call mpas_pool_get_array(state, 'u', u, 2) - call mpas_pool_get_dimension(state, 'nCellsSolve', nCellsSolve) - call mpas_pool_get_dimension(state, 'nEdgesSolve', nEdgesSolve) - call mpas_pool_get_dimension(state, 'nVertLevels', nVertLevels) - scalar_min = 0.0 scalar_max = 0.0 + !$acc parallel default(present) + !$acc loop gang vector collapse(2) reduction(min:scalar_min) reduction(max:scalar_max) do iCell = 1, nCellsSolve do k = 1, nVertLevels scalar_min = min(scalar_min, w(k,iCell)) scalar_max = max(scalar_max, w(k,iCell)) end do end do + !$acc end parallel call mpas_dmpar_min_real(domain % dminfo, scalar_min, global_scalar_min) call mpas_dmpar_max_real(domain % dminfo, scalar_max, global_scalar_max) call mpas_log_write('global min, max w $r $r', realArgs=(/global_scalar_min, global_scalar_max/)) scalar_min = 0.0 scalar_max = 0.0 + !$acc parallel default(present) + !$acc loop gang vector collapse(2) reduction(min:scalar_min) reduction(max:scalar_max) do iEdge = 1, nEdgesSolve do k = 1, nVertLevels scalar_min = min(scalar_min, u(k,iEdge)) scalar_max = max(scalar_max, u(k,iEdge)) end do end do + !$acc end parallel call mpas_dmpar_min_real(domain % dminfo, scalar_min, global_scalar_min) call mpas_dmpar_max_real(domain % dminfo, scalar_max, global_scalar_max) call mpas_log_write('global min, max u $r $r', realArgs=(/global_scalar_min, global_scalar_max/)) @@ -6697,28 +8408,38 @@ subroutine summarize_timestep(domain) call mpas_log_write('') end if - call mpas_pool_get_subpool(block % structs, 'state', state) - call mpas_pool_get_array(state, 'scalars', scalars, 2) - call mpas_pool_get_dimension(state, 'nCellsSolve', nCellsSolve) - call mpas_pool_get_dimension(state, 'nVertLevels', nVertLevels) - call mpas_pool_get_dimension(state, 'num_scalars', num_scalars) - do iScalar = 1, num_scalars scalar_min = 0.0 scalar_max = 0.0 + !$acc parallel default(present) + !$acc loop gang vector collapse(2) reduction(min:scalar_min) reduction(max:scalar_max) do iCell = 1, nCellsSolve do k = 1, nVertLevels scalar_min = min(scalar_min, scalars(iScalar,k,iCell)) scalar_max = max(scalar_max, scalars(iScalar,k,iCell)) end do end do + !$acc end parallel call mpas_dmpar_min_real(domain % dminfo, scalar_min, global_scalar_min) call mpas_dmpar_max_real(domain % dminfo, scalar_max, global_scalar_max) call mpas_log_write(' global min, max scalar $i $r $r', intArgs=(/iScalar/), realArgs=(/global_scalar_min, global_scalar_max/)) end do + + end if + + MPAS_ACC_TIMER_START('summarize_timestep [ACC_data_xfer]') + if (config_print_detailed_minmax_vel) then + !$acc exit data delete(w,u,v) + else if (config_print_global_minmax_vel) then + !$acc exit data delete(w,u) + end if + if (config_print_global_minmax_sca) then + !$acc exit data delete(scalars) end if + MPAS_ACC_TIMER_STOP('summarize_timestep [ACC_data_xfer]') end subroutine summarize_timestep + !----------------------------------------------------------------------- ! routine atm_advance_scalars_work_coldpool ! @@ -6762,7 +8483,8 @@ subroutine atm_advance_scalars_work_coldpool(nCells, num_scalars, dt, & use mpas_atm_dimensions, only : nVertLevels implicit none - integer, intent(in) :: index_buoyx !--srf + + integer, intent(in) :: index_buoyx !-srf integer, intent(in) :: nCells ! for allocating stack variables integer, intent(in) :: nEdges ! for allocating stack variables integer, intent(in) :: num_scalars @@ -6813,15 +8535,12 @@ subroutine atm_advance_scalars_work_coldpool(nCells, num_scalars, dt, & flux4(q_im2, q_im1, q_i, q_ip1, ua) + & coef3*abs(ua)*((q_ip1 - q_im2)-3.*(q_i-q_im1))/12.0 - !-srf +!-srf !print*,'atm_advance_scalars_work_coldpool : index_buoyx',index_buoyx !-srf local_advance_density = advance_density -!print*,'ADVANCE',maxval(uhAvg),minval(uhAvg),maxval(uhAvg(1:1, edgeStart:edgeEnd)) & -! ,minval(uhAvg(1:1, edgeStart:edgeEnd)) - ! ! Runge Kutta integration, so we compute fluxes from scalar_new values, update starts from scalar_old ! @@ -6843,27 +8562,36 @@ subroutine atm_advance_scalars_work_coldpool(nCells, num_scalars, dt, & weight_time_old = 1. - weight_time_new + MPAS_ACC_TIMER_START('atm_advance_scalars [ACC_data_xfer]') + !$acc enter data copyin(uhAvg, scalar_new) + MPAS_ACC_TIMER_STOP('atm_advance_scalars [ACC_data_xfer]') + + !$acc parallel async + !$acc loop gang worker private(scalar_weight2, ica) do iEdge=edgeStart,edgeEnd - if( (.not.config_apply_lbcs) .or. (bdyMaskEdge(iEdge) .lt. nRelaxZone-1) ) then ! full flux calculation + if ((.not.config_apply_lbcs) & + .or. (bdyMaskEdge(iEdge) < nRelaxZone-1)) then ! full flux calculation select case(nAdvCellsForEdge(iEdge)) case(10) + !$acc loop vector collapse(2) 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 + + !$acc loop vector do j=1,10 ica(j) = advCellsForEdge(j,iEdge) end do -!DIR$ IVDEP + + !$acc loop vector collapse(2) do k = 1,nVertLevels -!DIR$ IVDEP - do iScalar = 1,num_scalars ; if(iScalar /= index_buoyx) cycle !--srf + do iScalar = 1,num_scalars ; if(iScalar /= index_buoyx) cycle !--srf 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)) + & @@ -6880,62 +8608,94 @@ subroutine atm_advance_scalars_work_coldpool(nCells, num_scalars, dt, & case default - horiz_flux_arr(:,:,iEdge) = 0.0 + !$acc loop vector collapse(2) + do k=1,nVertLevels + do iScalar=1,num_scalars + horiz_flux_arr(iScalar,k,iEdge) = 0.0_RKIND + end do + end do + + !$acc loop seq do j=1,nAdvCellsForEdge(iEdge) iAdvCell = advCellsForEdge(j,iEdge) -!DIR$ IVDEP + + !$acc loop vector collapse(2) 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 ; if(iScalar /= index_buoyx) cycle !--srf - horiz_flux_arr(iScalar,k,iEdge) = horiz_flux_arr(iScalar,k,iEdge) + scalar_weight * scalar_new(iScalar,k,iAdvCell) + do iScalar=1,num_scalars; if(iScalar /= index_buoyx) cycle !--srf + scalar_weight = adv_coefs(j,iEdge) + sign(1.0_RKIND,uhAvg(k,iEdge))*adv_coefs_3rd(j,iEdge) + 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 - else if(config_apply_lbcs .and. (bdyMaskEdge(iEdge) .ge. nRelaxZone-1) .and. (bdyMaskEdge(iEdge) .le. nRelaxZone) ) then + else if(config_apply_lbcs & + .and. (bdyMaskEdge(iEdge) >= nRelaxZone-1) & + .and. (bdyMaskEdge(iEdge) <= nRelaxZone)) then + ! upwind flux evaluation for outermost 2 edges in specified zone cell1 = cellsOnEdge(1,iEdge) cell2 = cellsOnEdge(2,iEdge) -!DIR$ IVDEP + + !$acc loop vector collapse(2) 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 ; if(iScalar /= index_buoyx) cycle !--srf + do iScalar=1,num_scalars + 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) + if(iScalar /= index_buoyx) cycle !--srf horiz_flux_arr(iScalar,k,iEdge) = u_positive*scalar_new(iScalar,k,cell1) + u_negative*scalar_new(iScalar,k,cell2) end do end do end if ! end of regional MPAS test - end do + !$acc end parallel !$OMP BARRIER -! scalar update, for each column sum fluxes over horizontal edges, add physics tendency, and add vertical flux divergence in update. - + ! + ! scalar update, for each column sum fluxes over horizontal edges, add physics tendency, + ! and add vertical flux divergence in update. + ! + MPAS_ACC_TIMER_START('atm_advance_scalars [ACC_data_xfer]') +#ifndef DO_PHYSICS + !$acc enter data create(scalar_tend_save) +#else + !$acc enter data copyin(scalar_tend_save) +#endif + !$acc enter data copyin(scalar_old, fnm, fnp, rdnw, wwAvg, rho_zz_old, rho_zz_new) + !$acc enter data create(scalar_tend_column) + MPAS_ACC_TIMER_STOP('atm_advance_scalars [ACC_data_xfer]') + + !$acc parallel wait + !$acc loop gang worker private(scalar_tend_column, wdtn) do iCell=cellSolveStart,cellSolveEnd if(bdyMaskCell(iCell) <= nRelaxZone) then ! specified zone for regional_MPAS is not updated in this routine + !$acc loop vector collapse(2) + do k=1,nVertLevels + do iScalar=1,num_scalars + scalar_tend_column(index_buoyx,k) = 0.0_RKIND + #ifndef DO_PHYSICS - scalar_tend_save(index_buoyx,:,iCell) = 0.0 ! testing purposes - we have no sources or sinks + scalar_tend_save(index_buoyx,k,iCell) = 0.0_RKIND ! testing purposes - we have no sources or sinks #endif - scalar_tend_column(index_buoyx,1:nVertlevels) = 0. + end do + end do + !$acc loop seq 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 + !$acc loop vector collapse(2) do k=1,nVertLevels -!DIR$ IVDEP do iScalar=1,num_scalars; if(iScalar /= index_buoyx) cycle !--srf scalar_tend_column(iScalar,k) = scalar_tend_column(iScalar,k) & - edgesOnCell_sign(i,iCell) * uhAvg(k,iEdge)*horiz_flux_arr(iScalar,k,iEdge) @@ -6944,14 +8704,14 @@ subroutine atm_advance_scalars_work_coldpool(nCells, num_scalars, dt, & end do -!DIR$ IVDEP + !$acc loop vector collapse(2) do k=1,nVertLevels -!DIR$ IVDEP do iScalar=1,num_scalars; if(iScalar /= index_buoyx) cycle !--srf - scalar_tend_column(iScalar,k) = scalar_tend_column(iScalar,k) * invAreaCell(iCell) + scalar_tend_save(iScalar,k,iCell) + scalar_tend_column(iScalar,k) = scalar_tend_column(iScalar,k) * invAreaCell(iCell) & + + scalar_tend_save(iScalar,k,iCell) end do end do - + !--srf the cold pool gust front is essentially a terrain-following horizontal movement. wdtn(:,:) = 0.0 ! @@ -6982,11 +8742,10 @@ subroutine atm_advance_scalars_work_coldpool(nCells, num_scalars, dt, & ! end do !--srf -!DIR$ IVDEP + !$acc loop vector collapse(2) 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; if(iScalar /= index_buoyx) cycle !--srf + rho_zz_new_inv = 1.0_RKIND / (weight_time_old*rho_zz_old(k,iCell) + weight_time_new*rho_zz_new(k,iCell)) 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 @@ -6995,8 +8754,17 @@ subroutine atm_advance_scalars_work_coldpool(nCells, num_scalars, dt, & end if ! specified zone regional_MPAS test end do + !$acc end parallel + + MPAS_ACC_TIMER_START('atm_advance_scalars [ACC_data_xfer]') + !$acc exit data copyout(scalar_new) + !$acc exit data delete(scalar_tend_column, uhAvg, wwAvg, scalar_old, fnm, fnp, & + !$acc rdnw, rho_zz_old, rho_zz_new, scalar_tend_save) + MPAS_ACC_TIMER_STOP('atm_advance_scalars [ACC_data_xfer]') end subroutine atm_advance_scalars_work_coldpool + + !----------------------------------------------------------------------- ! routine atm_advance_scalars_mono_work_coldpool ! @@ -7029,7 +8797,7 @@ end subroutine atm_advance_scalars_work_coldpool !> as used in the RK3 scheme as described in Wang et al MWR 2009 ! !----------------------------------------------------------------------- - subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, num_scalars, dt, & + subroutine atm_advance_scalars_mono_work_coldpool(field_name, block, state, nCells, nEdges, num_scalars, dt, & cellStart, cellEnd, edgeStart, edgeEnd, & cellSolveStart, cellSolveEnd, & coef_3rd_order, nCellsSolve, uhAvg, wwAvg, scalar_tend, rho_zz_old, & @@ -7044,6 +8812,7 @@ subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, implicit none + character(len=*), intent(in) :: field_name type (block_type), intent(inout), target :: block type (mpas_pool_type), intent(inout) :: state integer, intent(in) :: index_buoyx !--srf @@ -7055,7 +8824,7 @@ subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, integer, intent(in) :: cellSolveStart, cellSolveEnd procedure (halo_exchange_routine) :: exchange_halo_group logical, intent(in), optional :: advance_density - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(inout), optional :: rho_zz_int + real (kind=RKIND), dimension(:,:), intent(inout), optional :: rho_zz_int integer :: ii,jj integer, dimension(10) :: ica @@ -7115,7 +8884,8 @@ subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, 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 - !-srf + +!-srf !print*,'atm_advance_scalars_work_mono_coldpool : index_buoyx',index_buoyx !-srf if (present(advance_density)) then @@ -7131,30 +8901,61 @@ subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, ! Note, however, that we enforce positive-definiteness in this update. ! The transport will maintain this positive definite solution and optionally, shape preservation (monotonicity). + + MPAS_ACC_TIMER_START('atm_advance_scalars_mono [ACC_data_xfer]') + !$acc data present(nEdgesOnCell, edgesOnCell, edgesOnCell_sign, & + !$acc invAreaCell, cellsOnCell, cellsOnEdge, nAdvCellsForEdge, & + !$acc advCellsForEdge, adv_coefs, adv_coefs_3rd, dvEdge, bdyMaskCell) + +#ifdef DO_PHYSICS + !$acc enter data copyin(scalar_tend) +#else + !$acc enter data create(scalar_tend) +#endif + if (local_advance_density) then + !$acc enter data copyin(rho_zz_int) + end if + !$acc enter data copyin(scalars_old, rho_zz_old, rdnw, uhAvg, wwAvg) + MPAS_ACC_TIMER_STOP('atm_advance_scalars_mono [ACC_data_xfer]') + + !$acc parallel + + !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd -!DIR$ IVDEP - do k = 1,nVertLevels -!DIR$ IVDEP - do iScalar = 1,num_scalars ; if(iScalar /= index_buoyx) cycle !--srf + + !$acc loop vector collapse(2) + do k = 1,nVertLevels + do iScalar = 1,num_scalars ; if(iScalar /= index_buoyx) cycle !--srf #ifndef DO_PHYSICS !TBH: Michael, would you please check this change? Our test uses -DDO_PHYSICS !TBH: so this code is not executed. The change avoids redundant work. - scalar_tend(iScalar,k,iCell) = 0.0 ! testing purposes - we have no sources or sinks + scalar_tend(iScalar,k,iCell) = 0.0_RKIND ! testing purposes - we have no sources or sinks #endif - scalars_old(iScalar,k,iCell) = scalars_old(iScalar,k,iCell)+dt*scalar_tend(iScalar,k,iCell) / rho_zz_old(k,iCell) - scalar_tend(iScalar,k,iCell) = 0.0 - end do + scalars_old(iScalar,k,iCell) = scalars_old(iScalar,k,iCell)+dt*scalar_tend(iScalar,k,iCell) / rho_zz_old(k,iCell) + scalar_tend(iScalar,k,iCell) = 0.0_RKIND + end do end do + end do + !$acc end parallel + + MPAS_ACC_TIMER_START('atm_advance_scalars_mono [ACC_data_xfer]') + !$acc exit data copyout(scalar_tend) + + !$acc update self(scalars_old) + MPAS_ACC_TIMER_STOP('atm_advance_scalars_mono [ACC_data_xfer]') !$OMP BARRIER !$OMP MASTER - call exchange_halo_group(block % domain, 'dynamics:scalars_old') + call exchange_halo_group(block % domain, 'dynamics:'//trim(field_name)//'_old') !$OMP END MASTER !$OMP BARRIER + MPAS_ACC_TIMER_START('atm_advance_scalars_mono [ACC_data_xfer]') + !$acc update device(scalars_old) + MPAS_ACC_TIMER_STOP('atm_advance_scalars_mono [ACC_data_xfer]') ! ! Runge Kutta integration, so we compute fluxes from scalar_new values, update starts from scalar_old @@ -7165,36 +8966,64 @@ subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, call mpas_log_write('Error: rho_zz_int not supplied to atm_advance_scalars_mono_work( ) when advance_density=.true.', messageType=MPAS_LOG_CRIT) end if + !$acc parallel + ! begin with update of density + + !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd - rho_zz_int(:,iCell) = 0.0 + + !$acc loop vector + do k=1,nVertLevels + rho_zz_int(k,iCell) = 0.0_RKIND + end do + + !$acc loop seq do i=1,nEdgesOnCell(iCell) iEdge = edgesOnCell(i,iCell) -!DIR$ IVDEP + !$acc loop vector 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) + rho_zz_int(k,iCell) = rho_zz_int(k,iCell) - edgesOnCell_sign(i,iCell) & + * uhAvg(k,iEdge) * dvEdge(iEdge) * invAreaCell(iCell) end do end do end do + + !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd -!DIR$ IVDEP + + !$acc loop vector 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)) ) + 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 + + !$acc end parallel + !$OMP BARRIER + end if - ! next, do one scalar at a time + MPAS_ACC_TIMER_START('atm_advance_scalars_mono [ACC_data_xfer]') + if (.not. local_advance_density) then + !$acc enter data copyin(rho_zz_new) + end if + !$acc enter data copyin(scalars_new, fnm, fnp) + !$acc enter data create(scale_arr) + MPAS_ACC_TIMER_STOP('atm_advance_scalars_mono [ACC_data_xfer]') - do iScalar = 1, num_scalars ; if(iScalar /= index_buoyx) cycle !--srf + do iScalar = 1, num_scalars; if(iScalar /= index_buoyx) cycle !--srf !srf !!print*,'scalars',iScalar,maxval(scalars_new(iScalar,:,:)) ! + !$acc parallel + + !$acc loop gang worker do iCell=cellStart,cellEnd -!DIR$ IVDEP + + !$acc loop vector do k=1,nVertLevels scalar_old(k,iCell) = scalars_old(iScalar,k,iCell) scalar_new(k,iCell) = scalars_new(iScalar,k,iCell) @@ -7202,15 +9031,20 @@ subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, end do ! ***** TEMPORARY TEST ******* WCS 20161012 - do k=1,nVertLevels - scalar_old(k,nCells+1) = 0. - scalar_new(k,nCells+1) = 0. - end do +#ifndef MPAS_OPENACC + do k=1,nVertLevels + scalar_old(k,nCells+1) = 0.0_RKIND + scalar_new(k,nCells+1) = 0.0_RKIND + end do +#endif + !$acc end parallel !$OMP BARRIER #ifdef DEBUG_TRANSPORT + !$acc update self(scalar_old) + scmin = scalar_old(1,1) scmax = scalar_old(1,1) do iCell = 1, nCells @@ -7221,6 +9055,8 @@ subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, end do call mpas_log_write(' scmin, scmin old in $r $r', realArgs=(/scmin,scmax/)) + !$acc update self(scalar_new) + scmin = scalar_new(1,1) scmax = scalar_new(1,1) do iCell = 1, nCells @@ -7232,15 +9068,17 @@ subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, call mpas_log_write(' scmin, scmin new in ', realArgs=(/scmin,scmax/)) #endif + !$acc parallel ! ! vertical flux divergence, and min and max bounds for flux limiter ! + !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd ! zero flux at top and bottom - wdtn(1,iCell) = 0.0 - wdtn(nVertLevels+1,iCell) = 0.0 + wdtn(1,iCell) = 0.0_RKIND + wdtn(nVertLevels+1,iCell) = 0.0_RKIND k = 1 s_max(k,iCell) = max(scalar_old(1,iCell),scalar_old(2,iCell)) @@ -7251,7 +9089,7 @@ subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, s_max(k,iCell) = max(scalar_old(k-1,iCell),scalar_old(k,iCell),scalar_old(k+1,iCell)) s_min(k,iCell) = min(scalar_old(k-1,iCell),scalar_old(k,iCell),scalar_old(k+1,iCell)) -!DIR$ IVDEP + !$acc loop vector do k=3,nVertLevels-1 wdtn(k,iCell) = flux3( scalar_new(k-2,iCell),scalar_new(k-1,iCell), & scalar_new(k ,iCell),scalar_new(k+1,iCell), & @@ -7273,7 +9111,7 @@ subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, ! original code retained in select "default" case select case(nEdgesOnCell(iCell)) case(6) -!DIR$ IVDEP + !$acc loop vector do k=1, nVertLevels s_max(k,iCell) = max(s_max(k,iCell), & scalar_old(k, cellsOnCell(1,iCell)), & @@ -7289,11 +9127,13 @@ subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, scalar_old(k, cellsOnCell(4,iCell)), & scalar_old(k, cellsOnCell(5,iCell)), & scalar_old(k, cellsOnCell(6,iCell))) - enddo + end do case default + !$acc loop seq do i=1, nEdgesOnCell(iCell) -!DIR$ IVDEP + + !$acc loop vector do k=1, nVertLevels s_max(k,iCell) = max(s_max(k,iCell),scalar_old(k, cellsOnCell(i,iCell))) s_min(k,iCell) = min(s_min(k,iCell),scalar_old(k, cellsOnCell(i,iCell))) @@ -7303,12 +9143,15 @@ subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, end do + !$acc end parallel + !$OMP BARRIER + !$acc parallel ! ! horizontal flux divergence ! - + !$acc loop gang worker private(ica, swa) do iEdge=edgeStart,edgeEnd cell1 = cellsOnEdge(1,iEdge) @@ -7321,11 +9164,14 @@ subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, ! be sure to see additional declarations near top of subroutine select case(nAdvCellsForEdge(iEdge)) case(10) + !$acc loop vector do jj=1,10 ica(jj) = advCellsForEdge(jj,iEdge) swa(jj,1) = adv_coefs(jj,iEdge) + adv_coefs_3rd(jj,iEdge) swa(jj,2) = adv_coefs(jj,iEdge) - adv_coefs_3rd(jj,iEdge) - enddo + end do + + !$acc loop vector do k=1,nVertLevels ii = merge(1, 2, uhAvg(k,iEdge) > 0) flux_arr(k,iEdge) = uhAvg(k,iEdge)*( & @@ -7334,15 +9180,19 @@ subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, swa(5,ii)*scalar_new(k,ica(5)) + swa(6,ii)*scalar_new(k,ica(6)) + & swa(7,ii)*scalar_new(k,ica(7)) + swa(8,ii)*scalar_new(k,ica(8)) + & swa(9,ii)*scalar_new(k,ica(9)) + swa(10,ii)*scalar_new(k,ica(10))) - enddo + end do case default + !$acc loop vector do k=1,nVertLevels flux_arr(k,iEdge) = 0.0_RKIND - enddo + end do + + !$acc loop seq do i=1,nAdvCellsForEdge(iEdge) iCell = advCellsForEdge(i,iEdge) -!DIR$ IVDEP + + !$acc loop vector do k=1,nVertLevels scalar_weight = uhAvg(k,iEdge)*(adv_coefs(i,iEdge) + sign(1.0_RKIND,uhAvg(k,iEdge))*adv_coefs_3rd(i,iEdge)) flux_arr(k,iEdge) = flux_arr(k,iEdge) + scalar_weight* scalar_new(k,iCell) @@ -7351,43 +9201,55 @@ subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, end select else - flux_arr(:,iEdge) = 0.0_RKIND + + !$acc loop vector + do k=1,nVertLevels + flux_arr(k,iEdge) = 0.0_RKIND + end do + end if end do + !$acc end parallel + !$OMP BARRIER + !$acc parallel + ! ! vertical flux divergence for upwind update, we will put upwind update into scalar_new, and put factor of dt in fluxes ! + !$acc loop gang worker private(flux_upwind_arr) do iCell=cellSolveStart,cellSolveEnd k = 1 scalar_new(k,iCell) = scalar_old(k,iCell) * rho_zz_old(k,iCell) -!DIR$ IVDEP + !$acc loop vector do k = 2, nVertLevels scalar_new(k,iCell) = scalar_old(k,iCell)*rho_zz_old(k,iCell) flux_upwind_arr(k) = dt*(max(0.0_RKIND,wwAvg(k,iCell))*scalar_old(k-1,iCell) + min(0.0_RKIND,wwAvg(k,iCell))*scalar_old(k,iCell)) end do + + !$acc loop vector do k = 1, nVertLevels-1 scalar_new(k,iCell) = scalar_new(k,iCell) - flux_upwind_arr(k+1)*rdnw(k) end do -!DIR$ IVDEP + + !$acc loop vector do k = 2, nVertLevels scalar_new(k ,iCell) = scalar_new(k ,iCell) + flux_upwind_arr(k)*rdnw(k) wdtn(k,iCell) = dt*wdtn(k,iCell) - flux_upwind_arr(k) end do - ! ! scale_arr(SCALE_IN,:,:) and scale_arr(SCALE_OUT:,:) are used here to store the incoming and outgoing perturbation flux ! contributions to the update: first the vertical flux component, then the horizontal ! -!DIR$ IVDEP + !$acc loop vector do k=1,nVertLevels scale_arr(k,SCALE_IN, iCell) = - rdnw(k)*(min(0.0_RKIND,wdtn(k+1,iCell))-max(0.0_RKIND,wdtn(k,iCell))) scale_arr(k,SCALE_OUT,iCell) = - rdnw(k)*(max(0.0_RKIND,wdtn(k+1,iCell))-min(0.0_RKIND,wdtn(k,iCell))) @@ -7400,28 +9262,43 @@ subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, ! ! upwind flux computation + !$acc loop gang worker do iEdge=edgeStart,edgeEnd + cell1 = cellsOnEdge(1,iEdge) cell2 = cellsOnEdge(2,iEdge) -!DIR$ IVDEP - do k=1, nVertLevels + + !$acc loop vector + do k=1,nVertLevels flux_upwind_tmp(k,iEdge) = dvEdge(iEdge) * dt * & (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) + !$acc loop vector + do k=1,nVertLevels + flux_tmp(k,iEdge) = 0.0_RKIND + flux_arr(k,iEdge) = flux_upwind_tmp(k,iEdge) + end do end if end do + + !$acc end parallel + !$OMP BARRIER + + !$acc parallel + + !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd + + !$acc loop seq do i=1,nEdgesOnCell(iCell) iEdge = edgesOnCell(i,iCell) -!DIR$ IVDEP + !$acc loop vector do k=1, nVertLevels scalar_new(k,iCell) = scalar_new(k,iCell) - edgesOnCell_sign(i,iCell) * flux_upwind_tmp(k,iEdge) * invAreaCell(iCell) @@ -7434,6 +9311,7 @@ subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, end do end do + ! ! next, the limiter ! @@ -7442,10 +9320,11 @@ subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, ! worked through algebra and found equivalent form ! added benefit that it should address ifort single prec overflow issue if (local_advance_density) then - do iCell=cellSolveStart,cellSolveEnd -!DIR$ IVDEP - do k = 1, nVertLevels + !$acc loop gang worker + do iCell=cellSolveStart,cellSolveEnd + !$acc loop vector + do k = 1, nVertLevels scale_factor = (s_max(k,iCell)*rho_zz_int(k,iCell) - scalar_new(k,iCell)) / & (scale_arr(k,SCALE_IN,iCell) + eps) scale_arr(k,SCALE_IN,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) ) @@ -7453,13 +9332,14 @@ subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, scale_factor = (s_min(k,iCell)*rho_zz_int(k,iCell) - scalar_new(k,iCell)) / & (scale_arr(k,SCALE_OUT,iCell) - eps) scale_arr(k,SCALE_OUT,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) ) - end do - end do + end do + end do else + !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd -!DIR$ IVDEP - do k = 1, nVertLevels + !$acc loop vector + do k = 1, nVertLevels scale_factor = (s_max(k,iCell)*rho_zz_new(k,iCell) - scalar_new(k,iCell)) / & (scale_arr(k,SCALE_IN,iCell) + eps) scale_arr(k,SCALE_IN,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) ) @@ -7471,21 +9351,37 @@ subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, end do end if + !$acc end parallel + ! ! communicate scale factors here. ! communicate only first halo row in these next two exchanges ! + + MPAS_ACC_TIMER_START('atm_advance_scalars_mono [ACC_data_xfer]') + !$acc update self(scale_arr) + MPAS_ACC_TIMER_STOP('atm_advance_scalars_mono [ACC_data_xfer]') + !$OMP BARRIER !$OMP MASTER call exchange_halo_group(block % domain, 'dynamics:scale') !$OMP END MASTER !$OMP BARRIER + MPAS_ACC_TIMER_START('atm_advance_scalars_mono [ACC_data_xfer]') + !$acc update device(scale_arr) + MPAS_ACC_TIMER_STOP('atm_advance_scalars_mono [ACC_data_xfer]') + + !$acc parallel + + !$acc loop gang worker do iEdge=edgeStart,edgeEnd cell1 = cellsOnEdge(1,iEdge) cell2 = cellsOnEdge(2,iEdge) + if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then ! only for owned cells -!DIR$ IVDEP + + !$acc loop vector do k=1, nVertLevels flux_upwind = dvEdge(iEdge) * dt * & (max(0.0_RKIND,uhAvg(k,iEdge))*scalar_old(k,cell1) + min(0.0_RKIND,uhAvg(k,iEdge))*scalar_old(k,cell2)) @@ -7493,7 +9389,10 @@ subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, end do if( config_apply_lbcs .and. (bdyMaskEdge(iEdge) == nRelaxZone) .or. (bdyMaskEdge(iEdge) == nRelaxZone-1) ) then - flux_arr(:,iEdge) = 0. + !$acc loop vector + do k=1,nVertLevels + flux_arr(k,iEdge) = 0.0_RKIND + end do end if end if @@ -7505,11 +9404,14 @@ subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, ! moved assignment to scalar_new from separate loop (see commented code below) ! into the following loops. Avoids having to save elements of flux array + !$acc loop gang worker do iEdge=edgeStart,edgeEnd cell1 = cellsOnEdge(1,iEdge) cell2 = cellsOnEdge(2,iEdge) + if (cell1 <= nCellsSolve .or. cell2 <= nCellsSolve) then -!DIR$ IVDEP + + !$acc loop vector do k = 1, nVertLevels flux = flux_arr(k,iEdge) flux = max(0.0_RKIND,flux) * min(scale_arr(k,SCALE_OUT,cell1), scale_arr(k,SCALE_IN, cell2)) & @@ -7519,13 +9421,20 @@ subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, end if end do + !$acc end parallel + ! ! rescale the vertical flux ! + !$OMP BARRIER + !$acc parallel + + !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd -!DIR$ IVDEP + + !$acc loop vector do k = 2, nVertLevels flux = wdtn(k,iCell) flux = max(0.0_RKIND,flux) * min(scale_arr(k-1,SCALE_OUT,iCell), scale_arr(k ,SCALE_IN,iCell)) & @@ -7534,33 +9443,42 @@ subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, end do end do - ! ! do the scalar update now that we have the fluxes ! + !$acc loop gang worker do iCell=cellSolveStart,cellSolveEnd + + !$acc loop seq do i=1,nEdgesOnCell(iCell) iEdge = edgesOnCell(i,iCell) -!DIR$ IVDEP + + !$acc loop vector do k=1,nVertLevels scalar_new(k,iCell) = scalar_new(k,iCell) - edgesOnCell_sign(i,iCell)*flux_arr(k,iEdge) * invAreaCell(iCell) end do end do - if (local_advance_density) then -!DIR$ IVDEP - do k=1,nVertLevels - scalar_new(k,iCell) = ( scalar_new(k,iCell) + (-rdnw(k)*(wdtn(k+1,iCell)-wdtn(k,iCell)) ) )/rho_zz_int(k,iCell) - end do - else -!DIR$ IVDEP - do k=1,nVertLevels - scalar_new(k,iCell) = ( scalar_new(k,iCell) + (-rdnw(k)*(wdtn(k+1,iCell)-wdtn(k,iCell)) ) )/rho_zz_new(k,iCell) - end do - end if + if (local_advance_density) then + !$acc loop vector + do k=1,nVertLevels + scalar_new(k,iCell) = (scalar_new(k,iCell) + (-rdnw(k)*(wdtn(k+1,iCell)-wdtn(k,iCell)) ) )/rho_zz_int(k,iCell) + end do + else + !$acc loop vector + do k=1,nVertLevels + scalar_new(k,iCell) = (scalar_new(k,iCell) + (-rdnw(k)*(wdtn(k+1,iCell)-wdtn(k,iCell)) ) )/rho_zz_new(k,iCell) + end do + end if end do + !$acc end parallel + #ifdef DEBUG_TRANSPORT + !$acc update self(scalar_new) + !$acc update self(s_max) + !$acc update self(s_min) + scmin = scalar_new(1,1) scmax = scalar_new(1,1) do iCell = 1, nCellsSolve @@ -7583,16 +9501,36 @@ subroutine atm_advance_scalars_mono_work_coldpool(block, state, nCells, nEdges, ! hence the enforcement of PD in the copy back to the model state. !$OMP BARRIER + !$acc parallel + + !$acc loop gang worker do iCell=cellStart,cellEnd if(bdyMaskCell(iCell) <= nSpecZone) then ! regional_MPAS does spec zone update after transport. - do k=1, nVertLevels + !$acc loop vector + do k=1,nVertLevels scalars_new(iScalar,k,iCell) = max(0.0_RKIND,scalar_new(k,iCell)) end do end if end do + !$acc end parallel + end do ! loop over scalars + MPAS_ACC_TIMER_START('atm_advance_scalars_mono [ACC_data_xfer]') + if (local_advance_density) then + !$acc exit data copyout(rho_zz_int) + else + !$acc exit data delete(rho_zz_new) + end if + !$acc exit data copyout(scalars_new) + !$acc exit data delete(scalars_old, scale_arr, rho_zz_old, wwAvg, & + !$acc uhAvg, fnm, fnp, rdnw) + + !$acc end data + MPAS_ACC_TIMER_STOP('atm_advance_scalars_mono [ACC_data_xfer]') + end subroutine atm_advance_scalars_mono_work_coldpool + end module atm_time_integration diff --git a/src/core_atmosphere/mpas_atm_core.F b/src/core_atmosphere/mpas_atm_core.F index 4093873b7..7f9be1196 100644 --- a/src/core_atmosphere/mpas_atm_core.F +++ b/src/core_atmosphere/mpas_atm_core.F @@ -392,9 +392,12 @@ subroutine atm_mpas_init_block(dminfo, stream_manager, block, mesh, dt) type (mpas_pool_type), pointer :: tend type (mpas_pool_type), pointer :: sfc_input type (mpas_pool_type), pointer :: diag_physics + type (mpas_pool_type), pointer :: diag_physics_noahmp + type (mpas_pool_type), pointer :: ngw_input type (mpas_pool_type), pointer :: atm_input + type (mpas_pool_type), pointer :: output_noahmp - integer :: iCell,iEdge,iVertex + integer :: iCell,iEdge,iVertex,k real (kind=RKIND), dimension(:,:), pointer :: u, uReconstructX, uReconstructY, uReconstructZ, uReconstructZonal, uReconstructMeridional real (kind=RKIND), dimension(:), pointer :: meshScalingDel2, meshScalingDel4 @@ -402,7 +405,8 @@ subroutine atm_mpas_init_block(dminfo, stream_manager, block, mesh, dt) real (kind=RKIND), dimension(:), pointer :: dvEdge, invDvEdge real (kind=RKIND), dimension(:), pointer :: dcEdge, invDcEdge real (kind=RKIND), dimension(:), pointer :: areaTriangle, invAreaTriangle - integer, pointer :: nCells, nEdges, nVertices, nVertLevels, nEdgesSolve + integer, pointer :: nCells_ptr, nEdges_ptr, nVertices_ptr, nVertLevels_ptr, nEdgesSolve + integer :: nCells, nEdges, nVertices, nVertLevels integer :: thread character(len=StrKIND), pointer :: mminlu @@ -441,9 +445,13 @@ subroutine atm_mpas_init_block(dminfo, stream_manager, block, mesh, dt) call mpas_pool_get_array(mesh, 'areaTriangle', areaTriangle) call mpas_pool_get_array(mesh, 'invAreaTriangle', invAreaTriangle) - call mpas_pool_get_dimension(mesh, 'nCells', nCells) - call mpas_pool_get_dimension(mesh, 'nEdges', nEdges) - call mpas_pool_get_dimension(mesh, 'nVertices', nVertices) + call mpas_pool_get_dimension(mesh, 'nCells', nCells_ptr) + call mpas_pool_get_dimension(mesh, 'nEdges', nEdges_ptr) + call mpas_pool_get_dimension(mesh, 'nVertices', nVertices_ptr) + + nCells = nCells_ptr + nEdges = nEdges_ptr + nVertices = nVertices_ptr do iCell=1,nCells invAreaCell(iCell) = 1.0_RKIND / areaCell(iCell) @@ -468,13 +476,21 @@ subroutine atm_mpas_init_block(dminfo, stream_manager, block, mesh, dt) call atm_couple_coef_3rd_order(mesh, block % configs) - call mpas_pool_get_dimension(state, 'nVertices', nVertices) - call mpas_pool_get_dimension(state, 'nVertLevels', nVertLevels) + call mpas_pool_get_dimension(state, 'nVertices', nVertices_ptr) + call mpas_pool_get_dimension(state, 'nVertLevels', nVertLevels_ptr) + + nVertices = nVertices_ptr + nVertLevels = nVertLevels_ptr allocate(ke_vertex(nVertLevels,nVertices+1)) ! ke_vertex is a module variable defined in mpas_atm_time_integration.F - ke_vertex(:,nVertices+1) = 0.0_RKIND allocate(ke_edge(nVertLevels,nEdges+1)) ! ke_edge is a module variable defined in mpas_atm_time_integration.F - ke_edge(:,nEdges+1) = 0.0_RKIND + !$acc parallel default(present) + !$acc loop vector + do k = 1, nVertLevels + ke_vertex(k,nVertices+1) = 0.0_RKIND + ke_edge(k,nEdges+1) = 0.0_RKIND + end do + !$acc end parallel call mpas_pool_get_dimension(block % dimensions, 'nThreads', nThreads) @@ -551,14 +567,17 @@ subroutine atm_mpas_init_block(dminfo, stream_manager, block, mesh, dt) !initialization of some input variables in registry: call mpas_pool_get_subpool(block % structs, 'tend', tend) call mpas_pool_get_subpool(block % structs, 'diag_physics', diag_physics) + call mpas_pool_get_subpool(block % structs, 'diag_physics_noahmp', diag_physics_noahmp) + call mpas_pool_get_subpool(block % structs, 'ngw_input', ngw_input) call mpas_pool_get_subpool(block % structs, 'atm_input', atm_input) + call mpas_pool_get_subpool(block % structs, 'output_noahmp', output_noahmp) call physics_tables_init(dminfo, block % configs) call physics_registry_init(mesh, block % configs, sfc_input) call physics_run_init(block % configs, mesh, state, clock, stream_manager) !initialization of all physics: - call physics_init(dminfo, clock, block % configs, mesh, diag, tend, state, 1, diag_physics, & - atm_input, sfc_input) + call physics_init(dminfo, stream_manager, clock, block % configs, mesh, diag, tend, state, 1, & + diag_physics, diag_physics_noahmp, ngw_input, atm_input, sfc_input, output_noahmp) endif #endif @@ -598,7 +617,7 @@ function atm_core_run(domain) result(ierr) type (domain_type), intent(inout) :: domain integer :: ierr - real (kind=RKIND), pointer :: dt + real (kind=RKIND) :: dt logical, pointer :: config_do_restart logical, pointer :: config_apply_lbcs type (block_type), pointer :: block_ptr @@ -625,8 +644,7 @@ function atm_core_run(domain) result(ierr) 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) + call mpas_get_timeInterval(mpas_get_clock_timestep(clock, ierr), dt=dt) call mpas_pool_get_config(domain % blocklist % configs, 'config_do_restart', config_do_restart) call mpas_pool_get_config(domain % blocklist % configs, 'config_restart_timestamp_name', config_restart_timestamp_name) diff --git a/src/core_atmosphere/mpas_atm_core_interface.F b/src/core_atmosphere/mpas_atm_core_interface.F index 6435e5b50..4e18b097f 100644 --- a/src/core_atmosphere/mpas_atm_core_interface.F +++ b/src/core_atmosphere/mpas_atm_core_interface.F @@ -124,10 +124,19 @@ function atm_setup_packages(configs, streamInfo, packages, iocontext) result(ier logical, pointer :: config_apply_lbcs logical, pointer :: config_jedi_da, jedi_daActive logical, pointer :: no_invariant_streamActive + logical, pointer :: ugwp_orog_streamActive + logical, pointer :: ugwp_ngw_streamActive + logical, pointer :: ugwp_diags_streamActive + character(len=StrKIND), pointer :: config_gwdo_scheme + logical, pointer :: config_ngw_scheme + logical, pointer :: config_ugwp_diags character(len=StrKIND) :: attvalue integer :: local_ierr - ierr = 0 + ierr = atm_setup_packages_when(configs, packages) + if (ierr /= 0) then + return + end if ! ! Incremental analysis update @@ -206,15 +215,60 @@ function atm_setup_packages(configs, streamInfo, packages, iocontext) result(ier ierr = ierr + 1 call mpas_log_write('Package setup failed for atmphys in core_atmosphere', messageType=MPAS_LOG_ERR) end if + + ! + ! Optional gravity wave drag parameterization streams + ! + call mpas_pool_get_config(configs, 'config_gwdo_scheme', config_gwdo_scheme) + nullify(ugwp_orog_streamActive) + call mpas_pool_get_package(packages, 'ugwp_orog_streamActive', ugwp_orog_streamActive) + if ( associated(config_gwdo_scheme) .and. associated(ugwp_orog_streamActive) ) then + if (trim(config_gwdo_scheme) == "bl_ugwp_gwdo") then + ugwp_orog_streamActive = .true. + else + ugwp_orog_streamActive = .false. + endif + else + ierr = ierr + 1 + call mpas_log_write("Package setup failed for 'ugwp_orog_stream'. 'ugwp_orog_stream' is not a package.", & + messageType=MPAS_LOG_ERR) + end if + + call mpas_pool_get_config(configs, 'config_ngw_scheme', config_ngw_scheme) + nullify(ugwp_ngw_streamActive) + call mpas_pool_get_package(packages, 'ugwp_ngw_streamActive', ugwp_ngw_streamActive) + if ( associated(config_ngw_scheme) .and. associated(ugwp_ngw_streamActive) ) then + ugwp_ngw_streamActive = config_ngw_scheme + else + ierr = ierr + 1 + call mpas_log_write("Package setup failed for 'ugwp_ngw_stream'. 'ugwp_ngw_stream' is not a package.", & + messageType=MPAS_LOG_ERR) + end if + + call mpas_pool_get_config(configs, 'config_ugwp_diags', config_ugwp_diags) + nullify(ugwp_diags_streamActive) + call mpas_pool_get_package(packages, 'ugwp_diags_streamActive', ugwp_diags_streamActive) + if ( associated(config_ugwp_diags) .and. associated(ugwp_diags_streamActive) ) then + ugwp_diags_streamActive = config_ugwp_diags + else + ierr = ierr + 1 + call mpas_log_write("Package setup failed for 'ugwp_diags_stream'. 'ugwp_diags_stream' is not a package.", & + messageType=MPAS_LOG_ERR) + end if + #endif ! ! Packages for the GF-MONAN scheme ! + !srf call setup_monan_packages(configs, packages) + !srf end function atm_setup_packages + !srf + !*********************************************************************** ! function setup_monan_packages ! !> \brief Set up packages specific to the GF-MONAN scheme @@ -311,6 +365,7 @@ subroutine setup_monan_packages(configs, packages) end if end subroutine setup_monan_packages + !srf !*********************************************************************** ! @@ -363,9 +418,7 @@ function atm_setup_log(logInfo, domain, unitNumbers) result(iErr)!{{{ use mpas_derived_types, only : mpas_log_type, domain_type use mpas_log, only : mpas_log_init, mpas_log_open -#ifdef MPAS_OPENMP - use mpas_threading, only : mpas_threading_get_num_threads -#endif + use mpas_framework, only : mpas_framework_report_settings implicit none @@ -394,53 +447,8 @@ function atm_setup_log(logInfo, domain, unitNumbers) result(iErr)!{{{ call mpas_log_write('') call mpas_log_write('MPAS-Atmosphere Version '//trim(domain % core % modelVersion)) call mpas_log_write('') - call mpas_log_write('') - call mpas_log_write('Output from ''git describe --dirty'': '//trim(domain % core % git_version)) - call mpas_log_write('') - call mpas_log_write('Compile-time options:') - call mpas_log_write(' Build target: '//trim(domain % core % build_target)) - call mpas_log_write(' OpenMP support: ' // & -#ifdef MPAS_OPENMP - 'yes') -#else - 'no') -#endif - call mpas_log_write(' OpenACC support: ' // & -#ifdef MPAS_OPENACC - 'yes') -#else - 'no') -#endif - call mpas_log_write(' Default real precision: ' // & -#ifdef SINGLE_PRECISION - 'single') -#else - 'double') -#endif - call mpas_log_write(' Compiler flags: ' // & -#ifdef MPAS_DEBUG - 'debug') -#else - 'optimize') -#endif - call mpas_log_write(' I/O layer: ' // & -#ifdef MPAS_PIO_SUPPORT -#ifdef USE_PIO2 - 'PIO 2.x') -#else - 'PIO 1.x') -#endif -#else - 'SMIOL') -#endif - call mpas_log_write('') - call mpas_log_write('Run-time settings:') - call mpas_log_write(' MPI task count: $i', intArgs=[domain % dminfo % nprocs]) -#ifdef MPAS_OPENMP - call mpas_log_write(' OpenMP max threads: $i', intArgs=[mpas_threading_get_max_threads()]) -#endif - call mpas_log_write('') + call mpas_framework_report_settings(domain) end function atm_setup_log!}}} @@ -734,6 +742,8 @@ end function atm_allocate_scalars #include "define_packages.inc" +#include "setup_packages.inc" + #include "structs_and_variables.inc" #include "namelist_call.inc" diff --git a/src/core_atmosphere/mpas_atm_halos.F b/src/core_atmosphere/mpas_atm_halos.F index 7c0505327..9d3848b4a 100644 --- a/src/core_atmosphere/mpas_atm_halos.F +++ b/src/core_atmosphere/mpas_atm_halos.F @@ -26,7 +26,7 @@ subroutine halo_exchange_routine(domain, halo_group, ierr) end subroutine halo_exchange_routine end interface - character(len=StrKIND), pointer, private :: config_halo_exch_method +! character(len=StrKIND), pointer, private :: config_halo_exch_method procedure (halo_exchange_routine), pointer :: exchange_halo_group @@ -56,9 +56,14 @@ subroutine atm_build_halo_groups(domain, ierr) use mpas_halo, only : mpas_halo_init, mpas_halo_exch_group_create, mpas_halo_exch_group_add_field, & mpas_halo_exch_group_complete, mpas_halo_exch_group_full_halo_exch + ! Arguments type (domain_type), intent(inout) :: domain integer, intent(inout) :: ierr + ! Local variables + character(len=StrKIND), pointer :: config_halo_exch_method + + ! ! Determine from the namelist option config_halo_exch_method which halo exchange method to employ ! @@ -174,16 +179,20 @@ subroutine atm_build_halo_groups(domain, ierr) call mpas_dmpar_exch_group_add_field(domain, 'physics:cuten', 'rucuten', timeLevel=1, haloLayers=(/1,2/)) call mpas_dmpar_exch_group_add_field(domain, 'physics:cuten', 'rvcuten', timeLevel=1, haloLayers=(/1,2/)) !-srf + !umcl;vmcl <==> diag call mpas_dmpar_exch_group_create(domain, 'physics:coldpool') call mpas_dmpar_exch_group_add_field(domain, 'physics:coldpool' , 'umcl', timeLevel=1, haloLayers=(/1,2/)) call mpas_dmpar_exch_group_add_field(domain, 'physics:coldpool' , 'vmcl', timeLevel=1, haloLayers=(/1,2/)) - + !sigma_deep <==> diag_physics + call mpas_dmpar_exch_group_create(domain, 'physics:sigdiagten') + call mpas_dmpar_exch_group_add_field(domain, 'physics:sigdiagten' , 'sigma_deep', timeLevel=1, haloLayers=(/1,2/)) + !sigma_deep <==> tend_physics call mpas_dmpar_exch_group_create(domain, 'physics:sub3d_cuten') - call mpas_dmpar_exch_group_add_field(domain, 'physics:sub3d_cuten', 'sigma_deep' , timeLevel=1, haloLayers=(/1/)) - call mpas_dmpar_exch_group_add_field(domain, 'physics:sub3d_cuten', 'sub3d_rucuten', timeLevel=1, haloLayers=(/1/)) - call mpas_dmpar_exch_group_add_field(domain, 'physics:sub3d_cuten', 'sub3d_rvcuten', timeLevel=1, haloLayers=(/1/)) - call mpas_dmpar_exch_group_add_field(domain, 'physics:sub3d_cuten', 'sub3d_rthcuten', timeLevel=1, haloLayers=(/1/)) - call mpas_dmpar_exch_group_add_field(domain, 'physics:sub3d_cuten', 'sub3d_rqvcuten', timeLevel=1, haloLayers=(/1/)) + !call mpas_dmpar_exch_group_add_field(domain, 'physics:sub3d_cuten', 'sigma_deep' , timeLevel=1, haloLayers=(/1,2/)) + call mpas_dmpar_exch_group_add_field(domain, 'physics:sub3d_cuten', 'sub3d_rucuten', timeLevel=1, haloLayers=(/1,2/)) + call mpas_dmpar_exch_group_add_field(domain, 'physics:sub3d_cuten', 'sub3d_rvcuten', timeLevel=1, haloLayers=(/1,2/)) + call mpas_dmpar_exch_group_add_field(domain, 'physics:sub3d_cuten', 'sub3d_rthcuten', timeLevel=1, haloLayers=(/1,2/)) + call mpas_dmpar_exch_group_add_field(domain, 'physics:sub3d_cuten', 'sub3d_rqvcuten', timeLevel=1, haloLayers=(/1,2/)) !-srf #endif @@ -323,13 +332,17 @@ subroutine atm_build_halo_groups(domain, ierr) call mpas_halo_exch_group_add_field(domain, 'physics:coldpool', 'umcl', timeLevel=1, haloLayers=(/1,2/)) call mpas_halo_exch_group_add_field(domain, 'physics:coldpool', 'vmcl', timeLevel=1, haloLayers=(/1,2/)) call mpas_halo_exch_group_complete(domain, 'physics:coldpool') + + call mpas_halo_exch_group_create(domain, 'physics:sigdiagten') + call mpas_halo_exch_group_add_field(domain, 'physics:sigdiagten', 'sigma_deep', timeLevel=1, haloLayers=(/1,2/)) + call mpas_halo_exch_group_complete(domain, 'physics:sigdiagten') call mpas_halo_exch_group_create(domain, 'physics:sub3d_cuten') - call mpas_halo_exch_group_add_field(domain, 'physics:sub3d_cuten', 'sigma_deep' , timeLevel=1, haloLayers=(/1/)) - call mpas_halo_exch_group_add_field(domain, 'physics:sub3d_cuten', 'sub3d_rucuten', timeLevel=1, haloLayers=(/1/)) - call mpas_halo_exch_group_add_field(domain, 'physics:sub3d_cuten', 'sub3d_rvcuten', timeLevel=1, haloLayers=(/1/)) - call mpas_halo_exch_group_add_field(domain, 'physics:sub3d_cuten', 'sub3d_rthcuten', timeLevel=1, haloLayers=(/1/)) - call mpas_halo_exch_group_add_field(domain, 'physics:sub3d_cuten', 'sub3d_rqvcuten', timeLevel=1, haloLayers=(/1/)) + !call mpas_halo_exch_group_add_field(domain, 'physics:sub3d_cuten', 'sigma_deep' , timeLevel=1, haloLayers=(/1,2/)) + call mpas_halo_exch_group_add_field(domain, 'physics:sub3d_cuten', 'sub3d_rucuten', timeLevel=1, haloLayers=(/1,2/)) + call mpas_halo_exch_group_add_field(domain, 'physics:sub3d_cuten', 'sub3d_rvcuten', timeLevel=1, haloLayers=(/1,2/)) + call mpas_halo_exch_group_add_field(domain, 'physics:sub3d_cuten', 'sub3d_rthcuten', timeLevel=1, haloLayers=(/1,2/)) + call mpas_halo_exch_group_add_field(domain, 'physics:sub3d_cuten', 'sub3d_rqvcuten', timeLevel=1, haloLayers=(/1,2/)) call mpas_halo_exch_group_complete(domain, 'physics:sub3d_cuten') !-srf #endif @@ -376,9 +389,15 @@ subroutine atm_destroy_halo_groups(domain, ierr) use mpas_dmpar, only : mpas_dmpar_exch_group_destroy use mpas_halo, only : mpas_halo_exch_group_destroy, mpas_halo_finalize + ! Arguments type (domain_type), intent(inout) :: domain integer, intent(inout) :: ierr + ! Local variables + character(len=StrKIND), pointer :: config_halo_exch_method + + + call mpas_pool_get_config(domain % blocklist % configs, 'config_halo_exch_method', config_halo_exch_method) if (trim(config_halo_exch_method) == 'mpas_dmpar') then ! @@ -416,7 +435,7 @@ subroutine atm_destroy_halo_groups(domain, ierr) !srf call mpas_dmpar_exch_group_destroy(domain, 'physics:coldpool') call mpas_dmpar_exch_group_destroy(domain, 'physics:sub3d_cuten') - + !srf #endif else if (trim(config_halo_exch_method) == 'mpas_halo') then @@ -456,6 +475,7 @@ subroutine atm_destroy_halo_groups(domain, ierr) !srf call mpas_halo_exch_group_destroy(domain, 'physics:coldpool') call mpas_halo_exch_group_destroy(domain, 'physics:sub3d_cuten') + !srf #endif diff --git a/src/core_atmosphere/physics/.gitignore b/src/core_atmosphere/physics/.gitignore index e0d3d1a00..6e4711d83 100644 --- a/src/core_atmosphere/physics/.gitignore +++ b/src/core_atmosphere/physics/.gitignore @@ -1,3 +1,5 @@ *.f90 physics_wrf/*.f90 physics_wrf/files/ +#physics_mmm - MONAN 2.0.0 change +UGWP diff --git a/src/core_atmosphere/physics/Makefile b/src/core_atmosphere/physics/Makefile index e176c7f74..93ff65731 100644 --- a/src/core_atmosphere/physics/Makefile +++ b/src/core_atmosphere/physics/Makefile @@ -4,13 +4,15 @@ ifeq ($(CORE),atmosphere) COREDEF = -Dmpas endif -all: lookup_tables core_physics_init core_physics_mmm core_physics_wrf core_physics_monan core_physics +all: + ./../tools/manage_externals/checkout_externals --externals ./../Externals.cfg + $(MAKE) lookup_tables core_physics_init core_physics_mmm core_physics_monan core_UGWP core_physics_wrf core_physics_noahmp core_physics dummy: echo "****** compiling physics ******" OBJS_init = \ - ccpp_kinds.o \ + ccpp_kind_types.o \ mpas_atmphys_constants.o \ mpas_atmphys_date_time.o \ mpas_atmphys_functions.o \ @@ -24,6 +26,7 @@ OBJS = \ mpas_atmphys_driver_convection.o \ mpas_atmphys_driver_gwdo.o \ mpas_atmphys_driver_lsm.o \ + mpas_atmphys_driver_lsm_noahmp.o \ mpas_atmphys_driver_microphysics.o \ mpas_atmphys_driver_oml.o \ mpas_atmphys_driver_pbl.o \ @@ -37,12 +40,15 @@ OBJS = \ mpas_atmphys_interface.o \ mpas_atmphys_landuse.o \ mpas_atmphys_lsm_noahinit.o \ + mpas_atmphys_lsm_noahmpinit.o \ + mpas_atmphys_lsm_noahmpfinalize.o \ mpas_atmphys_lsm_shared.o \ mpas_atmphys_manager.o \ mpas_atmphys_o3climatology.o \ mpas_atmphys_packages.o \ mpas_atmphys_rrtmg_lwinit.o \ mpas_atmphys_rrtmg_swinit.o \ + mpas_atmphys_sfc_diagnostics.o \ mpas_atmphys_todynamics.o \ mpas_atmphys_update_surface.o \ mpas_atmphys_update.o \ @@ -52,19 +58,32 @@ lookup_tables: ./checkout_data_files.sh core_physics_mmm: core_physics_init - (cd physics_mmm; $(MAKE) all) + (cd physics_mmm; $(MAKE) -f Makefile.mpas all) -core_physics_wrf: core_physics_init core_physics_mmm +core_UGWP: core_physics_init + (cd physics_noaa/UGWP; $(MAKE) all) + +core_physics_wrf: core_physics_init core_physics_mmm core_UGWP (cd physics_wrf; $(MAKE) all COREDEF="$(COREDEF)") +core_physics_noahmp: + (cd physics_noahmp/utility; $(MAKE) all COREDEF="$(COREDEF)") + (cd physics_noahmp/src; $(MAKE) all COREDEF="$(COREDEF)") + (cd physics_noahmp/drivers/mpas; $(MAKE) all COREDEF="$(COREDEF)") + core_physics_monan: core_physics_init (cd physics_monan; $(MAKE) all COREDEF="$(COREDEF)") + core_physics_init: $(OBJS_init) - ar -ru libphys.a $(OBJS_init) -core_physics: core_physics_wrf +core_physics: core_physics_wrf core_physics_noahmp ($(MAKE) phys_interface COREDEF="$(COREDEF)") - ar -ru libphys.a $(OBJS) + ar -ru libphys.a $(OBJS_init) $(OBJS) + ($(MAKE) -C ./physics_mmm -f Makefile.mpas physics_mmm_lib) + ($(MAKE) -C ./physics_wrf physics_wrf_lib) + ($(MAKE) -C ./physics_noahmp/drivers/mpas driver_lib) + ($(MAKE) -C ./physics_noahmp/src src_lib) + ($(MAKE) -C ./physics_noahmp/utility utility_lib) phys_interface: $(OBJS) @@ -82,6 +101,7 @@ mpas_atmphys_driver.o: \ mpas_atmphys_driver_convection.o \ mpas_atmphys_driver_gwdo.o \ mpas_atmphys_driver_lsm.o \ + mpas_atmphys_driver_lsm_noahmp.o \ mpas_atmphys_driver_pbl.o \ mpas_atmphys_driver_radiation_lw.o \ mpas_atmphys_driver_radiation_sw.o \ @@ -90,6 +110,7 @@ mpas_atmphys_driver.o: \ mpas_atmphys_driver_oml.o \ mpas_atmphys_constants.o \ mpas_atmphys_interface.o \ + mpas_atmphys_sfc_diagnostics.o \ mpas_atmphys_update.o \ mpas_atmphys_vars.o @@ -103,7 +124,8 @@ mpas_atmphys_driver_convection.o: \ mpas_atmphys_vars.o mpas_atmphys_driver_gwdo.o: \ - mpas_atmphys_vars.o + mpas_atmphys_vars.o \ + mpas_atmphys_manager.o mpas_atmphys_driver_lsm.o: \ mpas_atmphys_constants.o \ @@ -111,6 +133,11 @@ mpas_atmphys_driver_lsm.o: \ mpas_atmphys_lsm_noahinit.o \ mpas_atmphys_vars.o +mpas_atmphys_driver_lsm_noahmp.o: \ + mpas_atmphys_constants.o \ + mpas_atmphys_manager.o \ + mpas_atmphys_vars.o + mpas_atmphys_driver_microphysics.o: \ mpas_atmphys_constants.o \ mpas_atmphys_init_microphysics.o \ @@ -141,10 +168,18 @@ mpas_atmphys_driver_radiation_sw.o: \ mpas_atmphys_rrtmg_swinit.o \ mpas_atmphys_vars.o +mpas_atmphys_driver_seaice.o: \ + mpas_atmphys_constants.o \ + mpas_atmphys_lsm_shared.o \ + mpas_atmphys_vars.o + mpas_atmphys_driver_sfclayer.o: \ mpas_atmphys_constants.o \ mpas_atmphys_vars.o +mpas_atmphys_finalize.o: \ + mpas_atmphys_lsm_noahmpfinalize.o + mpas_atmphys_init.o: \ mpas_atmphys_driver_convection.o \ mpas_atmphys_driver_lsm.o \ @@ -153,6 +188,7 @@ mpas_atmphys_init.o: \ mpas_atmphys_driver_radiation_lw.o \ mpas_atmphys_driver_radiation_sw.o \ mpas_atmphys_driver_sfclayer.o \ + mpas_atmphys_lsm_noahmpinit.o \ mpas_atmphys_landuse.o \ mpas_atmphys_o3climatology.o \ mpas_atmphys_vars.o @@ -169,6 +205,13 @@ mpas_atmphys_lsm_noahinit.o: \ mpas_atmphys_constants.o \ mpas_atmphys_utilities.o +mpas_atmphys_lsm_noahmpinit.o: \ + mpas_atmphys_utilities.o \ + mpas_atmphys_vars.o + +mpas_atmphys_lsm_noahmpfinalize.o : \ + mpas_atmphys_vars.o + mpas_atmphys_manager.o: \ mpas_atmphys_constants.o \ mpas_atmphys_o3climatology.o \ @@ -189,9 +232,8 @@ mpas_atmphys_rrtmg_swinit.o: \ mpas_atmphys_constants.o \ mpas_atmphys_utilities.o -mpas_atmphys_driver_seaice.o: \ +mpas_atmphys_sfc_diagnostics.o: \ mpas_atmphys_constants.o \ - mpas_atmphys_lsm_shared.o \ mpas_atmphys_vars.o mpas_atmphys_todynamics.o: \ @@ -210,8 +252,12 @@ mpas_atmphys_update.o: \ clean: $(RM) *.o *.mod *.f90 libphys.a ( cd physics_wrf; $(MAKE) clean ) - ( cd physics_mmm; $(MAKE) clean ) + ( if [ -d physics_mmm ]; then cd physics_mmm; $(MAKE) -f Makefile.mpas clean; fi; ) + ( cd physics_noahmp/drivers/mpas; $(MAKE) clean ) + ( cd physics_noahmp/src; $(MAKE) clean ) + ( cd physics_noahmp/utility; $(MAKE) clean ) ( cd physics_monan; $(MAKE) clean ) + ( if [ -d physics_noaa/UGWP ]; then cd physics_noaa/UGWP; $(MAKE) clean; fi ) @# Certain systems with intel compilers generate *.i files @# This removes them during the clean process $(RM) *.i @@ -220,7 +266,7 @@ clean: $(RM) $@ $*.mod ifeq "$(GEN_F90)" "true" $(CPP) $(CPPFLAGS) $(COREDEF) $(HYDROSTATIC) $(CPPINCLUDES) $< > $*.f90 - $(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES) -I./physics_mmm -I./physics_wrf -I./physics_monan -I.. -I../../framework -I../../external/esmf_time_f90 + $(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES) -I./physics_mmm -I./physics_wrf -I./physics_monan -I./physics_noahmp -I./physics_noahmp/utility -I./physics_noahmp/drivers/mpas -I./physics_noahmp/src -I.. -I../../framework -I../../external/esmf_time_f90 else - $(FC) $(CPPFLAGS) $(COREDEF) $(HYDROSATIC) $(FFLAGS) -c $*.F $(CPPINCLUDES) $(FCINCLUDES) -I./physics_mmm -I./physics_wrf -I./physics_monan -I.. -I../../framework -I../../external/esmf_time_f90 + $(FC) $(CPPFLAGS) $(COREDEF) $(HYDROSATIC) $(FFLAGS) -c $*.F $(CPPINCLUDES) $(FCINCLUDES) -I./physics_mmm -I./physics_wrf -I./physics_monan -I./physics_noahmp -I./physics_noahmp/utility -I./physics_noahmp/drivers/mpas -I./physics_noahmp/src -I./physics_noaa/UGWP -I.. -I../../framework -I../../external/esmf_time_f90 endif diff --git a/src/core_atmosphere/physics/Registry_noahmp.xml b/src/core_atmosphere/physics/Registry_noahmp.xml new file mode 100644 index 000000000..89d980f72 --- /dev/null +++ b/src/core_atmosphere/physics/Registry_noahmp.xml @@ -0,0 +1,630 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/src/core_atmosphere/physics/ccpp_kind_types.F b/src/core_atmosphere/physics/ccpp_kind_types.F new file mode 100644 index 000000000..cdc75ccfa --- /dev/null +++ b/src/core_atmosphere/physics/ccpp_kind_types.F @@ -0,0 +1,4 @@ +module ccpp_kind_types + use mpas_kind_types,only: kind_phys => RKIND, kind_phys8 => R8KIND + contains +end module ccpp_kind_types diff --git a/src/core_atmosphere/physics/ccpp_kinds.F b/src/core_atmosphere/physics/ccpp_kinds.F deleted file mode 100644 index af633a84e..000000000 --- a/src/core_atmosphere/physics/ccpp_kinds.F +++ /dev/null @@ -1,4 +0,0 @@ -module ccpp_kinds - use mpas_kind_types,only: kind_phys => RKIND - contains -end module ccpp_kinds diff --git a/src/core_atmosphere/physics/checkout_data_files.sh b/src/core_atmosphere/physics/checkout_data_files.sh index 55043fee7..b5ad45bce 100755 --- a/src/core_atmosphere/physics/checkout_data_files.sh +++ b/src/core_atmosphere/physics/checkout_data_files.sh @@ -23,7 +23,7 @@ ################################################################################ -mpas_vers="8.0" +mpas_vers="8.2" github_org="MPAS-Dev" # GitHub organization where the MPAS-Data repository is found. # For physics development, it can be helpful for a developer diff --git a/src/core_atmosphere/physics/mpas_atmphys_control.F b/src/core_atmosphere/physics/mpas_atmphys_control.F index e45ac699a..bcdacad74 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_control.F +++ b/src/core_atmosphere/physics/mpas_atmphys_control.F @@ -72,10 +72,17 @@ module mpas_atmphys_control ! * modified logic in subroutine physics_tables_init so that the Thompson microphysics tables are read in each ! MPI task. ! Laura D. Fowler (laura@ucar.edu) / 2016-12-30. +! * added the option mp_thompson_aerosols. +! Laura D. Fowler (laura@ucar.edu) / 2018-01-31. ! * added the option sf_monin_obukhov_rev to run the revised surface layer scheme with the YSU PBL scheme. ! Laura D. Fowler (laura@ucar.edu) / 2023-05-15. ! * replaced the option "noah" with "sf_noah" to run the NOAH land surface scheme. ! Laura D. Fowler (laura@ucar.edu) / 2022-02-18. +! * added the option "sf_noahmp" to run the NOAH-MP land surface scheme. +! Laura D. Fowler (laura@ucar.edu) / 2022-07-15. +! * in the mesoscale_reference suite, replaced the MM5 surface layer scheme with the MM5 revised surface layer +! scheme as the default option for config_sfclayer_scheme. +! Laura D. Fowler (laura@ucar.edu) / 2024-06-18. contains @@ -130,7 +137,7 @@ subroutine physics_namelist_check(configs) if (trim(config_radt_lw_scheme) == 'suite') config_radt_lw_scheme = 'rrtmg_lw' if (trim(config_radt_sw_scheme) == 'suite') config_radt_sw_scheme = 'rrtmg_sw' if (trim(config_radt_cld_scheme) == 'suite') config_radt_cld_scheme = 'cld_fraction' - if (trim(config_sfclayer_scheme) == 'suite') config_sfclayer_scheme = 'sf_monin_obukhov' + if (trim(config_sfclayer_scheme) == 'suite') config_sfclayer_scheme = 'sf_monin_obukhov_rev' if (trim(config_lsm_scheme) == 'suite') config_lsm_scheme = 'sf_noah' else if (trim(config_physics_suite) == 'convection_permitting') then @@ -168,6 +175,7 @@ subroutine physics_namelist_check(configs) if (trim(config_radt_cld_scheme) == 'suite') config_radt_cld_scheme = 'cld_fraction_monan' if (trim(config_sfclayer_scheme) == 'suite') config_sfclayer_scheme = 'sf_mynn' if (trim(config_lsm_scheme) == 'suite') config_lsm_scheme = 'sf_noah' + else if (trim(config_physics_suite) == 'none') then if (trim(config_microp_scheme) == 'suite') config_microp_scheme = 'off' @@ -189,12 +197,13 @@ subroutine physics_namelist_check(configs) end if !cloud microphysics scheme: - if(.not. (config_microp_scheme .eq. 'off' .or. & - config_microp_scheme .eq. 'mp_kessler' .or. & - config_microp_scheme .eq. 'mp_thompson' .or. & + if(.not. (config_microp_scheme .eq. 'off' .or. & + config_microp_scheme .eq. 'mp_kessler' .or. & + config_microp_scheme .eq. 'mp_thompson' .or. & + config_microp_scheme .eq. 'mp_thompson_aerosols' .or. & config_microp_scheme .eq. 'mp_wsm6')) then - write(mpas_err_message,'(A,A10)') 'illegal value for config_microp_scheme:', & + write(mpas_err_message,'(A,A20)') 'illegal value for config_microp_scheme:', & trim(config_microp_scheme) call physics_error_fatal(mpas_err_message) @@ -208,7 +217,7 @@ subroutine physics_namelist_check(configs) config_convection_scheme .eq. 'cu_tiedtke' .or. & config_convection_scheme .eq. 'cu_ntiedtke')) then - write(mpas_err_message,'(A,A10)') 'illegal value for config_convection_scheme: ', & + write(mpas_err_message,'(A,A20)') 'illegal value for config_convection_scheme: ', & trim(config_convection_scheme) call physics_error_fatal(mpas_err_message) @@ -219,7 +228,7 @@ subroutine physics_namelist_check(configs) config_pbl_scheme .eq. 'bl_mynn' .or. & config_pbl_scheme .eq. 'bl_ysu')) then - write(mpas_err_message,'(A,A10)') 'illegal value for pbl_scheme: ', & + write(mpas_err_message,'(A,A20)') 'illegal value for pbl_scheme: ', & trim(config_pbl_scheme) call physics_error_fatal(mpas_err_message) @@ -227,9 +236,10 @@ subroutine physics_namelist_check(configs) !gravity wave drag over orography scheme: if(.not. (config_gwdo_scheme .eq. 'off' .or. & - config_gwdo_scheme .eq. 'bl_ysu_gwdo')) then + config_gwdo_scheme .eq. 'bl_ysu_gwdo' .or. & + config_gwdo_scheme .eq. 'bl_ugwp_gwdo')) then - write(mpas_err_message,'(A,A10)') 'illegal value for gwdo_scheme: ', & + write(mpas_err_message,'(A,A20)') 'illegal value for gwdo_scheme: ', & trim(config_gwdo_scheme) call physics_error_fatal(mpas_err_message) @@ -240,7 +250,7 @@ subroutine physics_namelist_check(configs) config_radt_lw_scheme .eq. 'cam_lw' .or. & config_radt_lw_scheme .eq. 'rrtmg_lw')) then - write(mpas_err_message,'(A,A10)') 'illegal value for longwave radiation scheme: ', & + write(mpas_err_message,'(A,A20)') 'illegal value for longwave radiation scheme: ', & trim(config_radt_lw_scheme) call physics_error_fatal(mpas_err_message) @@ -251,7 +261,7 @@ subroutine physics_namelist_check(configs) config_radt_sw_scheme .eq. 'cam_sw' .or. & config_radt_sw_scheme .eq. 'rrtmg_sw')) then - write(mpas_err_message,'(A,A10)') 'illegal value for shortwave radiation _scheme: ', & + write(mpas_err_message,'(A,A20)') 'illegal value for shortwave radiation _scheme: ', & trim(config_radt_sw_scheme) call physics_error_fatal(mpas_err_message) @@ -261,10 +271,10 @@ subroutine physics_namelist_check(configs) if(.not. (config_radt_cld_scheme .eq. 'off' .or. & config_radt_cld_scheme .eq. 'cld_incidence' .or. & config_radt_cld_scheme .eq. 'cld_fraction' .or. & - config_radt_cld_scheme .eq. 'cld_fraction_thompson' .or. & + config_radt_cld_scheme .eq. 'cld_fraction_thompson'.or. & config_radt_cld_scheme .eq. 'cld_fraction_monan')) then - write(mpas_err_message,'(A,A10)') 'illegal value for calculation of cloud fraction: ', & + write(mpas_err_message,'(A,A20)') 'illegal value for calculation of cloud fraction: ', & trim(config_radt_cld_scheme) call physics_error_fatal(mpas_err_message) @@ -273,10 +283,10 @@ subroutine physics_namelist_check(configs) (config_radt_sw_scheme.ne.'off' .and. config_radt_cld_scheme.eq.'off')) then call mpas_log_write('') - write(mpas_err_message,'(A,A10)') & + write(mpas_err_message,'(A,A20)') & ' config_radt_cld_scheme is not set for radiation calculation' call physics_message(mpas_err_message) - write(mpas_err_message,'(A,A10)') & + write(mpas_err_message,'(A,A20)') & ' switch calculation of cloud fraction to config_radt_cld_scheme = cld_incidence' call physics_message(mpas_err_message) config_radt_cld_scheme = "cld_incidence" @@ -289,7 +299,7 @@ subroutine physics_namelist_check(configs) config_sfclayer_scheme .eq. 'sf_monin_obukhov' .or. & config_sfclayer_scheme .eq. 'sf_monin_obukhov_rev')) then - write(mpas_err_message,'(A,A10)') 'illegal value for surface layer scheme: ', & + write(mpas_err_message,'(A,A20)') 'illegal value for surface layer scheme: ', & trim(config_sfclayer_scheme) call physics_error_fatal(mpas_err_message) else @@ -298,7 +308,7 @@ subroutine physics_namelist_check(configs) elseif(config_pbl_scheme == 'bl_ysu') then if(config_sfclayer_scheme /= 'sf_monin_obukhov' .and. & config_sfclayer_scheme /= 'sf_monin_obukhov_rev') then - write(mpas_err_message,'(A,A10)') 'wrong choice for surface layer scheme with YSU PBL: ', & + write(mpas_err_message,'(A,A20)') 'wrong choice for surface layer scheme with YSU PBL: ', & trim(config_sfclayer_scheme) call physics_error_fatal(mpas_err_message) endif @@ -312,10 +322,11 @@ subroutine physics_namelist_check(configs) call physics_error_fatal('land surface scheme: ' // & 'set config_sfclayer_scheme different than off') - elseif(.not. (config_lsm_scheme .eq. 'off ' .or. & - config_lsm_scheme .eq. 'sf_noah')) then + elseif(.not. (config_lsm_scheme .eq. 'off ' .or. & + config_lsm_scheme .eq. 'sf_noah' .or. & + config_lsm_scheme .eq. 'sf_noahmp')) then - write(mpas_err_message,'(A,A10)') 'illegal value for land surface scheme: ', & + write(mpas_err_message,'(A,A20)') 'illegal value for land surface scheme: ', & trim(config_lsm_scheme) call physics_error_fatal(mpas_err_message) @@ -384,7 +395,7 @@ subroutine physics_registry_init(mesh,configs,sfc_input) lsm_select: select case(trim(config_lsm_scheme)) - case("sf_noah") + case("sf_noah","sf_noahmp") !initialize the thickness of the soil layers for the Noah scheme: do iCell = 1, nCells dzs(1,iCell) = 0.10_RKIND @@ -423,7 +434,8 @@ subroutine physics_tables_init(dminfo,configs) if(dminfo % my_proc_id == IO_NODE) then call mpas_pool_get_config(configs,'config_microp_scheme',config_microp_scheme) - if(config_microp_scheme /= "mp_thompson") return + if(config_microp_scheme /= "mp_thompson" .or. & + config_microp_scheme /= "mp_thompson_aerosols") return l_qr_acr_qg = .false. l_qr_acr_qs = .false. @@ -495,7 +507,7 @@ subroutine physics_compatibility_check(dminfo, blockList, streamManager, ierr) call mpas_pool_get_config(blocklist % configs, 'config_gwdo_scheme', gwdo_scheme) - if (trim(gwdo_scheme) /= 'off') then + if (trim(gwdo_scheme) == 'bl_ysu_gwdo') then maxvar2d_local = -huge(maxvar2d_local) block => blockList do while (associated(block)) @@ -529,7 +541,7 @@ subroutine physics_compatibility_check(dminfo, blockList, streamManager, ierr) if (maxvar2d_global <= 0.0_RKIND .and. iall_water /= 1) 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,', & + call mpas_log_write('The YSU 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) diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver.F b/src/core_atmosphere/physics/mpas_atmphys_driver.F index 0bf7a4897..26eff1738 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_driver.F +++ b/src/core_atmosphere/physics/mpas_atmphys_driver.F @@ -14,6 +14,7 @@ module mpas_atmphys_driver use mpas_atmphys_driver_convection use mpas_atmphys_driver_gwdo use mpas_atmphys_driver_lsm + use mpas_atmphys_driver_lsm_noahmp use mpas_atmphys_driver_pbl use mpas_atmphys_driver_radiation_lw use mpas_atmphys_driver_radiation_sw @@ -22,6 +23,7 @@ module mpas_atmphys_driver use mpas_atmphys_driver_oml use mpas_atmphys_constants use mpas_atmphys_interface + use mpas_atmphys_sfc_diagnostics,only: atmphys_sfc_diagnostics use mpas_atmphys_update use mpas_atmphys_vars, only: l_camlw,l_conv,l_radtlw,l_radtsw,kts,kte,dt_pbl use mpas_timer @@ -115,9 +117,12 @@ end subroutine halo_exchange_routine ! * modified call to driver_cloudiness to accomodate the calculation of the cloud fraction with the Thompson ! cloud microphysics scheme. ! Laura D. Fowler (laura@ucar.edu) / 2016-06-04. +! * added call to the Noah-MP land surface scheme. +! Laura D. Fowler (laura@ucar.edu) / 2024-03-11. ! * Added call to boundary layer mixing for 'extras' scalars (see routine driver_pbl_scalars) ! Saulo R. Freitas (saulo.freitas@inpe.br) / 2024-09-19 + contains @@ -128,19 +133,23 @@ subroutine physics_driver(domain,itimestep,xtime_s,exchange_halo_group) !input arguments: integer,intent(in):: itimestep real(kind=RKIND),intent(in):: xtime_s + procedure (halo_exchange_routine) :: exchange_halo_group !inout arguments: type(domain_type),intent(inout):: domain !local pointers: - type(mpas_pool_type),pointer:: configs, & - mesh, & - state, & - diag, & - diag_physics, & - tend_physics, & - atm_input, & + type(mpas_pool_type),pointer:: configs, & + mesh, & + state, & + diag, & + diag_physics, & + diag_physics_noahmp, & + output_noahmp, & + tend_physics, & + atm_input, & + ngw_input, & sfc_input logical,pointer:: config_frac_seaice @@ -194,18 +203,21 @@ subroutine physics_driver(domain,itimestep,xtime_s,exchange_halo_group) 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_subpool(block%structs,'diag' ,diag ) - call mpas_pool_get_subpool(block%structs,'diag_physics',diag_physics) - call mpas_pool_get_subpool(block%structs,'atm_input' ,atm_input ) - call mpas_pool_get_subpool(block%structs,'sfc_input' ,sfc_input ) - call mpas_pool_get_subpool(block%structs,'tend_physics',tend_physics) + 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,'diag' ,diag ) + call mpas_pool_get_subpool(block%structs,'diag_physics' ,diag_physics ) + call mpas_pool_get_subpool(block%structs,'diag_physics_noahmp',diag_physics_noahmp) + call mpas_pool_get_subpool(block%structs,'output_noahmp' ,output_noahmp ) + call mpas_pool_get_subpool(block%structs,'atm_input' ,atm_input ) + call mpas_pool_get_subpool(block%structs,'sfc_input' ,sfc_input ) + call mpas_pool_get_subpool(block%structs,'ngw_input' ,ngw_input ) + call mpas_pool_get_subpool(block%structs,'tend_physics' ,tend_physics ) - call mpas_pool_get_dimension(block % dimensions, 'nThreads', nThreads) + 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) + call mpas_pool_get_dimension(block%dimensions,'cellSolveThreadStart',cellSolveThreadStart) + call mpas_pool_get_dimension(block%dimensions,'cellSolveThreadEnd',cellSolveThreadEnd) !allocate arrays shared by all physics parameterizations: call allocate_forall_physics(block%configs) @@ -216,7 +228,7 @@ subroutine physics_driver(domain,itimestep,xtime_s,exchange_halo_group) !$OMP PARALLEL DO do thread=1,nThreads call MPAS_to_physics(block%configs,mesh,state,time_lev,diag,diag_physics, & - cellSolveThreadStart(thread), cellSolveThreadEnd(thread)) + cellSolveThreadStart(thread),cellSolveThreadEnd(thread)) end do !$OMP END PARALLEL DO @@ -239,7 +251,7 @@ subroutine physics_driver(domain,itimestep,xtime_s,exchange_halo_group) do thread=1,nThreads call driver_radiation_sw(itimestep,block%configs,mesh,state,time_lev,diag_physics, & atm_input,sfc_input,tend_physics,xtime_s, & - cellSolveThreadStart(thread), cellSolveThreadEnd(thread)) + cellSolveThreadStart(thread),cellSolveThreadEnd(thread)) end do !$OMP END PARALLEL DO endif @@ -252,7 +264,7 @@ subroutine physics_driver(domain,itimestep,xtime_s,exchange_halo_group) do thread=1,nThreads call driver_radiation_lw(xtime_s,block%configs,mesh,state,time_lev,diag_physics, & atm_input,sfc_input,tend_physics, & - cellSolveThreadStart(thread), cellSolveThreadEnd(thread)) + cellSolveThreadStart(thread),cellSolveThreadEnd(thread)) end do !$OMP END PARALLEL DO endif @@ -262,7 +274,7 @@ subroutine physics_driver(domain,itimestep,xtime_s,exchange_halo_group) !$OMP PARALLEL DO do thread=1,nThreads call update_radiation_diagnostics(block%configs,mesh,diag_physics, & - cellSolveThreadStart(thread), cellSolveThreadEnd(thread)) + cellSolveThreadStart(thread),cellSolveThreadEnd(thread)) end do !$OMP END PARALLEL DO endif @@ -279,7 +291,7 @@ subroutine physics_driver(domain,itimestep,xtime_s,exchange_halo_group) !$OMP PARALLEL DO do thread=1,nThreads call driver_sfclayer(itimestep,block%configs,mesh,diag_physics,sfc_input, & - cellSolveThreadStart(thread), cellSolveThreadEnd(thread), & + cellSolveThreadStart(thread),cellSolveThreadEnd(thread), & state, time_lev) end do !$OMP END PARALLEL DO @@ -287,27 +299,43 @@ subroutine physics_driver(domain,itimestep,xtime_s,exchange_halo_group) endif !call to 1d ocean mixed-layer model - if(config_oml1d) call driver_oml1d(block%configs, mesh, diag, diag_physics, sfc_input) + if(config_oml1d) call driver_oml1d(block%configs,mesh,diag,diag_physics,sfc_input) !call to land-surface scheme: if(config_lsm_scheme .ne. 'off') then - call allocate_lsm + if(config_lsm_scheme == 'sf_noah') then + call allocate_lsm !$OMP PARALLEL DO - do thread=1,nThreads - call driver_lsm(itimestep,block%configs,mesh,diag_physics,sfc_input, & - cellSolveThreadStart(thread), cellSolveThreadEnd(thread)) - end do + do thread=1,nThreads + call driver_lsm(itimestep,block%configs,mesh,diag_physics,sfc_input, & + cellSolveThreadStart(thread),cellSolveThreadEnd(thread)) + end do !$OMP END PARALLEL DO call deallocate_lsm - call allocate_seaice + elseif(config_lsm_scheme == 'sf_noahmp') then + do thread=1,nThreads + call driver_lsm_noahmp(block%configs,mesh,state,time_lev,diag,diag_physics, & + diag_physics_noahmp,output_noahmp,sfc_input,itimestep, & + cellSolveThreadStart(thread),cellSolveThreadEnd(thread)) + enddo + endif + + call allocate_seaice(block%configs) !$OMP PARALLEL DO do thread=1,nThreads call driver_seaice(block%configs,diag_physics,sfc_input, & cellSolveThreadStart(thread),cellSolveThreadEnd(thread)) enddo !$OMP END PARALLEL DO - call deallocate_seaice + call deallocate_seaice(block%configs) + +!$OMP PARALLEL DO + do thread=1,nThreads + call atmphys_sfc_diagnostics(block%configs,mesh,diag,diag_physics,sfc_input,output_noahmp, & + cellSolveThreadStart(thread),cellSolveThreadEnd(thread)) + enddo +!$OMP END PARALLEL DO endif !call to pbl schemes: @@ -328,14 +356,14 @@ subroutine physics_driver(domain,itimestep,xtime_s,exchange_halo_group) !call to gravity wave drag over orography scheme: if(config_gwdo_scheme .ne. 'off') then - call allocate_gwdo + call allocate_gwdo(block%configs) !$OMP PARALLEL DO do thread=1,nThreads - call driver_gwdo(itimestep,block%configs,mesh,sfc_input,diag_physics,tend_physics, & - cellSolveThreadStart(thread),cellSolveThreadEnd(thread)) + call driver_gwdo(itimestep,block%configs,mesh,sfc_input,ngw_input,diag_physics, & + tend_physics,cellSolveThreadStart(thread),cellSolveThreadEnd(thread)) end do !$OMP END PARALLEL DO - call deallocate_gwdo + call deallocate_gwdo(block%configs) endif !call to convection scheme: @@ -350,7 +378,7 @@ subroutine physics_driver(domain,itimestep,xtime_s,exchange_halo_group) !$OMP PARALLEL DO do thread=1,nThreads call driver_convection(itimestep,block%configs,mesh,sfc_input,diag_physics,tend_physics,diag,domain%dminfo, & - cellSolveThreadStart(thread), cellSolveThreadEnd(thread),exchange_halo_group,block) + cellSolveThreadStart(thread),cellSolveThreadEnd(thread),exchange_halo_group,block) end do !$OMP END PARALLEL DO call deallocate_convection(block%configs) diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_cloudiness.F b/src/core_atmosphere/physics/mpas_atmphys_driver_cloudiness.F index ee088ac3f..6b3e4e46a 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_driver_cloudiness.F +++ b/src/core_atmosphere/physics/mpas_atmphys_driver_cloudiness.F @@ -15,7 +15,7 @@ module mpas_atmphys_driver_cloudiness use mpas_atmphys_vars use module_mp_thompson_cldfra3 use module_mp_cldfra_cb, only: calc_cldfraction_monan - + implicit none private public:: allocate_cloudiness, & @@ -89,6 +89,7 @@ subroutine deallocate_cloudiness if(allocated(qcrad_p) ) deallocate(qcrad_p ) if(allocated(qirad_p) ) deallocate(qirad_p ) if(allocated(qsrad_p) ) deallocate(qsrad_p ) + if(allocated(zgrid_p) ) deallocate(zgrid_p ) if(allocated(kpbl_p) ) deallocate(kpbl_p ) if(allocated(rupmfxcu_p)) deallocate(rupmfxcu_p) diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_convection.F b/src/core_atmosphere/physics/mpas_atmphys_driver_convection.F index 2b9fdb75d..e59db4ff7 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_driver_convection.F +++ b/src/core_atmosphere/physics/mpas_atmphys_driver_convection.F @@ -114,7 +114,7 @@ end subroutine halo_exchange_routine ! Laura D. Fowler (laura@ucar.edu) / 2016-10-18. ! * since we removed the local variable convection_scheme from mpas_atmphys_vars.F, now defines convection_scheme ! as a pointer to config_convection_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2917-02-16. +! Laura D. Fowler (laura@ucar.edu) / 2017-02-16. ! * removed f_qv,f_qr,and f_qs in the calls to cu_tiedtke and cu_ntiedtke. removed f_qv and f_qc in the call to ! kf_eta_cps. ! Laura D. Fowler (laura@ucar.edu) / 2024-02-13. @@ -219,8 +219,8 @@ subroutine allocate_convection(configs) if(.not.allocated(rucuten_p) ) allocate(rucuten_p(ims:ime,kms:kme,jms:jme) ) if(.not.allocated(rvcuten_p) ) allocate(rvcuten_p(ims:ime,kms:kme,jms:jme) ) if(.not.allocated(rcnvcfcuten_p) ) allocate(rcnvcfcuten_p(ims:ime,kms:kme,jms:jme)) - if(.not.allocated(rbuoyxcuten_p) ) allocate(rbuoyxcuten_p(ims:ime,kms:kme,jms:jme)) - + if(.not.allocated(rbuoyxcuten_p) ) allocate(rbuoyxcuten_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(tkepbl_p) ) allocate(tkepbl_p (ims:ime,kms:kme,jms:jme) ) if(.not.allocated(elpbl_p) ) allocate(elpbl_p (ims:ime,kms:kme,jms:jme) ) if(.not.allocated(rupmfxcu_p) ) allocate(rupmfxcu_p(ims:ime,kms:kme,jms:jme) ) @@ -336,7 +336,7 @@ subroutine allocate_convection(configs) if(.not.allocated(area_p) ) allocate(area_p(ims:ime,jms:jme) ) if(.not.allocated(nca_p) ) allocate(nca_p(ims:ime,jms:jme) ) if(.not.allocated(cubot_p) ) allocate(cubot_p(ims:ime,jms:jme) ) - if(.not.allocated(cutop_p) ) allocate(cutop_p(ims:ime,jms:jme) ) + if(.not.allocated(cutop_p) ) allocate(cutop_p(ims:ime,jms:jme) ) if(.not.allocated(w0avg_p) ) allocate(w0avg_p(ims:ime,kms:kme,jms:jme) ) if(.not.allocated(rqrcuten_p) ) allocate(rqrcuten_p(ims:ime,kms:kme,jms:jme)) if(.not.allocated(rqscuten_p) ) allocate(rqscuten_p(ims:ime,kms:kme,jms:jme)) @@ -534,7 +534,7 @@ subroutine deallocate_convection(configs) if(allocated(area_p) ) deallocate(area_p ) if(allocated(nca_p) ) deallocate(nca_p ) if(allocated(cubot_p) ) deallocate(cubot_p ) - if(allocated(cutop_p) ) deallocate(cutop_p ) + if(allocated(cutop_p) ) deallocate(cutop_p ) if(allocated(w0avg_p) ) deallocate(w0avg_p ) if(allocated(rqrcuten_p) ) deallocate(rqrcuten_p ) if(allocated(rqscuten_p) ) deallocate(rqscuten_p ) @@ -727,28 +727,28 @@ subroutine driver_convection(itimestep,configs,mesh,sfc_input,diag_physics,tend_ kpbl = kpbl_p , tke_pbl = tkepbl_p , & turb_len_scale = elpbl_p , & buoyx = buoyx_p , cnvcf = cnvcf_p , & - rthblten = rthblten_p , rqvblten = rqvblten_p , & + rthblten = rthblten_p , rqvblten = rqvblten_p , & rthratenlw = rthratenlw_p , rthratensw = rthratensw_p , & - rthdyten = rthdynten_p , rqvdyten = rqvdynten_p , & + rthdyten = rthdynten_p , rqvdyten = rqvdynten_p , & raincv = raincv_p , conprr = pratec_p , & lightn_dens = lightn_dens_p , sigma_deep = sigma_deep_p , & - rthcuten = rthcuten_p , rqvcuten = rqvcuten_p , & + rthcuten = rthcuten_p , rqvcuten = rqvcuten_p , & rqccuten = rqccuten_p , rqicuten = rqicuten_p , & rucuten = rucuten_p , rvcuten = rvcuten_p , & rbuoyxcuten = rbuoyxcuten_p , rcnvcfcuten = rcnvcfcuten_p , & - sub3d_rthcuten = sub3d_rthcuten_p , sub3d_rqvcuten= sub3d_rqvcuten_p, & + sub3d_rthcuten = sub3d_rthcuten_p , sub3d_rqvcuten= sub3d_rqvcuten_p, & sub3d_rucuten = sub3d_rucuten_p , sub3d_rvcuten = sub3d_rvcuten_p , & rupmfxcu = rupmfxcu_p , rdnmfxcu = rdnmfxcu_p , & - rmfxdpcu = rmfxdpcu_p , rmfxdncu = rmfxdncu_p , & + rmfxdpcu = rmfxdpcu_p , rmfxdncu = rmfxdncu_p , & rmfxmdcu = rmfxmdcu_p , & rmfxshcu = rmfxshcu_p , rtopdpcu = rtopdpcu_p , & rtopmdcu = rtopmdcu_p , rtopshcu = rtopshcu_p , & rbotdpcu = rbotdpcu_p , & - var2d1 = v2d1_p , var2d2 = v2d2_p , & + var2d1 = v2d1_p , var2d2 = v2d2_p , & var3d1 = v3d1_p , & ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , & ims = ims , ime = ime , jms = jms , jme = jme , kms = kds , kme = kme , & @@ -966,6 +966,7 @@ subroutine convection_from_MPAS(dt_dyn,configs,mesh,sfc_input,diag_physics,tend_ enddo enddo end if + convection_select: select case(convection_scheme) case ("cu_gf_monan") @@ -1245,7 +1246,8 @@ subroutine convection_from_MPAS(dt_dyn,configs,mesh,sfc_input,diag_physics,tend_ end subroutine convection_from_MPAS !================================================================================================================= - subroutine convection_to_MPAS(configs,mesh,diag_physics,tend_physics,its,ite,exchange_halo_group,block) + subroutine convection_to_MPAS(configs,mesh,diag_physics,tend_physics,its,ite,& + exchange_halo_group,block) !================================================================================================================= !input arguments: @@ -1314,6 +1316,7 @@ subroutine convection_to_MPAS(configs,mesh,diag_physics,tend_physics,its,ite,exc enddo convection_select: select case(convection_scheme) + case ("cu_gf_monan") call mpas_pool_get_array(diag_physics,'rmfxdpcu' ,rmfxdpcu ) call mpas_pool_get_array(diag_physics,'rmfxdncu' ,rmfxdncu ) @@ -1425,6 +1428,7 @@ subroutine convection_to_MPAS(configs,mesh,diag_physics,tend_physics,its,ite,exc !-- part 2: broadcast the subsidence tendencies call exchange_halo_group(block % domain, 'physics:sub3d_cuten') + call exchange_halo_group(block % domain, 'physics:sigdiagten') !-- part 3: spread the subsidence tendencies to the 1st neighboors call mpas_pool_get_array(mesh, 'cellsOnCell', cellsOnCell) @@ -1679,7 +1683,9 @@ subroutine update_convection_step2(configs,mesh,sfc_input,diag_physics,tend_phys real(kind=RKIND),dimension(:),pointer:: wlpool,vcpool,u_gustfront,v_gustfront real(kind=RKIND),dimension(:),pointer:: dp_dens,sh_dens,cg_dens real(kind=RKIND),dimension(:),pointer:: acc_dp_dens,acc_sh_dens,acc_cg_dens + real(kind=RKIND),dimension(:),pointer:: hpbl +!local variables and arrays: real(kind=RKIND),dimension(:,:),pointer:: umcl,vmcl real(kind=RKIND),dimension(:,:),pointer:: rumcl real(kind=RKIND),dimension(:,:),pointer:: zgrid,rh @@ -1693,17 +1699,17 @@ subroutine update_convection_step2(configs,mesh,sfc_input,diag_physics,tend_phys !local variables and arrays for the 'cu_gf_monan': integer:: i,k,j,k_amb_wind real(kind=RKIND),parameter:: alp = 0.5 ! semi-implicit, 1=explicit - real(kind=RKIND),parameter:: tau_cloud_diss0 = 7.*60. ! seconds - real(kind=RKIND),parameter:: width = 1000. ! meters - real(kind=RKIND),parameter:: turncf = 2000. ! meters above local terrain + real(kind=RKIND),parameter:: tau_cloud_diss0 = 20.*60. ! seconds + real(kind=RKIND),parameter:: width = 400. ! meters real(kind=RKIND),parameter:: Kfr = 0.9 ! internal Froude number real(kind=RKIND),parameter:: epsx = 100. ! threshold real(kind=RKIND),parameter:: slope_pool = 45.*(3.1416/180.) ! using mean value of Reif et al 2020 real(kind=RKIND),parameter:: startlev = 1000. ! meters above local surface real(kind=RKIND),parameter:: endlev = 4000. ! meters above local surface - real(kind=RKIND):: vert_scale_diss,tau_cloud_diss,htopx,snk,src,tau_cp,denom + real(kind=RKIND):: vert_scale_diss,tau_cloud_diss,htopx,snk,src,tau_cp,denom,OneMinusRH,turncf real(kind=RKIND):: total_dz,H_env,gama,temp, rvap, press, qes, zlevel, dzrho, aux, MCL_speed + !----------------------------------------------------------------------------------------------------------------- call mpas_pool_get_config(configs,'config_bucket_rainc',bucket_rainc) @@ -1763,24 +1769,29 @@ subroutine update_convection_step2(configs,mesh,sfc_input,diag_physics,tend_phys call mpas_pool_get_array(sfc_input,'xland' ,xland ) call mpas_pool_get_array(mesh, 'zgrid' ,zgrid ) call mpas_pool_get_array(diag, 'relhum',rh )! pct + call mpas_pool_get_array(diag_physics,'hpbl' ,hpbl ) do i = its,ite htopx = zgrid(1,i) !- local terrain + turncf = hpbl(i) + htopx do k = kts,kte - !-- this goes from 1 to 0.1 as the height goes from the local surface height to the upper levels - vert_scale_diss = 1._RKIND/(1.5_RKIND+atan(2._RKIND*(zgrid(k,i) - htopx - turncf)/width))/3. - vert_scale_diss = max(min (vert_scale_diss,1.) , 0.15_RKIND) ! = 1. to turn off vertical variation + OneMinusRH = (1.0_RKIND - min(1.0_RKIND , 0.01_RKIND*rh(k,i))) ! must be in [0,1] + + !---- this goes from 1 to 0.1 as the height goes from the local surface height to the upper levels + vert_scale_diss = 1._RKIND/(1.5_RKIND+atan(2._RKIND*(zgrid(k,i) - turncf)/width)) + vert_scale_diss = max(min (vert_scale_diss,1._RKIND), 0.40_RKIND) ! = 1. to turn off vertical variation tau_cloud_diss = tau_cloud_diss0/vert_scale_diss !---- sink term for cloud fraction - snk = dt_dyn * (1._RKIND/tau_cloud_diss) * (1.0_RKIND - 0.01_RKIND*rh(k,i)) * abs(cnvcf(k,i)) + snk = dt_dyn * (1._RKIND/tau_cloud_diss) * OneMinusRH * abs(cnvcf(k,i)) !---- source term for cloud fraction src = dt_dyn * rcnvcfcuten(k,i) - !- using semi-impl formulation; - !- f(t+dt) = ( f(t) - (dt/tau)* (alp* f(t)) ] / (1+(dt/tau)* (1-alp)) - denom = 1._RKIND + (1._RKIND-alp)*src + (1.-alp)*(1._RKIND-0.01_RKIND*rh(k,i))*dt_dyn/tau_cloud_diss + !---- using semi-impl formulation; + !---- f(t+dt) = [ f(t) - (dt/tau)* (alp* f(t)) ] / (1+(dt/tau)* (1-alp)) + denom = 1._RKIND + (1._RKIND-alp)*src + (1._RKIND-alp)*OneMinusRH*dt_dyn/tau_cloud_diss + !---- source term for cloud fraction !---- update cnvcf cnvcf(k,i) = ( cnvcf(k,i) - alp*snk + (1._RKIND-alp*cnvcf(k,i))*src )/denom @@ -1964,6 +1975,7 @@ subroutine update_convection_step2(configs,mesh,sfc_input,diag_physics,tend_phys case default end select convection_select + end subroutine update_convection_step2 !================================================================================================================= !-- alternative routine for "tend_toEdges" --! diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_gwdo.F b/src/core_atmosphere/physics/mpas_atmphys_driver_gwdo.F index 06bf5ef0e..a96ba7bf2 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_driver_gwdo.F +++ b/src/core_atmosphere/physics/mpas_atmphys_driver_gwdo.F @@ -13,9 +13,11 @@ module mpas_atmphys_driver_gwdo use mpas_atmphys_constants use mpas_atmphys_vars + use mpas_atmphys_manager,only: curr_julday !wrf physics: use module_bl_gwdo + use module_bl_ugwp_gwdo implicit none private @@ -62,77 +64,232 @@ module mpas_atmphys_driver_gwdo ! Laura D. Fowler (laura@ucar.edu) / 2019-01-30. ! * added the flags errmsg and errflg in the call to subroutine gwdo for compliance with the CCPP framework. ! Laura D. Fowler (laura@ucar.edu) / 2023-05-15. +! * added the NOAA UFS unified gravity wave drag scheme +! Michael D. Toy (michael.toy@noaa.gov) / 2024-10-21 contains !================================================================================================================= - subroutine allocate_gwdo + subroutine allocate_gwdo(configs) !================================================================================================================= + !input arguments: + type(mpas_pool_type),intent(in):: configs + + !local variables: + character(len=StrKIND),pointer:: gwdo_scheme + logical,pointer:: ugwp_diags,ngw_scheme + + call mpas_pool_get_config(configs,'config_gwdo_scheme',gwdo_scheme) + call mpas_pool_get_config(configs,'config_ugwp_diags',ugwp_diags) + call mpas_pool_get_config(configs,'config_ngw_scheme',ngw_scheme) + 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) ) - if(.not.allocated(oa1_p) ) allocate(oa1_p(ims:ime,jms:jme) ) - if(.not.allocated(oa2_p) ) allocate(oa2_p(ims:ime,jms:jme) ) - if(.not.allocated(oa3_p) ) allocate(oa3_p(ims:ime,jms:jme) ) - if(.not.allocated(oa4_p) ) allocate(oa4_p(ims:ime,jms:jme) ) - if(.not.allocated(ol1_p) ) allocate(ol1_p(ims:ime,jms:jme) ) - if(.not.allocated(ol2_p) ) allocate(ol2_p(ims:ime,jms:jme) ) - if(.not.allocated(ol3_p) ) allocate(ol3_p(ims:ime,jms:jme) ) - if(.not.allocated(ol4_p) ) allocate(ol4_p(ims:ime,jms:jme) ) if(.not.allocated(kpbl_p )) allocate(kpbl_p(ims:ime,jms:jme) ) if(.not.allocated(dusfcg_p)) allocate(dusfcg_p(ims:ime,jms:jme)) if(.not.allocated(dvsfcg_p)) allocate(dvsfcg_p(ims:ime,jms:jme)) - if(.not.allocated(dtaux3d_p)) allocate(dtaux3d_p(ims:ime,kms:kme,jms:jme)) if(.not.allocated(dtauy3d_p)) allocate(dtauy3d_p(ims:ime,kms:kme,jms:jme)) if(.not.allocated(rublten_p)) allocate(rublten_p(ims:ime,kms:kme,jms:jme)) if(.not.allocated(rvblten_p)) allocate(rvblten_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(rthblten_p)) allocate(rthblten_p(ims:ime,kms:kme,jms:jme)) + + gwdo_select: select case (trim(gwdo_scheme)) + + case("bl_ysu_gwdo") + if(.not.allocated(var2d_p) ) allocate(var2d_p(ims:ime,jms:jme) ) + if(.not.allocated(con_p) ) allocate(con_p(ims:ime,jms:jme) ) + if(.not.allocated(oa1_p) ) allocate(oa1_p(ims:ime,jms:jme) ) + if(.not.allocated(oa2_p) ) allocate(oa2_p(ims:ime,jms:jme) ) + if(.not.allocated(oa3_p) ) allocate(oa3_p(ims:ime,jms:jme) ) + if(.not.allocated(oa4_p) ) allocate(oa4_p(ims:ime,jms:jme) ) + if(.not.allocated(ol1_p) ) allocate(ol1_p(ims:ime,jms:jme) ) + if(.not.allocated(ol2_p) ) allocate(ol2_p(ims:ime,jms:jme) ) + if(.not.allocated(ol3_p) ) allocate(ol3_p(ims:ime,jms:jme) ) + if(.not.allocated(ol4_p) ) allocate(ol4_p(ims:ime,jms:jme) ) + + case("bl_ugwp_gwdo") + if(.not.allocated(var2dls_p) ) allocate(var2dls_p(ims:ime,jms:jme) ) + if(.not.allocated(conls_p) ) allocate(conls_p(ims:ime,jms:jme) ) + if(.not.allocated(oa1ls_p) ) allocate(oa1ls_p(ims:ime,jms:jme) ) + if(.not.allocated(oa2ls_p) ) allocate(oa2ls_p(ims:ime,jms:jme) ) + if(.not.allocated(oa3ls_p) ) allocate(oa3ls_p(ims:ime,jms:jme) ) + if(.not.allocated(oa4ls_p) ) allocate(oa4ls_p(ims:ime,jms:jme) ) + if(.not.allocated(ol1ls_p) ) allocate(ol1ls_p(ims:ime,jms:jme) ) + if(.not.allocated(ol2ls_p) ) allocate(ol2ls_p(ims:ime,jms:jme) ) + if(.not.allocated(ol3ls_p) ) allocate(ol3ls_p(ims:ime,jms:jme) ) + if(.not.allocated(ol4ls_p) ) allocate(ol4ls_p(ims:ime,jms:jme) ) + if(.not.allocated(var2dss_p) ) allocate(var2dss_p(ims:ime,jms:jme) ) + if(.not.allocated(conss_p) ) allocate(conss_p(ims:ime,jms:jme) ) + if(.not.allocated(oa1ss_p) ) allocate(oa1ss_p(ims:ime,jms:jme) ) + if(.not.allocated(oa2ss_p) ) allocate(oa2ss_p(ims:ime,jms:jme) ) + if(.not.allocated(oa3ss_p) ) allocate(oa3ss_p(ims:ime,jms:jme) ) + if(.not.allocated(oa4ss_p) ) allocate(oa4ss_p(ims:ime,jms:jme) ) + if(.not.allocated(ol1ss_p) ) allocate(ol1ss_p(ims:ime,jms:jme) ) + if(.not.allocated(ol2ss_p) ) allocate(ol2ss_p(ims:ime,jms:jme) ) + if(.not.allocated(ol3ss_p) ) allocate(ol3ss_p(ims:ime,jms:jme) ) + if(.not.allocated(ol4ss_p) ) allocate(ol4ss_p(ims:ime,jms:jme) ) + if(.not.allocated(hpbl_p) ) allocate(hpbl_p(ims:ime,jms:jme) ) + if(.not.allocated(br_p) ) allocate(br_p(ims:ime,jms:jme) ) + if(.not.allocated(xland_p ) ) allocate(xland_p(ims:ime,jms:jme) ) + if (ugwp_diags) then + if(.not.allocated(dusfc_ls_p)) allocate(dusfc_ls_p(ims:ime,jms:jme)) + if(.not.allocated(dvsfc_ls_p)) allocate(dvsfc_ls_p(ims:ime,jms:jme)) + if(.not.allocated(dusfc_bl_p)) allocate(dusfc_bl_p(ims:ime,jms:jme)) + if(.not.allocated(dvsfc_bl_p)) allocate(dvsfc_bl_p(ims:ime,jms:jme)) + if(.not.allocated(dusfc_ss_p)) allocate(dusfc_ss_p(ims:ime,jms:jme)) + if(.not.allocated(dvsfc_ss_p)) allocate(dvsfc_ss_p(ims:ime,jms:jme)) + if(.not.allocated(dusfc_fd_p)) allocate(dusfc_fd_p(ims:ime,jms:jme)) + if(.not.allocated(dvsfc_fd_p)) allocate(dvsfc_fd_p(ims:ime,jms:jme)) + if(.not.allocated(dtaux3d_ls_p)) allocate(dtaux3d_ls_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(dtauy3d_ls_p)) allocate(dtauy3d_ls_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(dtaux3d_bl_p)) allocate(dtaux3d_bl_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(dtauy3d_bl_p)) allocate(dtauy3d_bl_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(dtaux3d_ss_p)) allocate(dtaux3d_ss_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(dtauy3d_ss_p)) allocate(dtauy3d_ss_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(dtaux3d_fd_p)) allocate(dtaux3d_fd_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(dtauy3d_fd_p)) allocate(dtauy3d_fd_p(ims:ime,kms:kme,jms:jme)) + if (ngw_scheme) then + if(.not.allocated(dudt_ngw_p)) allocate(dudt_ngw_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(dvdt_ngw_p)) allocate(dvdt_ngw_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(dtdt_ngw_p)) allocate(dtdt_ngw_p(ims:ime,kms:kme,jms:jme)) + endif + endif + if (ngw_scheme) then + if(.not.allocated(xlat_p)) allocate(xlat_p(ims:ime,jms:jme)) + if(.not.allocated(raincv_p) ) allocate(raincv_p(ims:ime,jms:jme) ) + if(.not.allocated(rainncv_p) ) allocate(rainncv_p(ims:ime,jms:jme) ) + if(.not.allocated(jindx1_tau_p)) allocate(jindx1_tau_p(ims:ime,jms:jme)) + if(.not.allocated(jindx2_tau_p)) allocate(jindx2_tau_p(ims:ime,jms:jme)) + if(.not.allocated(ddy_j1tau_p)) allocate(ddy_j1tau_p(ims:ime,jms:jme)) + if(.not.allocated(ddy_j2tau_p)) allocate(ddy_j2tau_p(ims:ime,jms:jme)) + endif + + case default + + end select gwdo_select end subroutine allocate_gwdo !================================================================================================================= - subroutine deallocate_gwdo + subroutine deallocate_gwdo(configs) !================================================================================================================= + !input arguments: + type(mpas_pool_type),intent(in):: configs + + !local variables: + character(len=StrKIND),pointer:: gwdo_scheme + logical,pointer:: ugwp_diags,ngw_scheme + + call mpas_pool_get_config(configs,'config_gwdo_scheme',gwdo_scheme) + call mpas_pool_get_config(configs,'config_ugwp_diags',ugwp_diags) + call mpas_pool_get_config(configs,'config_ngw_scheme',ngw_scheme) + 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 ) - if(allocated(oa1_p) ) deallocate(oa1_p ) - if(allocated(oa2_p) ) deallocate(oa2_p ) - if(allocated(oa3_p) ) deallocate(oa3_p ) - if(allocated(oa4_p) ) deallocate(oa4_p ) - if(allocated(ol1_p) ) deallocate(ol1_p ) - if(allocated(ol2_p) ) deallocate(ol2_p ) - if(allocated(ol3_p) ) deallocate(ol3_p ) - if(allocated(ol4_p) ) deallocate(ol4_p ) - if(allocated(kpbl_p )) deallocate(kpbl_p ) + if(allocated(kpbl_p) ) deallocate(kpbl_p ) if(allocated(dusfcg_p)) deallocate(dusfcg_p) if(allocated(dvsfcg_p)) deallocate(dvsfcg_p) - if(allocated(dtaux3d_p)) deallocate(dtaux3d_p) if(allocated(dtauy3d_p)) deallocate(dtauy3d_p) if(allocated(rublten_p)) deallocate(rublten_p) if(allocated(rvblten_p)) deallocate(rvblten_p) + if(allocated(rthblten_p)) deallocate(rthblten_p) + + gwdo_select: select case (trim(gwdo_scheme)) + + case("bl_ysu_gwdo") + if(allocated(var2d_p) ) deallocate(var2d_p ) + if(allocated(con_p) ) deallocate(con_p ) + if(allocated(oa1_p) ) deallocate(oa1_p ) + if(allocated(oa2_p) ) deallocate(oa2_p ) + if(allocated(oa3_p) ) deallocate(oa3_p ) + if(allocated(oa4_p) ) deallocate(oa4_p ) + if(allocated(ol1_p) ) deallocate(ol1_p ) + if(allocated(ol2_p) ) deallocate(ol2_p ) + if(allocated(ol3_p) ) deallocate(ol3_p ) + if(allocated(ol4_p) ) deallocate(ol4_p ) + + case("bl_ugwp_gwdo") + if(allocated(var2dls_p) ) deallocate(var2dls_p ) + if(allocated(conls_p) ) deallocate(conls_p ) + if(allocated(oa1ls_p) ) deallocate(oa1ls_p ) + if(allocated(oa2ls_p) ) deallocate(oa2ls_p ) + if(allocated(oa3ls_p) ) deallocate(oa3ls_p ) + if(allocated(oa4ls_p) ) deallocate(oa4ls_p ) + if(allocated(ol1ls_p) ) deallocate(ol1ls_p ) + if(allocated(ol2ls_p) ) deallocate(ol2ls_p ) + if(allocated(ol3ls_p) ) deallocate(ol3ls_p ) + if(allocated(ol4ls_p) ) deallocate(ol4ls_p ) + if(allocated(var2dss_p) ) deallocate(var2dss_p ) + if(allocated(conss_p) ) deallocate(conss_p ) + if(allocated(oa1ss_p) ) deallocate(oa1ss_p ) + if(allocated(oa2ss_p) ) deallocate(oa2ss_p ) + if(allocated(oa3ss_p) ) deallocate(oa3ss_p ) + if(allocated(oa4ss_p) ) deallocate(oa4ss_p ) + if(allocated(ol1ss_p) ) deallocate(ol1ss_p ) + if(allocated(ol2ss_p) ) deallocate(ol2ss_p ) + if(allocated(ol3ss_p) ) deallocate(ol3ss_p ) + if(allocated(ol4ss_p) ) deallocate(ol4ss_p ) + if(allocated(hpbl_p) ) deallocate(hpbl_p ) + if(allocated(br_p) ) deallocate(br_p ) + if(allocated(xland_p) ) deallocate(xland_p ) + if (ugwp_diags) then + if(allocated(dusfc_ls_p)) deallocate(dusfc_ls_p) + if(allocated(dvsfc_ls_p)) deallocate(dvsfc_ls_p) + if(allocated(dusfc_bl_p)) deallocate(dusfc_bl_p) + if(allocated(dvsfc_bl_p)) deallocate(dvsfc_bl_p) + if(allocated(dusfc_ss_p)) deallocate(dusfc_ss_p) + if(allocated(dvsfc_ss_p)) deallocate(dvsfc_ss_p) + if(allocated(dusfc_fd_p)) deallocate(dusfc_fd_p) + if(allocated(dvsfc_fd_p)) deallocate(dvsfc_fd_p) + if(allocated(dtaux3d_ls_p)) deallocate(dtaux3d_ls_p) + if(allocated(dtauy3d_ls_p)) deallocate(dtauy3d_ls_p) + if(allocated(dtaux3d_bl_p)) deallocate(dtaux3d_bl_p) + if(allocated(dtauy3d_bl_p)) deallocate(dtauy3d_bl_p) + if(allocated(dtaux3d_ss_p)) deallocate(dtaux3d_ss_p) + if(allocated(dtauy3d_ss_p)) deallocate(dtauy3d_ss_p) + if(allocated(dtaux3d_fd_p)) deallocate(dtaux3d_fd_p) + if(allocated(dtauy3d_fd_p)) deallocate(dtauy3d_fd_p) + if (ngw_scheme) then + if(allocated(dudt_ngw_p)) deallocate(dudt_ngw_p) + if(allocated(dvdt_ngw_p)) deallocate(dvdt_ngw_p) + if(allocated(dtdt_ngw_p)) deallocate(dtdt_ngw_p) + endif + endif + if (ngw_scheme) then + if(allocated(xlat_p)) deallocate(xlat_p) + if(allocated(raincv_p) ) deallocate(raincv_p) + if(allocated(rainncv_p) ) deallocate(rainncv_p) + if(allocated(jindx1_tau_p)) deallocate(jindx1_tau_p) + if(allocated(jindx2_tau_p)) deallocate(jindx2_tau_p) + if(allocated(ddy_j1tau_p)) deallocate(ddy_j1tau_p) + if(allocated(ddy_j2tau_p)) deallocate(ddy_j2tau_p) + endif + + case default + + end select gwdo_select end subroutine deallocate_gwdo !================================================================================================================= - subroutine gwdo_from_MPAS(configs,mesh,sfc_input,diag_physics,tend_physics,its,ite) + subroutine gwdo_from_MPAS(configs,mesh,sfc_input,ngw_input,diag_physics,tend_physics,its,ite) !================================================================================================================= !input arguments: type(mpas_pool_type),intent(in):: configs type(mpas_pool_type),intent(in):: mesh type(mpas_pool_type),intent(in):: sfc_input + type(mpas_pool_type),intent(in):: ngw_input type(mpas_pool_type),intent(in):: diag_physics type(mpas_pool_type),intent(in):: tend_physics @@ -140,30 +297,225 @@ subroutine gwdo_from_MPAS(configs,mesh,sfc_input,diag_physics,tend_physics,its,i !local variables: integer:: i,k,j + character(len=StrKIND),pointer:: gwdo_scheme + character(len=StrKIND),pointer:: convection_scheme,microp_scheme + logical,pointer:: ugwp_diags,ngw_scheme + real(kind=RKIND),parameter :: rad2deg = 180./3.1415926 !local pointers: integer,dimension(:),pointer:: kpbl + integer,dimension(:),pointer:: jindx1_tau,jindx2_tau real(kind=RKIND),pointer:: len_disp real(kind=RKIND),dimension(:),pointer :: meshDensity real(kind=RKIND),dimension(:),pointer :: oa1,oa2,oa3,oa4,ol1,ol2,ol3,ol4,con,var2d + real(kind=RKIND),dimension(:),pointer :: oa1ls,oa2ls,oa3ls,oa4ls,ol1ls,ol2ls, & + ol3ls,ol4ls,conls,var2dls + real(kind=RKIND),dimension(:),pointer :: oa1ss,oa2ss,oa3ss,oa4ss,ol1ss,ol2ss, & + ol3ss,ol4ss,conss,var2dss real(kind=RKIND),dimension(:),pointer :: dusfcg,dvsfcg real(kind=RKIND),dimension(:,:),pointer:: dtaux3d,dtauy3d,rublten,rvblten + real(kind=RKIND),dimension(:,:),pointer:: rthblten + real(kind=RKIND),dimension(:),pointer :: dusfc_ls,dvsfc_ls,dusfc_bl,dvsfc_bl, & + dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd + real(kind=RKIND),dimension(:),pointer :: hpbl,xland,br1 + real(kind=RKIND),dimension(:),pointer :: latCell,ddy_j1tau,ddy_j2tau,raincv,rainncv + real(kind=RKIND),dimension(:,:),pointer:: dtaux3d_ls,dtauy3d_ls,dtaux3d_bl,dtauy3d_bl, & + dtaux3d_ss,dtauy3d_ss,dtaux3d_fd,dtauy3d_fd + real(kind=RKIND),dimension(:,:),pointer:: dudt_ngw,dvdt_ngw,dtdt_ngw !----------------------------------------------------------------------------------------------------------------- call mpas_pool_get_config(configs,'config_len_disp',len_disp) + call mpas_pool_get_config(configs,'config_gwdo_scheme',gwdo_scheme) + call mpas_pool_get_config(configs,'config_ugwp_diags',ugwp_diags) + call mpas_pool_get_config(configs,'config_ngw_scheme',ngw_scheme) + call mpas_pool_get_config(configs,'config_convection_scheme',convection_scheme) + call mpas_pool_get_config(configs,'config_microp_scheme',microp_scheme) call mpas_pool_get_array(mesh,'meshDensity',meshDensity) - call mpas_pool_get_array(sfc_input,'oa1' ,oa1 ) - call mpas_pool_get_array(sfc_input,'oa2' ,oa2 ) - call mpas_pool_get_array(sfc_input,'oa3' ,oa3 ) - call mpas_pool_get_array(sfc_input,'oa4' ,oa4 ) - call mpas_pool_get_array(sfc_input,'ol1' ,ol1 ) - call mpas_pool_get_array(sfc_input,'ol2' ,ol2 ) - call mpas_pool_get_array(sfc_input,'ol3' ,ol3 ) - call mpas_pool_get_array(sfc_input,'ol4' ,ol4 ) - call mpas_pool_get_array(sfc_input,'con' ,con ) - call mpas_pool_get_array(sfc_input,'var2d',var2d) + + gwdo_select: select case (trim(gwdo_scheme)) + + case("bl_ysu_gwdo") + call mpas_pool_get_array(sfc_input,'var2d',var2d) + call mpas_pool_get_array(sfc_input,'con' ,con ) + call mpas_pool_get_array(sfc_input,'oa1' ,oa1 ) + call mpas_pool_get_array(sfc_input,'oa2' ,oa2 ) + call mpas_pool_get_array(sfc_input,'oa3' ,oa3 ) + call mpas_pool_get_array(sfc_input,'oa4' ,oa4 ) + call mpas_pool_get_array(sfc_input,'ol1' ,ol1 ) + call mpas_pool_get_array(sfc_input,'ol2' ,ol2 ) + call mpas_pool_get_array(sfc_input,'ol3' ,ol3 ) + call mpas_pool_get_array(sfc_input,'ol4' ,ol4 ) + do j = jts,jte + do i = its,ite + var2d_p(i,j) = var2d(i) + con_p(i,j) = con(i) + oa1_p(i,j) = oa1(i) + oa2_p(i,j) = oa2(i) + oa3_p(i,j) = oa3(i) + oa4_p(i,j) = oa4(i) + ol1_p(i,j) = ol1(i) + ol2_p(i,j) = ol2(i) + ol3_p(i,j) = ol3(i) + ol4_p(i,j) = ol4(i) + enddo + enddo + + case("bl_ugwp_gwdo") + call mpas_pool_get_array(sfc_input,'var2dls',var2dls) + call mpas_pool_get_array(sfc_input,'conls' ,conls ) + call mpas_pool_get_array(sfc_input,'oa1ls' ,oa1ls ) + call mpas_pool_get_array(sfc_input,'oa2ls' ,oa2ls ) + call mpas_pool_get_array(sfc_input,'oa3ls' ,oa3ls ) + call mpas_pool_get_array(sfc_input,'oa4ls' ,oa4ls ) + call mpas_pool_get_array(sfc_input,'ol1ls' ,ol1ls ) + call mpas_pool_get_array(sfc_input,'ol2ls' ,ol2ls ) + call mpas_pool_get_array(sfc_input,'ol3ls' ,ol3ls ) + call mpas_pool_get_array(sfc_input,'ol4ls' ,ol4ls ) + call mpas_pool_get_array(sfc_input,'var2dss',var2dss) + call mpas_pool_get_array(sfc_input,'conss' ,conss ) + call mpas_pool_get_array(sfc_input,'oa1ss' ,oa1ss ) + call mpas_pool_get_array(sfc_input,'oa2ss' ,oa2ss ) + call mpas_pool_get_array(sfc_input,'oa3ss' ,oa3ss ) + call mpas_pool_get_array(sfc_input,'oa4ss' ,oa4ss ) + call mpas_pool_get_array(sfc_input,'ol1ss' ,ol1ss ) + call mpas_pool_get_array(sfc_input,'ol2ss' ,ol2ss ) + call mpas_pool_get_array(sfc_input,'ol3ss' ,ol3ss ) + call mpas_pool_get_array(sfc_input,'ol4ss' ,ol4ss ) + call mpas_pool_get_array(diag_physics,'hpbl',hpbl ) + call mpas_pool_get_array(diag_physics,'br' ,br1 ) + call mpas_pool_get_array(sfc_input,'xland' ,xland ) + do j = jts,jte + do i = its,ite + var2dls_p(i,j) = var2dls(i) + conls_p(i,j) = conls(i) + oa1ls_p(i,j) = oa1ls(i) + oa2ls_p(i,j) = oa2ls(i) + oa3ls_p(i,j) = oa3ls(i) + oa4ls_p(i,j) = oa4ls(i) + ol1ls_p(i,j) = ol1ls(i) + ol2ls_p(i,j) = ol2ls(i) + ol3ls_p(i,j) = ol3ls(i) + ol4ls_p(i,j) = ol4ls(i) + var2dss_p(i,j) = var2dss(i) + conss_p(i,j) = conss(i) + oa1ss_p(i,j) = oa1ss(i) + oa2ss_p(i,j) = oa2ss(i) + oa3ss_p(i,j) = oa3ss(i) + oa4ss_p(i,j) = oa4ss(i) + ol1ss_p(i,j) = ol1ss(i) + ol2ss_p(i,j) = ol2ss(i) + ol3ss_p(i,j) = ol3ss(i) + ol4ss_p(i,j) = ol4ss(i) + hpbl_p(i,j) = hpbl(i) + br_p(i,j) = br1(i) + xland_p(i,j) = xland(i) + enddo + enddo + if (ugwp_diags) then + call mpas_pool_get_array(diag_physics,'dusfc_ls' ,dusfc_ls ) + call mpas_pool_get_array(diag_physics,'dvsfc_ls' ,dvsfc_ls ) + call mpas_pool_get_array(diag_physics,'dusfc_bl' ,dusfc_bl ) + call mpas_pool_get_array(diag_physics,'dvsfc_bl' ,dvsfc_bl ) + call mpas_pool_get_array(diag_physics,'dusfc_ss' ,dusfc_ss ) + call mpas_pool_get_array(diag_physics,'dvsfc_ss' ,dvsfc_ss ) + call mpas_pool_get_array(diag_physics,'dusfc_fd' ,dusfc_fd ) + call mpas_pool_get_array(diag_physics,'dvsfc_fd' ,dvsfc_fd ) + call mpas_pool_get_array(diag_physics,'dtaux3d_ls' ,dtaux3d_ls ) + call mpas_pool_get_array(diag_physics,'dtauy3d_ls' ,dtauy3d_ls ) + call mpas_pool_get_array(diag_physics,'dtaux3d_bl' ,dtaux3d_bl ) + call mpas_pool_get_array(diag_physics,'dtauy3d_bl' ,dtauy3d_bl ) + call mpas_pool_get_array(diag_physics,'dtaux3d_ss' ,dtaux3d_ss ) + call mpas_pool_get_array(diag_physics,'dtauy3d_ss' ,dtauy3d_ss ) + call mpas_pool_get_array(diag_physics,'dtaux3d_fd' ,dtaux3d_fd ) + call mpas_pool_get_array(diag_physics,'dtauy3d_fd' ,dtauy3d_fd ) + do j = jts,jte + do i = its,ite + dusfc_ls_p(i,j) = dusfc_ls(i) + dvsfc_ls_p(i,j) = dvsfc_ls(i) + dusfc_bl_p(i,j) = dusfc_bl(i) + dvsfc_bl_p(i,j) = dvsfc_bl(i) + dusfc_ss_p(i,j) = dusfc_ss(i) + dvsfc_ss_p(i,j) = dvsfc_ss(i) + dusfc_fd_p(i,j) = dusfc_fd(i) + dvsfc_fd_p(i,j) = dvsfc_fd(i) + enddo + enddo + do j = jts,jte + do k = kts,kte + do i = its,ite + dtaux3d_ls_p(i,k,j) = dtaux3d_ls(k,i) + dtauy3d_ls_p(i,k,j) = dtauy3d_ls(k,i) + dtaux3d_bl_p(i,k,j) = dtaux3d_bl(k,i) + dtauy3d_bl_p(i,k,j) = dtauy3d_bl(k,i) + dtaux3d_ss_p(i,k,j) = dtaux3d_ss(k,i) + dtauy3d_ss_p(i,k,j) = dtauy3d_ss(k,i) + dtaux3d_fd_p(i,k,j) = dtaux3d_fd(k,i) + dtauy3d_fd_p(i,k,j) = dtauy3d_fd(k,i) + enddo + enddo + enddo + endif + if (ugwp_diags.and.ngw_scheme) then + call mpas_pool_get_array(diag_physics,'dudt_ngw',dudt_ngw) + call mpas_pool_get_array(diag_physics,'dvdt_ngw',dvdt_ngw) + call mpas_pool_get_array(diag_physics,'dtdt_ngw',dtdt_ngw) + do j = jts,jte + do k = kts,kte + do i = its,ite + dudt_ngw_p(i,k,j) = dudt_ngw(k,i) + dvdt_ngw_p(i,k,j) = dvdt_ngw(k,i) + dtdt_ngw_p(i,k,j) = dtdt_ngw(k,i) + enddo + enddo + enddo + endif + if (ngw_scheme) then + call mpas_pool_get_array(mesh,'latCell',latCell) + if(trim(convection_scheme) /= "off") & + call mpas_pool_get_array(diag_physics,'raincv',raincv) + if(trim(microp_scheme) /= "off") & + call mpas_pool_get_array(diag_physics,'rainncv',rainncv) + call mpas_pool_get_array(ngw_input,'jindx1_tau',jindx1_tau) + call mpas_pool_get_array(ngw_input,'jindx2_tau',jindx2_tau) + call mpas_pool_get_array(ngw_input,'ddy_j1tau', ddy_j1tau) + call mpas_pool_get_array(ngw_input,'ddy_j2tau', ddy_j2tau) + do j = jts,jte + do i = its,ite + xlat_p(i,j) = latCell(i)*rad2deg ! latitude in degrees + jindx1_tau_p(i,j) = jindx1_tau(i) + jindx2_tau_p(i,j) = jindx2_tau(i) + ddy_j1tau_p(i,j) = ddy_j1tau(i) + ddy_j2tau_p(i,j) = ddy_j2tau(i) + enddo + enddo + ! Treat rain rates conditionally + if(trim(convection_scheme) == "off") then + raincv_p(:,:) = 0._RKIND + else + do j = jts,jte + do i = its,ite + raincv_p(i,j) = raincv(i) + enddo + enddo + endif + if(trim(microp_scheme) == "off") then + rainncv_p(:,:) = 0._RKIND + else + do j = jts,jte + do i = its,ite + rainncv_p(i,j) = rainncv(i) + enddo + enddo + endif + + endif + + case default + + end select gwdo_select + call mpas_pool_get_array(diag_physics,'kpbl' ,kpbl ) call mpas_pool_get_array(diag_physics,'dusfcg' ,dusfcg ) @@ -172,28 +524,12 @@ subroutine gwdo_from_MPAS(configs,mesh,sfc_input,diag_physics,tend_physics,its,i call mpas_pool_get_array(diag_physics,'dtauy3d' ,dtauy3d ) call mpas_pool_get_array(tend_physics,'rublten' ,rublten ) call mpas_pool_get_array(tend_physics,'rvblten' ,rvblten ) + call mpas_pool_get_array(tend_physics,'rthblten',rthblten) 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) - oa2_p(i,j) = oa2(i) - oa3_p(i,j) = oa3(i) - oa4_p(i,j) = oa4(i) - ol1_p(i,j) = ol1(i) - ol2_p(i,j) = ol2(i) - ol3_p(i,j) = ol3(i) - ol4_p(i,j) = ol4(i) - enddo - enddo - - do j = jts,jte - do i = its,ite dx_p(i,j) = len_disp / meshDensity(i)**0.25 kpbl_p(i,j) = kpbl(i) dusfcg_p(i,j) = dusfcg(i) @@ -208,6 +544,7 @@ subroutine gwdo_from_MPAS(configs,mesh,sfc_input,diag_physics,tend_physics,its,i dtauy3d_p(i,k,j) = dtauy3d(k,i) rublten_p(i,k,j) = rublten(k,i) rvblten_p(i,k,j) = rvblten(k,i) + rthblten_p(i,k,j) = rthblten(k,i) enddo enddo enddo @@ -215,11 +552,12 @@ subroutine gwdo_from_MPAS(configs,mesh,sfc_input,diag_physics,tend_physics,its,i end subroutine gwdo_from_MPAS !================================================================================================================= - subroutine gwdo_to_MPAS(diag_physics,tend_physics,its,ite) + subroutine gwdo_to_MPAS(configs,diag_physics,tend_physics,its,ite) !================================================================================================================= !input arguments: integer,intent(in):: its,ite + type(mpas_pool_type),intent(in):: configs !inout arguments: type(mpas_pool_type),intent(inout):: diag_physics @@ -227,13 +565,29 @@ subroutine gwdo_to_MPAS(diag_physics,tend_physics,its,ite) !local variables: integer:: i,k,j + character(len=StrKIND),pointer:: gwdo_scheme + logical,pointer:: ugwp_diags,ngw_scheme !local pointers: real(kind=RKIND),dimension(:),pointer :: dusfcg,dvsfcg real(kind=RKIND),dimension(:,:),pointer:: dtaux3d,dtauy3d,rubldiff,rvbldiff,rublten,rvblten + real(kind=RKIND),dimension(:,:),pointer:: rthblten + + real(kind=RKIND),dimension(:),pointer :: oa1ls,oa2ls,oa3ls,oa4ls,ol1ls,ol2ls, & + ol3ls,ol4ls,conls,var2dls + real(kind=RKIND),dimension(:),pointer :: oa1ss,oa2ss,oa3ss,oa4ss,ol1ss,ol2ss, & + ol3ss,ol4ss,conss,var2dss + real(kind=RKIND),dimension(:),pointer :: dusfc_ls,dvsfc_ls,dusfc_bl,dvsfc_bl, & + dusfc_ss,dvsfc_ss,dusfc_fd,dvsfc_fd + real(kind=RKIND),dimension(:,:),pointer:: dtaux3d_ls,dtauy3d_ls,dtaux3d_bl,dtauy3d_bl, & + dtaux3d_ss,dtauy3d_ss,dtaux3d_fd,dtauy3d_fd + real(kind=RKIND),dimension(:,:),pointer:: dudt_ngw,dvdt_ngw,dtdt_ngw !----------------------------------------------------------------------------------------------------------------- + call mpas_pool_get_config(configs,'config_gwdo_scheme',gwdo_scheme) + call mpas_pool_get_config(configs,'config_ugwp_diags',ugwp_diags) + call mpas_pool_get_config(configs,'config_ngw_scheme',ngw_scheme) call mpas_pool_get_array(diag_physics,'dusfcg' ,dusfcg ) call mpas_pool_get_array(diag_physics,'dvsfcg' ,dvsfcg ) call mpas_pool_get_array(diag_physics,'dtaux3d' ,dtaux3d ) @@ -242,6 +596,74 @@ subroutine gwdo_to_MPAS(diag_physics,tend_physics,its,ite) call mpas_pool_get_array(diag_physics,'rvbldiff',rvbldiff) call mpas_pool_get_array(tend_physics,'rublten' ,rublten ) call mpas_pool_get_array(tend_physics,'rvblten' ,rvblten ) + call mpas_pool_get_array(tend_physics,'rthblten',rthblten) + + + gwdo_select: select case (trim(gwdo_scheme)) + + case("bl_ugwp_gwdo") + if (ugwp_diags) then + call mpas_pool_get_array(diag_physics,'dusfc_ls' ,dusfc_ls ) + call mpas_pool_get_array(diag_physics,'dvsfc_ls' ,dvsfc_ls ) + call mpas_pool_get_array(diag_physics,'dusfc_bl' ,dusfc_bl ) + call mpas_pool_get_array(diag_physics,'dvsfc_bl' ,dvsfc_bl ) + call mpas_pool_get_array(diag_physics,'dusfc_ss' ,dusfc_ss ) + call mpas_pool_get_array(diag_physics,'dvsfc_ss' ,dvsfc_ss ) + call mpas_pool_get_array(diag_physics,'dusfc_fd' ,dusfc_fd ) + call mpas_pool_get_array(diag_physics,'dvsfc_fd' ,dvsfc_fd ) + call mpas_pool_get_array(diag_physics,'dtaux3d_ls' ,dtaux3d_ls ) + call mpas_pool_get_array(diag_physics,'dtauy3d_ls' ,dtauy3d_ls ) + call mpas_pool_get_array(diag_physics,'dtaux3d_bl' ,dtaux3d_bl ) + call mpas_pool_get_array(diag_physics,'dtauy3d_bl' ,dtauy3d_bl ) + call mpas_pool_get_array(diag_physics,'dtaux3d_ss' ,dtaux3d_ss ) + call mpas_pool_get_array(diag_physics,'dtauy3d_ss' ,dtauy3d_ss ) + call mpas_pool_get_array(diag_physics,'dtaux3d_fd' ,dtaux3d_fd ) + call mpas_pool_get_array(diag_physics,'dtauy3d_fd' ,dtauy3d_fd ) + do j = jts,jte + do i = its,ite + dusfc_ls(i) = dusfc_ls_p(i,j) + dvsfc_ls(i) = dvsfc_ls_p(i,j) + dusfc_bl(i) = dusfc_bl_p(i,j) + dvsfc_bl(i) = dvsfc_bl_p(i,j) + dusfc_ss(i) = dusfc_ss_p(i,j) + dvsfc_ss(i) = dvsfc_ss_p(i,j) + dusfc_fd(i) = dusfc_fd_p(i,j) + dvsfc_fd(i) = dvsfc_fd_p(i,j) + enddo + enddo + do j = jts,jte + do k = kts,kte + do i = its,ite + dtaux3d_ls(k,i) = dtaux3d_ls_p(i,k,j) + dtauy3d_ls(k,i) = dtauy3d_ls_p(i,k,j) + dtaux3d_bl(k,i) = dtaux3d_bl_p(i,k,j) + dtauy3d_bl(k,i) = dtauy3d_bl_p(i,k,j) + dtaux3d_ss(k,i) = dtaux3d_ss_p(i,k,j) + dtauy3d_ss(k,i) = dtauy3d_ss_p(i,k,j) + dtaux3d_fd(k,i) = dtaux3d_fd_p(i,k,j) + dtauy3d_fd(k,i) = dtauy3d_fd_p(i,k,j) + enddo + enddo + enddo + if (ngw_scheme) then + call mpas_pool_get_array(diag_physics,'dudt_ngw' ,dudt_ngw ) + call mpas_pool_get_array(diag_physics,'dvdt_ngw' ,dvdt_ngw ) + call mpas_pool_get_array(diag_physics,'dtdt_ngw' ,dtdt_ngw ) + do j = jts,jte + do k = kts,kte + do i = its,ite + dudt_ngw(k,i) = dudt_ngw_p(i,k,j) + dvdt_ngw(k,i) = dvdt_ngw_p(i,k,j) + dtdt_ngw(k,i) = dtdt_ngw_p(i,k,j) + enddo + enddo + enddo + endif + endif + + case default + + end select gwdo_select do j = jts,jte do i = its,ite @@ -259,6 +681,7 @@ subroutine gwdo_to_MPAS(diag_physics,tend_physics,its,ite) rvbldiff(k,i) = rvblten_p(i,k,j)-rvblten(k,i) rublten(k,i) = rublten_p(i,k,j) rvblten(k,i) = rvblten_p(i,k,j) + rthblten(k,i) = rthblten_p(i,k,j) enddo enddo enddo @@ -266,7 +689,7 @@ subroutine gwdo_to_MPAS(diag_physics,tend_physics,its,ite) end subroutine gwdo_to_MPAS !================================================================================================================= - subroutine driver_gwdo(itimestep,configs,mesh,sfc_input,diag_physics,tend_physics,its,ite) + subroutine driver_gwdo(itimestep,configs,mesh,sfc_input,ngw_input,diag_physics,tend_physics,its,ite) !================================================================================================================= !input arguments: @@ -278,13 +701,21 @@ subroutine driver_gwdo(itimestep,configs,mesh,sfc_input,diag_physics,tend_physic integer,intent(in):: itimestep !inout arguments: + type(mpas_pool_type),intent(inout):: ngw_input type(mpas_pool_type),intent(inout):: diag_physics type(mpas_pool_type),intent(inout):: tend_physics !local variables: character(len=StrKIND),pointer:: gwdo_scheme - - integer:: i,iCell,iEdge + logical,pointer:: ugwp_diags,ngw_scheme + integer,pointer:: ntau_d1y_ptr,ntau_d2t_ptr + real(kind=RKIND),dimension(:),pointer :: days_limb_ptr + real(kind=RKIND),dimension(:,:),pointer:: tau_limb_ptr + integer:: ntau_d1y,ntau_d2t + real(kind=RKIND),dimension(:),allocatable:: days_limb + real(kind=RKIND),dimension(:,:),allocatable:: tau_limb + + integer:: i real(kind=RKIND),dimension(:),allocatable:: dx_max !CCPP-compliant flags: @@ -300,9 +731,26 @@ subroutine driver_gwdo(itimestep,configs,mesh,sfc_input,diag_physics,tend_physic errflg = 0 call mpas_pool_get_config(configs,'config_gwdo_scheme',gwdo_scheme) + call mpas_pool_get_config(configs,'config_ugwp_diags',ugwp_diags) + call mpas_pool_get_config(configs,'config_ngw_scheme',ngw_scheme) + + ! Call up variables needed for NGW scheme + if (ngw_scheme) then + call mpas_pool_get_dimension(mesh,'lat',ntau_d1y_ptr) + call mpas_pool_get_dimension(mesh,'days',ntau_d2t_ptr) + call mpas_pool_get_array(ngw_input,'DAYS',days_limb_ptr) + call mpas_pool_get_array(ngw_input,'ABSMF',tau_limb_ptr) + ntau_d1y = ntau_d1y_ptr + ntau_d2t = ntau_d2t_ptr + if(.not.allocated(days_limb)) allocate(days_limb(ntau_d2t)) + if(.not.allocated(tau_limb) ) allocate(tau_limb (ntau_d1y,ntau_d2t)) + days_limb(:) = days_limb_ptr(:) + tau_limb (:,:) = tau_limb_ptr(:,:) + endif + !copy MPAS arrays to local arrays: - call gwdo_from_MPAS(configs,mesh,sfc_input,diag_physics,tend_physics,its,ite) + call gwdo_from_MPAS(configs,mesh,sfc_input,ngw_input,diag_physics,tend_physics,its,ite) gwdo_select: select case (trim(gwdo_scheme)) @@ -328,12 +776,57 @@ subroutine driver_gwdo(itimestep,configs,mesh,sfc_input,diag_physics,tend_physic ) call mpas_timer_stop('bl_gwdo') + case("bl_ugwp_gwdo") + call mpas_timer_start('bl_ugwp_gwdo') + call gwdo_ugwp ( & + p3d = pres_hydd_p , p3di = pres2_hydd_p, pi3d = pi_p , & + u3d = u_p , v3d = v_p , t3d = t_p , & + qv3d = qv_p , z = zmid_p , rublten = rublten_p , & + rvblten = rvblten_p , rthblten = rthblten_p , & + dtaux3d = dtaux3d_p , dtauy3d = dtauy3d_p , & + dusfcg = dusfcg_p , dvsfcg = dvsfcg_p , kpbl2d = kpbl_p , & + itimestep = itimestep , dt = dt_pbl , dx = dx_p , & + pblh = hpbl_p , br1 = br_p , xland = xland_p , & + cp = cp , g = gravity , rd = R_d , & + rv = R_v , ep1 = ep_1 , pi = pii , & + sina = sina_p , cosa = cosa_p , dz = dz_p , & + var2dls = var2dls_p , oc12dls = conls_p , oa2d1ls = oa1ls_p , & + oa2d2ls = oa2ls_p , oa2d3ls = oa3ls_p , oa2d4ls = oa4ls_p , & + ol2d1ls = ol1ls_p , ol2d2ls = ol2ls_p , ol2d3ls = ol3ls_p , & + ol2d4ls = ol4ls_p , var2dss = var2dss_p , oc12dss = conss_p , & + oa2d1ss = oa1ss_p , oa2d2ss = oa2ss_p , oa2d3ss = oa3ss_p , & + oa2d4ss = oa4ss_p , ol2d1ss = ol1ss_p , ol2d2ss = ol2ss_p , & + ol2d3ss = ol3ss_p , ol2d4ss = ol4ss_p , zi = z_p , & + dusfc_ls = dusfc_ls_p , dvsfc_ls = dvsfc_ls_p , dusfc_bl = dusfc_bl_p, & + dvsfc_bl = dvsfc_bl_p , dusfc_ss = dusfc_ss_p , dvsfc_ss = dvsfc_ss_p, & + dusfc_fd = dusfc_fd_p , dvsfc_fd = dvsfc_fd_p , & + dtaux3d_ls = dtaux3d_ls_p, dtauy3d_ls = dtauy3d_ls_p, & + dtaux3d_bl = dtaux3d_bl_p, dtauy3d_bl = dtauy3d_bl_p, & + dtaux3d_ss = dtaux3d_ss_p, dtauy3d_ss = dtauy3d_ss_p, & + dtaux3d_fd = dtaux3d_fd_p, dtauy3d_fd = dtauy3d_fd_p, & + ugwp_diags = ugwp_diags , ngw_scheme = ngw_scheme , xlatd = xlat_p , & + jindx1_tau = jindx1_tau_p, jindx2_tau = jindx2_tau_p, & + ddy_j1tau = ddy_j1tau_p , ddy_j2tau = ddy_j2tau_p , r_DoY = curr_julday, & + raincv = raincv_p , rainncv = rainncv_p , ntau_d1y = ntau_d1y , & + ntau_d2t = ntau_d2t , days_limb = days_limb , tau_limb = tau_limb , & + dudt_ngw = dudt_ngw_p , dvdt_ngw = dvdt_ngw_p , dtdt_ngw = dtdt_ngw_p , & + errmsg = errmsg , errflg = errflg , & + 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 (ngw_scheme) then + if(allocated(days_limb)) deallocate(days_limb) + if(allocated(tau_limb) ) deallocate(tau_limb ) + endif + call mpas_timer_stop('bl_ugwp_gwdo') + case default end select gwdo_select !copy local arrays to MPAS grid: - call gwdo_to_MPAS(diag_physics,tend_physics,its,ite) + call gwdo_to_MPAS(configs,diag_physics,tend_physics,its,ite) !call mpas_log_write('--- end subroutine driver_gwdo.') !call mpas_log_write('') diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_lsm_noahmp.F b/src/core_atmosphere/physics/mpas_atmphys_driver_lsm_noahmp.F new file mode 100644 index 000000000..7b93e7cf6 --- /dev/null +++ b/src/core_atmosphere/physics/mpas_atmphys_driver_lsm_noahmp.F @@ -0,0 +1,1090 @@ +! Copyright (c) 2013, Los Alamos National Security, LLC (LANS) +! and the University Corporation for Atmospheric Research (UCAR). +! +! Unless noted otherwise source code is licensed under the BSD license. +! Additional copyright and license information can be found in the LICENSE file +! distributed with this code, or at http://mpas-dev.github.com/license.html +! +!================================================================================================================= + module mpas_atmphys_driver_lsm_noahmp + use mpas_kind_types + use mpas_log + use mpas_pool_routines + use mpas_timer,only: mpas_timer_start, mpas_timer_stop + + use mpas_atmphys_constants,only: R_d,R_v + use mpas_atmphys_manager,only : year,curr_julday,month,day + use mpas_atmphys_vars,only : mpas_noahmp,xice_threshold + + + use NoahmpIOVarType + use NoahmpDriverMainMod,only: NoahmpDriverMain + + implicit none + private + public:: driver_lsm_noahmp + + + contains + + +!================================================================================================================= + subroutine lsm_noahmp_fromMPAS(configs,mesh,diag,diag_physics,diag_physics_noahmp,output_noahmp,sfc_input, & + state,time_lev,itimestep) +!================================================================================================================= + +!--- input arguments: + type(mpas_pool_type),intent(in):: configs + type(mpas_pool_type),intent(in):: mesh + type(mpas_pool_type),intent(in):: diag + type(mpas_pool_type),intent(in):: state + + integer,intent(in):: time_lev + integer,intent(in):: itimestep + + +!--- inout arguments: + type(mpas_pool_type),intent(in):: diag_physics + type(mpas_pool_type),intent(in):: diag_physics_noahmp + type(mpas_pool_type),intent(in):: output_noahmp + type(mpas_pool_type),intent(in):: sfc_input + + +!--- local variables and arrays: + logical,pointer:: do_restart + + character(len=StrKIND),pointer:: microp_scheme, & + convection_scheme + + integer:: i,its,ite + integer:: n,ns,nsoil,nsnow,nzsnow + integer,dimension(:),pointer:: isltyp,ivgtyp + + real(kind=RKIND),dimension(:),pointer:: latCell,lonCell + real(kind=RKIND),dimension(:),pointer:: shdmax,shdmin,vegfra,tmn,xice,xland + + real(kind=RKIND),dimension(:),pointer:: coszr,glw,gsw,swddir,swddif + real(kind=RKIND),dimension(:),pointer:: graupelncv,raincv,rainncv,snowncv,sr + + +!--- local INOUT pointers (with generic LSM equivalent as defined in WRF): + real(kind=RKIND),dimension(:),pointer:: acsnom,acsnow,canwat,hfx,qfx,qsfc,lh,grdflx,sfc_albedo,sfc_emiss, & + sfcrunoff,skintemp,smstav,smstot,udrunoff,snow,snowc,snowh,lai,z0, & + znt + real(kind=RKIND),dimension(:,:),pointer:: sh2o,smois,tslb + + +!--- local INOUT pointers (with no Noah LSM equivalent as defined in WRF): + integer,dimension(:),pointer:: isnowxy + real(kind=RKIND),dimension(:),pointer:: tvxy,tgxy,canicexy,canliqxy,eahxy,tahxy,cmxy,chxy,fwetxy,sneqvoxy, & + alboldxy,qsnowxy,qrainxy,wslakexy,zwtxy,waxy,wtxy,deeprechxy, & + rechxy,lfmassxy,rtmassxy,stmassxy,woodxy,grainxy,gddxy,stblcpxy, & + fastcpxy,xsaixy,taussxy + real(kind=RKIND),dimension(:,:),pointer:: tsnoxy,zsnsoxy,snicexy,snliqxy + + +!--- local OUT pointers (with no Noah LSM equivalent as defined in WRF): + real(kind=RKIND),dimension(:),pointer:: tradxy,neexy,gppxy,nppxy,fvegxy,runsfxy,runsbxy,ecanxy,edirxy, & + etranxy,fsaxy,firaxy,aparxy,psnxy,savxy,sagxy,rssunxy,rsshaxy, & + bgapxy,wgapxy,tgvxy,tgbxy,chvxy,chbxy,shgxy,shcxy,shbxy,evgxy, & + evbxy,ghvxy,ghbxy,irgxy,ircxy,irbxy,trxy,evcxy,chleafxy,chucxy, & + chv2xy,chb2xy,rs,qtdrain + + +!--- local OUT additional variables: + real(kind=RKIND),dimension(:),pointer:: pahxy,pahgxy,pahbxy,pahvxy,qintsxy,qintrxy,qdripsxy,qdriprxy, & + qthrosxy,qthrorxy,qsnsubxy,qmeltxy,qsnfroxy,qsubcxy,qfrocxy, & + qevacxy,qdewcxy,qfrzcxy,qmeltcxy,qsnbotxy,pondingxy,fpicexy, & + rainlsm,snowlsm,forctlsm,forcqlsm,forcplsm,forczlsm,forcwlsm, & + acc_ssoilxy,acc_qinsurxy,acc_qsevaxy,eflxbxy,soilenergy,snowenergy, & + canhsxy,acc_dwaterxy,acc_prcpxy,acc_ecanxy,acc_etranxy,acc_edirxy + real(kind=RKIND),dimension(:,:),pointer:: acc_etranixy + +!----------------------------------------------------------------------------------------------------------------- +!call mpas_log_write('--- enter subroutine lsm_noahmp_fromMPAS: itimestep = $i',intArgs=(/itimestep/)) + + call mpas_pool_get_config(configs,'config_do_restart',do_restart) + + call mpas_pool_get_config(configs,'config_convection_scheme',convection_scheme) + call mpas_pool_get_config(configs,'config_microp_scheme' ,microp_scheme ) + + +!--- initialization of local dimensions: + its = mpas_noahmp%its + ite = mpas_noahmp%ite + nsoil = mpas_noahmp%nsoil + nsnow = mpas_noahmp%nsnow + nzsnow = nsnow + nsoil + + +!--- initialization of time-varying variables: + mpas_noahmp%restart_flag = do_restart + + mpas_noahmp%soiltstep = 0 + mpas_noahmp%itimestep = itimestep + mpas_noahmp%yr = year + mpas_noahmp%month = month + mpas_noahmp%day = day + mpas_noahmp%julian = curr_julday + + +!--- initialization of xice_threshold: + mpas_noahmp%xice_threshold = xice_threshold + + +!--- initialization of INPUT surface variables: + call mpas_pool_get_array(sfc_input,'shdmax',shdmax) + call mpas_pool_get_array(sfc_input,'shdmin',shdmin) + call mpas_pool_get_array(sfc_input,'vegfra',vegfra) + call mpas_pool_get_array(sfc_input,'tmn' ,tmn ) + call mpas_pool_get_array(sfc_input,'xice' ,xice ) + call mpas_pool_get_array(sfc_input,'xland' ,xland ) + + call mpas_pool_get_array(diag_physics,'coszr' ,coszr ) + call mpas_pool_get_array(diag_physics,'glw' ,glw ) + call mpas_pool_get_array(diag_physics,'gsw' ,gsw ) + call mpas_pool_get_array(diag_physics,'sfc_albedo',sfc_albedo) + call mpas_pool_get_array(diag_physics,'swddir' ,swddir ) + call mpas_pool_get_array(diag_physics,'swddif' ,swddif ) + call mpas_pool_get_array(diag_physics,'sr' ,sr ) + call mpas_pool_get_array(diag_physics,'raincv' ,raincv ) + call mpas_pool_get_array(diag_physics,'rainncv' ,rainncv ) + call mpas_pool_get_array(diag_physics,'snowncv' ,snowncv ) + call mpas_pool_get_array(diag_physics,'graupelncv',graupelncv) + + do i = its,ite + mpas_noahmp%coszen(i) = coszr(i) + mpas_noahmp%gvfmax(i) = shdmax(i) + mpas_noahmp%gvfmin(i) = shdmin(i) + mpas_noahmp%vegfra(i) = vegfra(i) + mpas_noahmp%tmn(i) = tmn(i) + mpas_noahmp%xland(i) = xland(i) + mpas_noahmp%xice(i) = xice(i) + mpas_noahmp%swdown(i) = gsw(i) / (1.-sfc_albedo(i)) + mpas_noahmp%swddir(i) = swddir(i) + mpas_noahmp%swddif(i) = swddif(i) + mpas_noahmp%glw(i) = glw(i) + mpas_noahmp%rainbl(i) = 0. + mpas_noahmp%snowbl(i) = 0. + mpas_noahmp%rainshv(i) = 0. + mpas_noahmp%hailncv(i) = 0. + mpas_noahmp%mp_hail(i) = 0. + mpas_noahmp%mp_shcv(i) = 0. + mpas_noahmp%seaice(i) = 0. + enddo + +!--- calculation of the instantaneous precipitation rates of rain and snow: + if(microp_scheme .ne. 'off') then + do i = its,ite + mpas_noahmp%sr(i) = sr(i) + mpas_noahmp%rainncv(i) = rainncv(i) + mpas_noahmp%snowncv(i) = snowncv(i) + mpas_noahmp%graupelncv(i) = graupelncv(i) + mpas_noahmp%rainbl(i) = mpas_noahmp%rainbl(i) + mpas_noahmp%rainncv(i) + mpas_noahmp%snowbl(i) = mpas_noahmp%snowbl(i) + mpas_noahmp%snowncv(i) + + mpas_noahmp%mp_rainnc(i) = rainncv(i) + mpas_noahmp%mp_snow(i) = snowncv(i) + mpas_noahmp%mp_graup(i) = graupelncv(i) + enddo + else + do i = its,ite + mpas_noahmp%sr(i) = 0. + mpas_noahmp%rainncv(i) = 0. + mpas_noahmp%snowncv(i) = 0. + mpas_noahmp%graupelncv(i) = 0. + + mpas_noahmp%mp_rainnc(i) = 0. + mpas_noahmp%mp_snow(i) = 0. + mpas_noahmp%mp_graup(i) = 0. + enddo + endif + if(convection_scheme .ne. 'off') then + do i = its,ite + mpas_noahmp%raincv(i) = raincv(i) + mpas_noahmp%rainbl(i) = mpas_noahmp%rainbl(i) + mpas_noahmp%raincv(i) + mpas_noahmp%raincv(i) = raincv(i) + + mpas_noahmp%mp_rainc(i) = raincv(i) + enddo + else + do i = its,ite + mpas_noahmp%raincv(i) = 0. + mpas_noahmp%mp_rainc(i) = 0. + enddo + endif + +!--- calculation of the incidence of fractional seaice: + do i = its,ite + mpas_noahmp%seaice(i) = 0. + if(mpas_noahmp%xice(i) .ge. xice_threshold) mpas_noahmp%seaice(i) = 1. + enddo + + +!--- initialization of INPUT sounding variables: + call lsm_noahmp_sounding_fromMPAS(mesh,state,time_lev,diag) + + +!--- initialization of INOUT variables (with generic LSM equivalent as defined in WRF), i.e. +! see lines 162-184 in module NoahmpIOVarType.F90): + call mpas_pool_get_array(sfc_input,'skintemp',skintemp) + call mpas_pool_get_array(sfc_input,'snowc' ,snowc ) + call mpas_pool_get_array(sfc_input,'snow' ,snow ) + call mpas_pool_get_array(sfc_input,'snowh' ,snowh ) + call mpas_pool_get_array(sfc_input,'sh2o' ,sh2o ) + 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,'hfx' ,hfx ) + call mpas_pool_get_array(diag_physics,'qfx' ,qfx ) + call mpas_pool_get_array(diag_physics,'lh ' ,lh ) + call mpas_pool_get_array(diag_physics,'grdflx' ,grdflx ) + 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,'sfcrunoff' ,sfcrunoff ) + call mpas_pool_get_array(diag_physics,'udrunoff' ,udrunoff ) + call mpas_pool_get_array(diag_physics,'canwat' ,canwat ) + 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,'sfc_emiss' ,sfc_emiss ) + call mpas_pool_get_array(diag_physics,'qsfc' ,qsfc ) + call mpas_pool_get_array(diag_physics,'lai' ,lai ) + call mpas_pool_get_array(diag_physics,'z0' ,z0 ) + call mpas_pool_get_array(diag_physics,'znt' ,znt ) + + + do i = its,ite + mpas_noahmp%tsk(i) = skintemp(i) + mpas_noahmp%hfx(i) = hfx(i) + mpas_noahmp%qfx(i) = qfx(i) + mpas_noahmp%lh(i) = lh(i) + mpas_noahmp%grdflx(i) = grdflx(i) + mpas_noahmp%smstav(i) = smstav(i) + mpas_noahmp%smstot(i) = smstot(i) + mpas_noahmp%sfcrunoff(i) = sfcrunoff(i) + mpas_noahmp%udrunoff(i) = udrunoff(i) + mpas_noahmp%albedo(i) = sfc_albedo(i) + mpas_noahmp%snowc(i) = snowc(i) + mpas_noahmp%snow(i) = snow(i) + mpas_noahmp%snowh(i) = snowh(i) + mpas_noahmp%canwat(i) = canwat(i) + mpas_noahmp%acsnom(i) = acsnom(i) + mpas_noahmp%acsnow(i) = acsnow(i) + mpas_noahmp%emiss(i) = sfc_emiss(i) + mpas_noahmp%qsfc(i) = qsfc(i) + mpas_noahmp%lai(i) = lai(i) + mpas_noahmp%z0(i) = z0(i) + mpas_noahmp%znt(i) = znt(i) + enddo + + do ns = 1,nsoil + do i = its,ite + mpas_noahmp%sh2o(i,ns) = sh2o(ns,i) + mpas_noahmp%smois(i,ns) = smois(ns,i) + mpas_noahmp%tslb(i,ns) = tslb(ns,i) + enddo + enddo + + +!--- initialization of INOUT variables (with no Noah LSM equivalent as defined in WRF), i.e. +! see lines 186-222 in module NoahmpIOVarType.F90: + call mpas_pool_get_array(diag_physics_noahmp,'isnowxy' ,isnowxy ) + call mpas_pool_get_array(diag_physics_noahmp,'tvxy' ,tvxy ) + call mpas_pool_get_array(diag_physics_noahmp,'tgxy' ,tgxy ) + call mpas_pool_get_array(diag_physics_noahmp,'canicexy' ,canicexy ) + call mpas_pool_get_array(diag_physics_noahmp,'canliqxy' ,canliqxy ) + call mpas_pool_get_array(diag_physics_noahmp,'eahxy' ,eahxy ) + call mpas_pool_get_array(diag_physics_noahmp,'tahxy' ,tahxy ) + call mpas_pool_get_array(diag_physics_noahmp,'cmxy' ,cmxy ) + call mpas_pool_get_array(diag_physics_noahmp,'chxy' ,chxy ) + call mpas_pool_get_array(diag_physics_noahmp,'fwetxy' ,fwetxy ) + call mpas_pool_get_array(diag_physics_noahmp,'sneqvoxy' ,sneqvoxy ) + call mpas_pool_get_array(diag_physics_noahmp,'alboldxy' ,alboldxy ) + call mpas_pool_get_array(diag_physics_noahmp,'qsnowxy' ,qsnowxy ) + call mpas_pool_get_array(diag_physics_noahmp,'qrainxy' ,qrainxy ) + call mpas_pool_get_array(diag_physics_noahmp,'wslakexy' ,wslakexy ) + call mpas_pool_get_array(diag_physics_noahmp,'zwtxy' ,zwtxy ) + call mpas_pool_get_array(diag_physics_noahmp,'waxy' ,waxy ) + call mpas_pool_get_array(diag_physics_noahmp,'wtxy' ,wtxy ) + call mpas_pool_get_array(diag_physics_noahmp,'deeprechxy',deeprechxy ) + call mpas_pool_get_array(diag_physics_noahmp,'rechxy' ,rechxy ) + call mpas_pool_get_array(diag_physics_noahmp,'tsnoxy' ,tsnoxy ) + call mpas_pool_get_array(diag_physics_noahmp,'zsnsoxy' ,zsnsoxy ) + call mpas_pool_get_array(diag_physics_noahmp,'snicexy' ,snicexy ) + call mpas_pool_get_array(diag_physics_noahmp,'snliqxy' ,snliqxy ) + call mpas_pool_get_array(diag_physics_noahmp,'lfmassxy' ,lfmassxy ) + call mpas_pool_get_array(diag_physics_noahmp,'rtmassxy' ,rtmassxy ) + call mpas_pool_get_array(diag_physics_noahmp,'stmassxy' ,stmassxy ) + call mpas_pool_get_array(diag_physics_noahmp,'woodxy' ,woodxy ) + call mpas_pool_get_array(diag_physics_noahmp,'grainxy' ,grainxy ) + call mpas_pool_get_array(diag_physics_noahmp,'gddxy' ,gddxy ) + call mpas_pool_get_array(diag_physics_noahmp,'stblcpxy' ,stblcpxy ) + call mpas_pool_get_array(diag_physics_noahmp,'fastcpxy' ,fastcpxy ) + call mpas_pool_get_array(diag_physics_noahmp,'xsaixy' ,xsaixy ) + call mpas_pool_get_array(diag_physics_noahmp,'taussxy' ,taussxy ) + + do i = its,ite + mpas_noahmp%isnowxy(i) = isnowxy(i) + mpas_noahmp%tvxy(i) = tvxy(i) + mpas_noahmp%tgxy(i) = tgxy(i) + mpas_noahmp%canicexy(i) = canicexy(i) + mpas_noahmp%canliqxy(i) = canliqxy(i) + mpas_noahmp%eahxy(i) = eahxy(i) + mpas_noahmp%tahxy(i) = tahxy(i) + mpas_noahmp%cmxy(i) = cmxy(i) + mpas_noahmp%chxy(i) = chxy(i) + mpas_noahmp%fwetxy(i) = fwetxy(i) + mpas_noahmp%sneqvoxy(i) = sneqvoxy(i) + mpas_noahmp%alboldxy(i) = alboldxy(i) + mpas_noahmp%qsnowxy(i) = qsnowxy(i) + mpas_noahmp%qrainxy(i) = qrainxy(i) + mpas_noahmp%wslakexy(i) = wslakexy(i) + mpas_noahmp%zwtxy(i) = zwtxy(i) + mpas_noahmp%waxy(i) = waxy(i) + mpas_noahmp%wtxy(i) = wtxy(i) + mpas_noahmp%deeprechxy(i) = deeprechxy(i) + mpas_noahmp%rechxy(i) = rechxy(i) + mpas_noahmp%lfmassxy(i) = lfmassxy(i) + mpas_noahmp%rtmassxy(i) = rtmassxy(i) + mpas_noahmp%stmassxy(i) = stmassxy(i) + mpas_noahmp%woodxy(i) = woodxy(i) + mpas_noahmp%grainxy(i) = grainxy(i) + mpas_noahmp%gddxy(i) = gddxy(i) + mpas_noahmp%stblcpxy(i) = stblcpxy(i) + mpas_noahmp%fastcpxy(i) = fastcpxy(i) + mpas_noahmp%xsaixy(i) = xsaixy(i) + mpas_noahmp%taussxy(i) = taussxy(i) + enddo + + do ns = 1,nsnow + n = ns - nsnow + do i = its,ite + mpas_noahmp%tsnoxy(i,n) = tsnoxy(ns,i) + mpas_noahmp%snicexy(i,n) = snicexy(ns,i) + mpas_noahmp%snliqxy(i,n) = snliqxy(ns,i) + mpas_noahmp%zsnsoxy(i,n) = zsnsoxy(ns,i) + enddo + enddo + do ns = nsnow+1,nzsnow + n = ns - nsnow + do i = its,ite + mpas_noahmp%zsnsoxy(i,n) = zsnsoxy(ns,i) + enddo + enddo + + +!--- initialization of OUT (with no Noah LSM equivalent as defined in WRF), i.e. +! see lines 242-290 in module NoahmpIOVarType.F90): + call mpas_pool_get_array(output_noahmp,'tradxy' ,tradxy ) + call mpas_pool_get_array(output_noahmp,'neexy' ,neexy ) + call mpas_pool_get_array(output_noahmp,'gppxy' ,gppxy ) + call mpas_pool_get_array(output_noahmp,'nppxy' ,nppxy ) + call mpas_pool_get_array(output_noahmp,'fvegxy' ,fvegxy ) + call mpas_pool_get_array(output_noahmp,'runsfxy' ,runsfxy ) + call mpas_pool_get_array(output_noahmp,'runsbxy' ,runsbxy ) + call mpas_pool_get_array(output_noahmp,'ecanxy' ,ecanxy ) + call mpas_pool_get_array(output_noahmp,'edirxy' ,edirxy ) + call mpas_pool_get_array(output_noahmp,'etranxy' ,etranxy ) + call mpas_pool_get_array(output_noahmp,'fsaxy' ,fsaxy ) + call mpas_pool_get_array(output_noahmp,'firaxy' ,firaxy ) + call mpas_pool_get_array(output_noahmp,'aparxy' ,aparxy ) + call mpas_pool_get_array(output_noahmp,'psnxy' ,psnxy ) + call mpas_pool_get_array(output_noahmp,'savxy' ,savxy ) + call mpas_pool_get_array(output_noahmp,'sagxy' ,sagxy ) + call mpas_pool_get_array(output_noahmp,'rssunxy' ,rssunxy ) + call mpas_pool_get_array(output_noahmp,'rsshaxy' ,rsshaxy ) + call mpas_pool_get_array(output_noahmp,'bgapxy' ,bgapxy ) + call mpas_pool_get_array(output_noahmp,'wgapxy' ,wgapxy ) + call mpas_pool_get_array(output_noahmp,'tgvxy' ,tgvxy ) + call mpas_pool_get_array(output_noahmp,'tgbxy' ,tgbxy ) + call mpas_pool_get_array(output_noahmp,'chvxy' ,chvxy ) + call mpas_pool_get_array(output_noahmp,'chbxy' ,chbxy ) + call mpas_pool_get_array(output_noahmp,'shgxy' ,shgxy ) + call mpas_pool_get_array(output_noahmp,'shcxy' ,shcxy ) + call mpas_pool_get_array(output_noahmp,'shbxy' ,shbxy ) + call mpas_pool_get_array(output_noahmp,'evgxy' ,evgxy ) + call mpas_pool_get_array(output_noahmp,'evbxy' ,evbxy ) + call mpas_pool_get_array(output_noahmp,'ghvxy' ,ghvxy ) + call mpas_pool_get_array(output_noahmp,'ghbxy' ,ghbxy ) + call mpas_pool_get_array(output_noahmp,'irgxy' ,irgxy ) + call mpas_pool_get_array(output_noahmp,'ircxy' ,ircxy ) + call mpas_pool_get_array(output_noahmp,'irbxy' ,irbxy ) + call mpas_pool_get_array(output_noahmp,'trxy' ,trxy ) + call mpas_pool_get_array(output_noahmp,'evcxy' ,evcxy ) + call mpas_pool_get_array(output_noahmp,'chleafxy',chleafxy) + call mpas_pool_get_array(output_noahmp,'chucxy' ,chucxy ) + call mpas_pool_get_array(output_noahmp,'chv2xy' ,chv2xy ) + call mpas_pool_get_array(output_noahmp,'chb2xy' ,chb2xy ) + call mpas_pool_get_array(output_noahmp,'rs' ,rs ) + call mpas_pool_get_array(output_noahmp,'qtdrain',qtdrain ) + + do i = its,ite + mpas_noahmp%tradxy(i) = tradxy(i) + mpas_noahmp%neexy(i) = neexy(i) + mpas_noahmp%gppxy(i) = gppxy(i) + mpas_noahmp%nppxy(i) = nppxy(i) + mpas_noahmp%fvegxy(i) = fvegxy(i) + mpas_noahmp%runsfxy(i) = runsfxy(i) + mpas_noahmp%runsbxy(i) = runsbxy(i) + mpas_noahmp%ecanxy(i) = ecanxy(i) + mpas_noahmp%edirxy(i) = edirxy(i) + mpas_noahmp%etranxy(i) = etranxy(i) + mpas_noahmp%fsaxy(i) = fsaxy(i) + mpas_noahmp%firaxy(i) = firaxy(i) + mpas_noahmp%aparxy(i) = aparxy(i) + mpas_noahmp%psnxy(i) = psnxy(i) + mpas_noahmp%savxy(i) = savxy(i) + mpas_noahmp%sagxy(i) = sagxy(i) + mpas_noahmp%rssunxy(i) = rssunxy(i) + mpas_noahmp%rsshaxy(i) = rsshaxy(i) + mpas_noahmp%bgapxy(i) = bgapxy(i) + mpas_noahmp%wgapxy(i) = wgapxy(i) + mpas_noahmp%tgvxy(i) = tgvxy(i) + mpas_noahmp%tgbxy(i) = tgbxy(i) + mpas_noahmp%chvxy(i) = chvxy(i) + mpas_noahmp%chbxy(i) = chbxy(i) + mpas_noahmp%shgxy(i) = shgxy(i) + mpas_noahmp%shcxy(i) = shcxy(i) + mpas_noahmp%shbxy(i) = shbxy(i) + mpas_noahmp%evgxy(i) = evgxy(i) + mpas_noahmp%evbxy(i) = evbxy(i) + mpas_noahmp%ghvxy(i) = ghvxy(i) + mpas_noahmp%ghbxy(i) = ghbxy(i) + mpas_noahmp%irgxy(i) = irgxy(i) + mpas_noahmp%ircxy(i) = ircxy(i) + mpas_noahmp%irbxy(i) = irbxy(i) + mpas_noahmp%trxy(i) = trxy(i) + mpas_noahmp%evcxy(i) = evcxy(i) + mpas_noahmp%chleafxy(i) = chleafxy(i) + mpas_noahmp%chucxy(i) = chucxy(i) + mpas_noahmp%chv2xy(i) = chv2xy(i) + mpas_noahmp%chb2xy(i) = chb2xy(i) + mpas_noahmp%rs(i) = rs(i) + mpas_noahmp%qtdrain(i) = qtdrain(i) + enddo + + + !--- update of OUT additional variables, i.e. see lines 292-334 in module NoahmpIOVarType.F90: + call mpas_pool_get_array(output_noahmp,'pahxy' ,pahxy ) + call mpas_pool_get_array(output_noahmp,'pahgxy' ,pahgxy ) + call mpas_pool_get_array(output_noahmp,'pahbxy' ,pahbxy ) + call mpas_pool_get_array(output_noahmp,'pahvxy' ,pahvxy ) + call mpas_pool_get_array(output_noahmp,'qintsxy' ,qintsxy ) + call mpas_pool_get_array(output_noahmp,'qintrxy' ,qintrxy ) + call mpas_pool_get_array(output_noahmp,'qdripsxy' ,qdripsxy ) + call mpas_pool_get_array(output_noahmp,'qdriprxy' ,qdriprxy ) + call mpas_pool_get_array(output_noahmp,'qthrosxy' ,qthrosxy ) + call mpas_pool_get_array(output_noahmp,'qthrorxy' ,qthrorxy ) + call mpas_pool_get_array(output_noahmp,'qsnsubxy' ,qsnsubxy ) + call mpas_pool_get_array(output_noahmp,'qmeltxy' ,qmeltxy ) + call mpas_pool_get_array(output_noahmp,'qsnfroxy' ,qsnfroxy ) + call mpas_pool_get_array(output_noahmp,'qsubcxy' ,qsubcxy ) + call mpas_pool_get_array(output_noahmp,'qfrocxy' ,qfrocxy ) + call mpas_pool_get_array(output_noahmp,'qevacxy' ,qevacxy ) + call mpas_pool_get_array(output_noahmp,'qdewcxy' ,qdewcxy ) + call mpas_pool_get_array(output_noahmp,'qfrzcxy' ,qfrzcxy ) + call mpas_pool_get_array(output_noahmp,'qmeltcxy' ,qmeltcxy ) + call mpas_pool_get_array(output_noahmp,'qsnbotxy' ,qsnbotxy ) + call mpas_pool_get_array(output_noahmp,'pondingxy' ,pondingxy ) + call mpas_pool_get_array(output_noahmp,'fpicexy' ,fpicexy ) + call mpas_pool_get_array(output_noahmp,'rainlsm' ,rainlsm ) + call mpas_pool_get_array(output_noahmp,'snowlsm' ,snowlsm ) + call mpas_pool_get_array(output_noahmp,'forctlsm' ,forctlsm ) + call mpas_pool_get_array(output_noahmp,'forcqlsm' ,forcqlsm ) + call mpas_pool_get_array(output_noahmp,'forcplsm' ,forcplsm ) + call mpas_pool_get_array(output_noahmp,'forczlsm' ,forczlsm ) + call mpas_pool_get_array(output_noahmp,'forcwlsm' ,forcwlsm ) + call mpas_pool_get_array(output_noahmp,'acc_ssoilxy' ,acc_ssoilxy ) + call mpas_pool_get_array(output_noahmp,'acc_qinsurxy',acc_qinsurxy ) + call mpas_pool_get_array(output_noahmp,'acc_qsevaxy' ,acc_qsevaxy ) + call mpas_pool_get_array(output_noahmp,'eflxbxy' ,eflxbxy ) + call mpas_pool_get_array(output_noahmp,'soilenergy' ,soilenergy ) + call mpas_pool_get_array(output_noahmp,'snowenergy' ,snowenergy ) + call mpas_pool_get_array(output_noahmp,'canhsxy' ,canhsxy ) + call mpas_pool_get_array(output_noahmp,'acc_dwaterxy',acc_dwaterxy ) + call mpas_pool_get_array(output_noahmp,'acc_prcpxy' ,acc_prcpxy ) + call mpas_pool_get_array(output_noahmp,'acc_ecanxy' ,acc_ecanxy ) + call mpas_pool_get_array(output_noahmp,'acc_etranxy' ,acc_etranxy ) + call mpas_pool_get_array(output_noahmp,'acc_edirxy' ,acc_edirxy ) + call mpas_pool_get_array(output_noahmp,'acc_etranixy',acc_etranixy ) + + do i = its,ite + mpas_noahmp%pahxy(i) = pahxy(i) + mpas_noahmp%pahgxy(i) = pahgxy(i) + mpas_noahmp%pahbxy(i) = pahbxy(i) + mpas_noahmp%pahvxy(i) = pahvxy(i) + mpas_noahmp%qintsxy(i) = qintsxy(i) + mpas_noahmp%qintrxy(i) = qintrxy(i) + mpas_noahmp%qdripsxy(i) = qdripsxy(i) + mpas_noahmp%qdriprxy(i) = qdriprxy(i) + mpas_noahmp%qthrosxy(i) = qthrosxy(i) + mpas_noahmp%qthrorxy(i) = qthrorxy(i) + mpas_noahmp%qsnsubxy(i) = qsnsubxy(i) + mpas_noahmp%qmeltxy(i) = qmeltxy(i) + mpas_noahmp%qsnfroxy(i) = qsnfroxy(i) + mpas_noahmp%qsubcxy(i) = qsubcxy(i) + mpas_noahmp%qfrocxy(i) = qfrocxy(i) + mpas_noahmp%qevacxy(i) = qevacxy(i) + mpas_noahmp%qdewcxy(i) = qdewcxy(i) + mpas_noahmp%qfrzcxy(i) = qfrzcxy(i) + mpas_noahmp%qmeltcxy(i) = qmeltcxy(i) + mpas_noahmp%qsnbotxy(i) = qsnbotxy(i) + mpas_noahmp%pondingxy(i) = pondingxy(i) + mpas_noahmp%fpicexy(i) = fpicexy(i) + mpas_noahmp%rainlsm(i) = rainlsm(i) + mpas_noahmp%snowlsm(i) = snowlsm(i) + mpas_noahmp%forctlsm(i) = forctlsm(i) + mpas_noahmp%forcqlsm(i) = forcqlsm(i) + mpas_noahmp%forcplsm(i) = forcplsm(i) + mpas_noahmp%forczlsm(i) = forczlsm(i) + mpas_noahmp%forcwlsm(i) = forcwlsm(i) + mpas_noahmp%acc_ssoilxy(i) = acc_ssoilxy(i) + mpas_noahmp%acc_qinsurxy(i) = acc_qinsurxy(i) + mpas_noahmp%acc_qsevaxy(i) = acc_qsevaxy(i) + mpas_noahmp%eflxbxy(i) = eflxbxy(i) + mpas_noahmp%soilenergy(i) = soilenergy(i) + mpas_noahmp%snowenergy(i) = snowenergy(i) + mpas_noahmp%canhsxy(i) = canhsxy(i) + mpas_noahmp%acc_dwaterxy(i) = acc_dwaterxy(i) + mpas_noahmp%acc_prcpxy(i) = acc_prcpxy(i) + mpas_noahmp%acc_ecanxy(i) = acc_ecanxy(i) + mpas_noahmp%acc_etranxy(i) = acc_etranxy(i) + mpas_noahmp%acc_edirxy(i) = acc_edirxy(i) +! real(kind=kind_noahmp), allocatable, dimension(:,:) :: acc_etranixy + enddo + +!call mpas_log_write('--- end subroutine lsm_noahmp_fromMPAS.') + + end subroutine lsm_noahmp_fromMPAS + +!================================================================================================================= + subroutine lsm_noahmp_sounding_fromMPAS(mesh,state,time_lev,diag) +!================================================================================================================= + +!--- input arguments: + type(mpas_pool_type),intent(in):: mesh + type(mpas_pool_type),intent(in):: diag + type(mpas_pool_type),intent(in):: state + + integer,intent(in):: time_lev + + +!--- local variables and arrays: + integer:: i,its,ite,k,kts,kte + integer,pointer:: index_qv + + real(kind=RKIND),dimension(:,:),pointer:: zgrid + real(kind=RKIND),dimension(:,:),pointer:: qv,theta_m,u,v + real(kind=RKIND),dimension(:,:),pointer:: exner,pressure_b,pressure_p + real(kind=RKIND),dimension(:,:,:),pointer:: scalars + + real(kind=RKIND):: fzm,fzp,mult,totm,totp + real(kind=RKIND):: w1,w2,z0,z1,z2 + +!----------------------------------------------------------------------------------------------------------------- +!call mpas_log_write('--- enter subroutine lsm_noahmp_sounding_fromMPAS: $i',intArgs=(/time_lev/)) + + +!--- initialization of local dimensions: + its = mpas_noahmp%its + ite = mpas_noahmp%ite + kts = mpas_noahmp%kts + kte = mpas_noahmp%kte + + +!--- initialization of input sounding variables: + call mpas_pool_get_array(mesh,'zgrid',zgrid) + + call mpas_pool_get_array(diag,'exner' ,exner ) + call mpas_pool_get_array(diag,'pressure_base' ,pressure_b) + call mpas_pool_get_array(diag,'pressure_p' ,pressure_p) + call mpas_pool_get_array(diag,'uReconstructZonal' ,u ) + call mpas_pool_get_array(diag,'uReconstructMeridional',v ) + + call mpas_pool_get_array(state,'theta_m',theta_m,time_lev) + call mpas_pool_get_array(state,'scalars',scalars,time_lev) + + call mpas_pool_get_dimension(state,'index_qv',index_qv) + qv => scalars(index_qv,:,:) + + do i = its,ite + do k = kts,kte + mpas_noahmp%dz8w(i,k) = zgrid(k+1,i)-zgrid(k,i) + mpas_noahmp%qv_curr(i,k) = qv(k,i) + mpas_noahmp%t_phy(i,k) = (theta_m(k,i)/(1.+R_v/R_d*qv(k,i)))*exner(k,i) + mpas_noahmp%u_phy(i,k) = u(k,i) + mpas_noahmp%v_phy(i,k) = v(k,i) + enddo + enddo + + +!--- initialization of pressure at interface between layers: + do i = its,ite + k = kts + z0 = zgrid(k,i) + z1 = 0.5*(zgrid(k,i)+zgrid(k+1,i)) + z2 = 0.5*(zgrid(k+1,i)+zgrid(k+2,i)) + w1 = (z0-z2)/(z1-z2) + w2 = 1.-w1 + totm = pressure_p(k,i)+pressure_b(k,i) + totp = pressure_p(k+1,i)+pressure_b(k+1,i) + mpas_noahmp%p8w(i,k) = w1*totm + w2*totp + + do k = kts+1,kte + totm = pressure_p(k-1,i)+pressure_b(k-1,i) + totp = pressure_p(k,i)+pressure_b(k,i) + mult = 1./(zgrid(k+1,i)-zgrid(k-1,i)) + fzm = mult*(zgrid(k,i)-zgrid(k-1,i)) + fzp = mult*(zgrid(k+1,i)-zgrid(k,i)) + mpas_noahmp%p8w(i,k) = fzm*totp + fzp*totm + enddo + enddo + +!call mpas_log_write('--- end subroutine lsm_noahmp_sounding_fromMPAS:') + + end subroutine lsm_noahmp_sounding_fromMPAS + +!================================================================================================================= + subroutine lsm_noahmp_toMPAS(diag_physics,diag_physics_noahmp,output_noahmp,sfc_input) +!================================================================================================================= + +!--- input arguments: + type(mpas_pool_type),intent(inout):: diag_physics + type(mpas_pool_type),intent(inout):: diag_physics_noahmp + type(mpas_pool_type),intent(inout):: output_noahmp + type(mpas_pool_type),intent(inout):: sfc_input + + +!--- local variables and arrays: + integer:: i,its,ite + integer:: n,ns,nsoil,nsnow,nzsnow + + +!--- local INOUT pointers (with generic LSM equivalent as defined in WRF): + real(kind=RKIND),dimension(:),pointer:: acsnom,acsnow,canwat,hfx,qfx,qsfc,lh,grdflx,sfc_albedo,sfc_emiss, & + sfcrunoff,skintemp,smstav,smstot,udrunoff,snow,snowc,snowh,lai,z0, & + znt + real(kind=RKIND),dimension(:,:),pointer:: sh2o,smois,tslb + + + !--- local INOUT pointers (with no Noah LSM equivalent as defined in WRF): + integer,dimension(:),pointer:: isnowxy + real(kind=RKIND),dimension(:),pointer:: tvxy,tgxy,canicexy,canliqxy,eahxy,tahxy,cmxy,chxy,fwetxy,sneqvoxy, & + alboldxy,qsnowxy,qrainxy,wslakexy,zwtxy,waxy,wtxy,deeprechxy, & + rechxy,lfmassxy,rtmassxy,stmassxy,woodxy,grainxy,gddxy,stblcpxy, & + fastcpxy,xsaixy,taussxy + real(kind=RKIND),dimension(:,:),pointer:: tsnoxy,zsnsoxy,snicexy,snliqxy + + +!--- local OUT pointers (with no Noah LSM equivalent as defined in WRF): + real(kind=RKIND),dimension(:),pointer:: t2mvxy,t2mbxy,t2mxy,q2mvxy,q2mbxy,q2mxy,tradxy,neexy,gppxy,nppxy, & + fvegxy,runsfxy,runsbxy,ecanxy,edirxy,etranxy,fsaxy,firaxy,aparxy, & + psnxy,savxy,sagxy,rssunxy,rsshaxy,bgapxy,wgapxy,tgvxy,tgbxy,chvxy, & + chbxy,shgxy,shcxy,shbxy,evgxy,evbxy,ghvxy,ghbxy,irgxy,ircxy,irbxy, & + trxy,evcxy,chleafxy,chucxy,chv2xy,chb2xy,rs,qtdrain + + +!--- local OUT additional variables: + real(kind=RKIND),dimension(:),pointer:: pahxy,pahgxy,pahbxy,pahvxy,qintsxy,qintrxy,qdripsxy,qdriprxy, & + qthrosxy,qthrorxy,qsnsubxy,qmeltxy,qsnfroxy,qsubcxy,qfrocxy, & + qevacxy,qdewcxy,qfrzcxy,qmeltcxy,qsnbotxy,pondingxy,fpicexy, & + rainlsm,snowlsm,forctlsm,forcqlsm,forcplsm,forczlsm,forcwlsm, & + acc_ssoilxy,acc_qinsurxy,acc_qsevaxy,eflxbxy,soilenergy,snowenergy, & + canhsxy,acc_dwaterxy,acc_prcpxy,acc_ecanxy,acc_etranxy,acc_edirxy + real(kind=RKIND),dimension(:,:),pointer:: acc_etranixy + +!----------------------------------------------------------------------------------------------------------------- +!call mpas_log_write('--- enter subroutine lsm_noahmp_toMPAS:') + + +!--- initialization of local dimensions: + its = mpas_noahmp%its + ite = mpas_noahmp%ite + nsoil = mpas_noahmp%nsoil + nsnow = mpas_noahmp%nsnow + nzsnow = nsnow + nsoil + + +!--- update of INOUT variables (with generic LSM equivalent as defined in WRF), i.e. see +! lines 162-184 in module NoahmpIOVarType.F90): + call mpas_pool_get_array(sfc_input,'skintemp',skintemp) + call mpas_pool_get_array(sfc_input,'snowc' ,snowc ) + call mpas_pool_get_array(sfc_input,'snow' ,snow ) + call mpas_pool_get_array(sfc_input,'snowh' ,snowh ) + call mpas_pool_get_array(sfc_input,'sh2o' ,sh2o ) + 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,'hfx' ,hfx ) + call mpas_pool_get_array(diag_physics,'qfx' ,qfx ) + call mpas_pool_get_array(diag_physics,'lh ' ,lh ) + call mpas_pool_get_array(diag_physics,'grdflx' ,grdflx ) + 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,'sfcrunoff' ,sfcrunoff ) + call mpas_pool_get_array(diag_physics,'udrunoff' ,udrunoff ) + call mpas_pool_get_array(diag_physics,'sfc_albedo',sfc_albedo) + call mpas_pool_get_array(diag_physics,'canwat' ,canwat ) + 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,'sfc_emiss' ,sfc_emiss ) + call mpas_pool_get_array(diag_physics,'qsfc' ,qsfc ) + call mpas_pool_get_array(diag_physics,'lai' ,lai ) + call mpas_pool_get_array(diag_physics,'z0' ,z0 ) + call mpas_pool_get_array(diag_physics,'znt' ,znt ) + + + do i = its,ite + skintemp(i) = mpas_noahmp%tsk(i) + hfx(i) = mpas_noahmp%hfx(i) + qfx(i) = mpas_noahmp%qfx(i) + lh(i) = mpas_noahmp%lh(i) + grdflx(i) = mpas_noahmp%grdflx(i) + smstav(i) = mpas_noahmp%smstav(i) + smstot(i) = mpas_noahmp%smstot(i) + sfcrunoff(i) = mpas_noahmp%sfcrunoff(i) + udrunoff(i) = mpas_noahmp%udrunoff(i) + sfc_albedo(i) = mpas_noahmp%albedo(i) + snowc(i) = mpas_noahmp%snowc(i) + snow(i) = mpas_noahmp%snow(i) + snowh(i) = mpas_noahmp%snowh(i) + canwat(i) = mpas_noahmp%canwat(i) + acsnom(i) = mpas_noahmp%acsnom(i) + acsnow(i) = mpas_noahmp%acsnow(i) + sfc_emiss(i) = mpas_noahmp%emiss(i) + qsfc(i) = mpas_noahmp%qsfc(i) + lai(i) = mpas_noahmp%lai(i) + z0(i) = mpas_noahmp%z0(i) + znt(i) = mpas_noahmp%znt(i) + enddo + + do ns = 1,nsoil + do i = its,ite + sh2o(ns,i) = mpas_noahmp%sh2o(i,ns) + smois(ns,i) = mpas_noahmp%smois(i,ns) + tslb(ns,i) = mpas_noahmp%tslb(i,ns) + enddo + enddo + + +!--- update of INOUT variables (with no Noah LSM equivalent as defined in WRF), i.e. see +! lines 186-222 in module NoahmpIOVarType.F90: + call mpas_pool_get_array(diag_physics_noahmp,'isnowxy' ,isnowxy ) + call mpas_pool_get_array(diag_physics_noahmp,'tvxy' ,tvxy ) + call mpas_pool_get_array(diag_physics_noahmp,'tgxy' ,tgxy ) + call mpas_pool_get_array(diag_physics_noahmp,'canicexy' ,canicexy ) + call mpas_pool_get_array(diag_physics_noahmp,'canliqxy' ,canliqxy ) + call mpas_pool_get_array(diag_physics_noahmp,'eahxy' ,eahxy ) + call mpas_pool_get_array(diag_physics_noahmp,'tahxy' ,tahxy ) + call mpas_pool_get_array(diag_physics_noahmp,'cmxy' ,cmxy ) + call mpas_pool_get_array(diag_physics_noahmp,'chxy' ,chxy ) + call mpas_pool_get_array(diag_physics_noahmp,'fwetxy' ,fwetxy ) + call mpas_pool_get_array(diag_physics_noahmp,'sneqvoxy' ,sneqvoxy ) + call mpas_pool_get_array(diag_physics_noahmp,'alboldxy' ,alboldxy ) + call mpas_pool_get_array(diag_physics_noahmp,'qsnowxy' ,qsnowxy ) + call mpas_pool_get_array(diag_physics_noahmp,'qrainxy' ,qrainxy ) + call mpas_pool_get_array(diag_physics_noahmp,'wslakexy' ,wslakexy ) + call mpas_pool_get_array(diag_physics_noahmp,'zwtxy' ,zwtxy ) + call mpas_pool_get_array(diag_physics_noahmp,'waxy' ,waxy ) + call mpas_pool_get_array(diag_physics_noahmp,'wtxy' ,wtxy ) + call mpas_pool_get_array(diag_physics_noahmp,'deeprechxy',deeprechxy ) + call mpas_pool_get_array(diag_physics_noahmp,'rechxy' ,rechxy ) + call mpas_pool_get_array(diag_physics_noahmp,'tsnoxy' ,tsnoxy ) + call mpas_pool_get_array(diag_physics_noahmp,'zsnsoxy' ,zsnsoxy ) + call mpas_pool_get_array(diag_physics_noahmp,'snicexy' ,snicexy ) + call mpas_pool_get_array(diag_physics_noahmp,'snliqxy' ,snliqxy ) + call mpas_pool_get_array(diag_physics_noahmp,'lfmassxy' ,lfmassxy ) + call mpas_pool_get_array(diag_physics_noahmp,'rtmassxy' ,rtmassxy ) + call mpas_pool_get_array(diag_physics_noahmp,'stmassxy' ,stmassxy ) + call mpas_pool_get_array(diag_physics_noahmp,'woodxy' ,woodxy ) + call mpas_pool_get_array(diag_physics_noahmp,'grainxy' ,grainxy ) + call mpas_pool_get_array(diag_physics_noahmp,'gddxy' ,gddxy ) + call mpas_pool_get_array(diag_physics_noahmp,'stblcpxy' ,stblcpxy ) + call mpas_pool_get_array(diag_physics_noahmp,'fastcpxy' ,fastcpxy ) + call mpas_pool_get_array(diag_physics_noahmp,'xsaixy' ,xsaixy ) + call mpas_pool_get_array(diag_physics_noahmp,'taussxy' ,taussxy ) + + do i = its,ite + isnowxy(i) = mpas_noahmp%isnowxy(i) + tvxy(i) = mpas_noahmp%tvxy(i) + tgxy(i) = mpas_noahmp%tgxy(i) + canicexy(i) = mpas_noahmp%canicexy(i) + canliqxy(i) = mpas_noahmp%canliqxy(i) + eahxy(i) = mpas_noahmp%eahxy(i) + tahxy(i) = mpas_noahmp%tahxy(i) + cmxy(i) = mpas_noahmp%cmxy(i) + chxy(i) = mpas_noahmp%chxy(i) + fwetxy(i) = mpas_noahmp%fwetxy(i) + sneqvoxy(i) = mpas_noahmp%sneqvoxy(i) + alboldxy(i) = mpas_noahmp%alboldxy(i) + qsnowxy(i) = mpas_noahmp%qsnowxy(i) + qrainxy(i) = mpas_noahmp%qrainxy(i) + wslakexy(i) = mpas_noahmp%wslakexy(i) + zwtxy(i) = mpas_noahmp%zwtxy(i) + waxy(i) = mpas_noahmp%waxy(i) + wtxy(i) = mpas_noahmp%wtxy(i) + deeprechxy(i) = mpas_noahmp%deeprechxy(i) + rechxy(i) = mpas_noahmp%rechxy(i) + lfmassxy(i) = mpas_noahmp%lfmassxy(i) + rtmassxy(i) = mpas_noahmp%rtmassxy(i) + stmassxy(i) = mpas_noahmp%stmassxy(i) + woodxy(i) = mpas_noahmp%woodxy(i) + grainxy(i) = mpas_noahmp%grainxy(i) + gddxy(i) = mpas_noahmp%gddxy(i) + stblcpxy(i) = mpas_noahmp%stblcpxy(i) + fastcpxy(i) = mpas_noahmp%fastcpxy(i) + xsaixy(i) = mpas_noahmp%xsaixy(i) + taussxy(i) = mpas_noahmp%taussxy(i) + + do ns = 1,nsnow + n = ns - nsnow + tsnoxy(ns,i) = mpas_noahmp%tsnoxy(i,n) + snicexy(ns,i) = mpas_noahmp%snicexy(i,n) + snliqxy(ns,i) = mpas_noahmp%snliqxy(i,n) + enddo + do ns = 1,nsnow + n = ns - nsnow + zsnsoxy(ns,i) = mpas_noahmp%zsnsoxy(i,n) + enddo + do ns = nsnow+1,nzsnow + n = ns - nsoil + 1 + zsnsoxy(ns,i) = mpas_noahmp%zsnsoxy(i,n) + enddo + enddo + + +!--- update of OUT (with no Noah LSM equivalent as defined in WRF), i.e. see +! lines 242-290 in module NoahmpIOVarType.F90: + call mpas_pool_get_array(output_noahmp,'t2mvxy' ,t2mvxy ) + call mpas_pool_get_array(output_noahmp,'t2mbxy' ,t2mbxy ) + call mpas_pool_get_array(output_noahmp,'t2mxy' ,t2mxy ) + call mpas_pool_get_array(output_noahmp,'q2mvxy' ,q2mvxy ) + call mpas_pool_get_array(output_noahmp,'q2mbxy' ,q2mbxy ) + call mpas_pool_get_array(output_noahmp,'q2mxy' ,q2mxy ) + call mpas_pool_get_array(output_noahmp,'tradxy' ,tradxy ) + call mpas_pool_get_array(output_noahmp,'neexy' ,neexy ) + call mpas_pool_get_array(output_noahmp,'gppxy' ,gppxy ) + call mpas_pool_get_array(output_noahmp,'nppxy' ,nppxy ) + call mpas_pool_get_array(output_noahmp,'fvegxy' ,fvegxy ) + call mpas_pool_get_array(output_noahmp,'runsfxy' ,runsfxy ) + call mpas_pool_get_array(output_noahmp,'runsbxy' ,runsbxy ) + call mpas_pool_get_array(output_noahmp,'ecanxy' ,ecanxy ) + call mpas_pool_get_array(output_noahmp,'edirxy' ,edirxy ) + call mpas_pool_get_array(output_noahmp,'etranxy' ,etranxy ) + call mpas_pool_get_array(output_noahmp,'fsaxy' ,fsaxy ) + call mpas_pool_get_array(output_noahmp,'firaxy' ,firaxy ) + call mpas_pool_get_array(output_noahmp,'aparxy' ,aparxy ) + call mpas_pool_get_array(output_noahmp,'psnxy' ,psnxy ) + call mpas_pool_get_array(output_noahmp,'savxy' ,savxy ) + call mpas_pool_get_array(output_noahmp,'sagxy' ,sagxy ) + call mpas_pool_get_array(output_noahmp,'rssunxy' ,rssunxy ) + call mpas_pool_get_array(output_noahmp,'rsshaxy' ,rsshaxy ) + call mpas_pool_get_array(output_noahmp,'bgapxy' ,bgapxy ) + call mpas_pool_get_array(output_noahmp,'wgapxy' ,wgapxy ) + call mpas_pool_get_array(output_noahmp,'tgvxy' ,tgvxy ) + call mpas_pool_get_array(output_noahmp,'tgbxy' ,tgbxy ) + call mpas_pool_get_array(output_noahmp,'chvxy' ,chvxy ) + call mpas_pool_get_array(output_noahmp,'chbxy' ,chbxy ) + call mpas_pool_get_array(output_noahmp,'shgxy' ,shgxy ) + call mpas_pool_get_array(output_noahmp,'shcxy' ,shcxy ) + call mpas_pool_get_array(output_noahmp,'shbxy' ,shbxy ) + call mpas_pool_get_array(output_noahmp,'evgxy' ,evgxy ) + call mpas_pool_get_array(output_noahmp,'evbxy' ,evbxy ) + call mpas_pool_get_array(output_noahmp,'ghvxy' ,ghvxy ) + call mpas_pool_get_array(output_noahmp,'ghbxy' ,ghbxy ) + call mpas_pool_get_array(output_noahmp,'irgxy' ,irgxy ) + call mpas_pool_get_array(output_noahmp,'ircxy' ,ircxy ) + call mpas_pool_get_array(output_noahmp,'irbxy' ,irbxy ) + call mpas_pool_get_array(output_noahmp,'trxy' ,trxy ) + call mpas_pool_get_array(output_noahmp,'evcxy' ,evcxy ) + call mpas_pool_get_array(output_noahmp,'chleafxy',chleafxy) + call mpas_pool_get_array(output_noahmp,'chucxy' ,chucxy ) + call mpas_pool_get_array(output_noahmp,'chv2xy' ,chv2xy ) + call mpas_pool_get_array(output_noahmp,'chb2xy' ,chb2xy ) + call mpas_pool_get_array(output_noahmp,'rs' ,rs ) + call mpas_pool_get_array(output_noahmp,'qtdrain',qtdrain ) + + do i = its,ite + t2mvxy(i) = mpas_noahmp%t2mvxy(i) + t2mbxy(i) = mpas_noahmp%t2mbxy(i) + t2mxy(i) = mpas_noahmp%t2mxy(i) + q2mvxy(i) = mpas_noahmp%q2mvxy(i) + q2mbxy(i) = mpas_noahmp%q2mbxy(i) + q2mxy(i) = mpas_noahmp%q2mxy(i) + tradxy(i) = mpas_noahmp%tradxy(i) + neexy(i) = mpas_noahmp%neexy(i) + gppxy(i) = mpas_noahmp%gppxy(i) + nppxy(i) = mpas_noahmp%nppxy(i) + fvegxy(i) = mpas_noahmp%fvegxy(i) + runsfxy(i) = mpas_noahmp%runsfxy(i) + runsbxy(i) = mpas_noahmp%runsbxy(i) + ecanxy(i) = mpas_noahmp%ecanxy(i) + edirxy(i) = mpas_noahmp%edirxy(i) + etranxy(i) = mpas_noahmp%etranxy(i) + fsaxy(i) = mpas_noahmp%fsaxy(i) + firaxy(i) = mpas_noahmp%firaxy(i) + aparxy(i) = mpas_noahmp%aparxy(i) + psnxy(i) = mpas_noahmp%psnxy(i) + savxy(i) = mpas_noahmp%savxy(i) + sagxy(i) = mpas_noahmp%sagxy(i) + rssunxy(i) = mpas_noahmp%rssunxy(i) + rsshaxy(i) = mpas_noahmp%rsshaxy(i) + bgapxy(i) = mpas_noahmp%bgapxy(i) + wgapxy(i) = mpas_noahmp%wgapxy(i) + tgvxy(i) = mpas_noahmp%tgvxy(i) + tgbxy(i) = mpas_noahmp%tgbxy(i) + chvxy(i) = mpas_noahmp%chvxy(i) + chbxy(i) = mpas_noahmp%chbxy(i) + shgxy(i) = mpas_noahmp%shgxy(i) + shcxy(i) = mpas_noahmp%shcxy(i) + shbxy(i) = mpas_noahmp%shbxy(i) + evgxy(i) = mpas_noahmp%evgxy(i) + evbxy(i) = mpas_noahmp%evbxy(i) + ghvxy(i) = mpas_noahmp%ghvxy(i) + ghbxy(i) = mpas_noahmp%ghbxy(i) + irgxy(i) = mpas_noahmp%irgxy(i) + ircxy(i) = mpas_noahmp%ircxy(i) + irbxy(i) = mpas_noahmp%irbxy(i) + trxy(i) = mpas_noahmp%trxy(i) + evcxy(i) = mpas_noahmp%evcxy(i) + chleafxy(i) = mpas_noahmp%chleafxy(i) + chucxy(i) = mpas_noahmp%chucxy(i) + chv2xy(i) = mpas_noahmp%chv2xy(i) + chb2xy(i) = mpas_noahmp%chb2xy(i) + rs(i) = mpas_noahmp%rs(i) + qtdrain(i) = mpas_noahmp%qtdrain(i) + enddo + + +!--- update of OUT additional variables, i.e. see lines 292-334 in module NoahmpIOVarType.F90: + call mpas_pool_get_array(output_noahmp,'pahxy' ,pahxy ) + call mpas_pool_get_array(output_noahmp,'pahgxy' ,pahgxy ) + call mpas_pool_get_array(output_noahmp,'pahbxy' ,pahbxy ) + call mpas_pool_get_array(output_noahmp,'pahvxy' ,pahvxy ) + call mpas_pool_get_array(output_noahmp,'qintsxy' ,qintsxy ) + call mpas_pool_get_array(output_noahmp,'qintrxy' ,qintrxy ) + call mpas_pool_get_array(output_noahmp,'qdripsxy' ,qdripsxy ) + call mpas_pool_get_array(output_noahmp,'qdriprxy' ,qdriprxy ) + call mpas_pool_get_array(output_noahmp,'qthrosxy' ,qthrosxy ) + call mpas_pool_get_array(output_noahmp,'qthrorxy' ,qthrorxy ) + call mpas_pool_get_array(output_noahmp,'qsnsubxy' ,qsnsubxy ) + call mpas_pool_get_array(output_noahmp,'qmeltxy' ,qmeltxy ) + call mpas_pool_get_array(output_noahmp,'qsnfroxy' ,qsnfroxy ) + call mpas_pool_get_array(output_noahmp,'qsubcxy' ,qsubcxy ) + call mpas_pool_get_array(output_noahmp,'qfrocxy' ,qfrocxy ) + call mpas_pool_get_array(output_noahmp,'qevacxy' ,qevacxy ) + call mpas_pool_get_array(output_noahmp,'qdewcxy' ,qdewcxy ) + call mpas_pool_get_array(output_noahmp,'qfrzcxy' ,qfrzcxy ) + call mpas_pool_get_array(output_noahmp,'qmeltcxy' ,qmeltcxy ) + call mpas_pool_get_array(output_noahmp,'qsnbotxy' ,qsnbotxy ) + call mpas_pool_get_array(output_noahmp,'pondingxy' ,pondingxy ) + call mpas_pool_get_array(output_noahmp,'fpicexy' ,fpicexy ) + call mpas_pool_get_array(output_noahmp,'rainlsm' ,rainlsm ) + call mpas_pool_get_array(output_noahmp,'snowlsm' ,snowlsm ) + call mpas_pool_get_array(output_noahmp,'forctlsm' ,forctlsm ) + call mpas_pool_get_array(output_noahmp,'forcqlsm' ,forcqlsm ) + call mpas_pool_get_array(output_noahmp,'forcplsm' ,forcplsm ) + call mpas_pool_get_array(output_noahmp,'forczlsm' ,forczlsm ) + call mpas_pool_get_array(output_noahmp,'forcwlsm' ,forcwlsm ) + call mpas_pool_get_array(output_noahmp,'acc_ssoilxy' ,acc_ssoilxy ) + call mpas_pool_get_array(output_noahmp,'acc_qinsurxy',acc_qinsurxy ) + call mpas_pool_get_array(output_noahmp,'acc_qsevaxy' ,acc_qsevaxy ) + call mpas_pool_get_array(output_noahmp,'eflxbxy' ,eflxbxy ) + call mpas_pool_get_array(output_noahmp,'soilenergy' ,soilenergy ) + call mpas_pool_get_array(output_noahmp,'snowenergy' ,snowenergy ) + call mpas_pool_get_array(output_noahmp,'canhsxy' ,canhsxy ) + call mpas_pool_get_array(output_noahmp,'acc_dwaterxy',acc_dwaterxy ) + call mpas_pool_get_array(output_noahmp,'acc_prcpxy' ,acc_prcpxy ) + call mpas_pool_get_array(output_noahmp,'acc_ecanxy' ,acc_ecanxy ) + call mpas_pool_get_array(output_noahmp,'acc_etranxy' ,acc_etranxy ) + call mpas_pool_get_array(output_noahmp,'acc_edirxy' ,acc_edirxy ) + call mpas_pool_get_array(output_noahmp,'acc_etranixy',acc_etranixy ) + + do i = its,ite + pahxy(i) = mpas_noahmp%pahxy(i) + pahgxy(i) = mpas_noahmp%pahgxy(i) + pahbxy(i) = mpas_noahmp%pahbxy(i) + pahvxy(i) = mpas_noahmp%pahvxy(i) + qintsxy(i) = mpas_noahmp%qintsxy(i) + qintrxy(i) = mpas_noahmp%qintrxy(i) + qdripsxy(i) = mpas_noahmp%qdripsxy(i) + qdriprxy(i) = mpas_noahmp%qdriprxy(i) + qthrosxy(i) = mpas_noahmp%qthrosxy(i) + qthrorxy(i) = mpas_noahmp%qthrorxy(i) + qsnsubxy(i) = mpas_noahmp%qsnsubxy(i) + qmeltxy(i) = mpas_noahmp%qmeltxy(i) + qsnfroxy(i) = mpas_noahmp%qsnfroxy(i) + qsubcxy(i) = mpas_noahmp%qsubcxy(i) + qfrocxy(i) = mpas_noahmp%qfrocxy(i) + qevacxy(i) = mpas_noahmp%qevacxy(i) + qdewcxy(i) = mpas_noahmp%qdewcxy(i) + qfrzcxy(i) = mpas_noahmp%qfrzcxy(i) + qmeltcxy(i) = mpas_noahmp%qmeltcxy(i) + qsnbotxy(i) = mpas_noahmp%qsnbotxy(i) + pondingxy(i) = mpas_noahmp%pondingxy(i) + fpicexy(i) = mpas_noahmp%fpicexy(i) + rainlsm(i) = mpas_noahmp%rainlsm(i) + snowlsm(i) = mpas_noahmp%snowlsm(i) + forctlsm(i) = mpas_noahmp%forctlsm(i) + forcqlsm(i) = mpas_noahmp%forcqlsm(i) + forcplsm(i) = mpas_noahmp%forcplsm(i) + forczlsm(i) = mpas_noahmp%forczlsm(i) + forcwlsm(i) = mpas_noahmp%forcwlsm(i) + acc_ssoilxy(i) = mpas_noahmp%acc_ssoilxy(i) + acc_qinsurxy(i) = mpas_noahmp%acc_qinsurxy(i) + acc_qsevaxy(i) = mpas_noahmp%acc_qsevaxy(i) + eflxbxy(i) = mpas_noahmp%eflxbxy(i) + soilenergy(i) = mpas_noahmp%soilenergy(i) + snowenergy(i) = mpas_noahmp%snowenergy(i) + canhsxy(i) = mpas_noahmp%canhsxy(i) + acc_dwaterxy(i) = mpas_noahmp%acc_dwaterxy(i) + acc_prcpxy(i) = mpas_noahmp%acc_prcpxy(i) + acc_ecanxy(i) = mpas_noahmp%acc_ecanxy(i) + acc_etranxy(i) = mpas_noahmp%acc_etranxy(i) + acc_edirxy(i) = mpas_noahmp%acc_edirxy(i) +! real(kind=kind_noahmp), allocatable, dimension(:,:) :: acc_etranixy + enddo + +!call mpas_log_write('--- end subroutine lsm_noahmp_toMPAS:') + + end subroutine lsm_noahmp_toMPAS + +!================================================================================================================= + subroutine driver_lsm_noahmp(configs,mesh,state,time_lev,diag,diag_physics,diag_physics_noahmp,output_noahmp, & + sfc_input,itimestep,its,ite) +!================================================================================================================= + +!--- input arguments: + type(mpas_pool_type),intent(in):: configs + type(mpas_pool_type),intent(in):: mesh + type(mpas_pool_type),intent(in):: diag + type(mpas_pool_type),intent(in):: state + + integer,intent(in):: itimestep,its,ite + integer,intent(in):: time_lev + +!--- inout arguments: + type(mpas_pool_type),intent(inout):: diag_physics + type(mpas_pool_type),intent(inout):: diag_physics_noahmp + type(mpas_pool_type),intent(inout):: output_noahmp + type(mpas_pool_type),intent(inout):: sfc_input + + +!----------------------------------------------------------------------------------------------------------------- +!call mpas_log_write(' ') +!call mpas_log_write('--- enter subroutine driver_lsm_noahmp:') + + call lsm_noahmp_fromMPAS(configs,mesh,diag,diag_physics,diag_physics_noahmp,output_noahmp,sfc_input, & + state,time_lev,itimestep) + + call NoahmpDriverMain(mpas_noahmp) + + call lsm_noahmp_toMPAS(diag_physics,diag_physics_noahmp,output_noahmp,sfc_input) + +!call mpas_log_write('--- end subroutine driver_lsm_noahmp:') + + end subroutine driver_lsm_noahmp + +!================================================================================================================= + end module mpas_atmphys_driver_lsm_noahmp +!================================================================================================================= diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_microphysics.F b/src/core_atmosphere/physics/mpas_atmphys_driver_microphysics.F index 9282f1406..b2e172dad 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_driver_microphysics.F +++ b/src/core_atmosphere/physics/mpas_atmphys_driver_microphysics.F @@ -28,7 +28,7 @@ module mpas_atmphys_driver_microphysics public:: allocate_microphysics, & deallocate_microphysics, & driver_microphysics, & - microphysics_init + init_microphysics !MPAS driver for parameterization of cloud microphysics processes. @@ -87,9 +87,6 @@ module mpas_atmphys_driver_microphysics ! pointer to config_microp_scheme. ! Laura D. Fowler (laura@ucar.edu) / 2917-02-16. -! * implemented fro WRF a cloud top temperature estimation -! Saulo R. Freitas (saulo.freitas@inpe.br) / 2025-01-20 -! !--- initialization option for WSM6 from WRF version 3.8.1. this option could also be set as a namelist parameter. integer,parameter:: hail_opt = 0 @@ -112,32 +109,29 @@ subroutine allocate_microphysics(configs) call mpas_pool_get_config(configs,'config_microp_scheme',microp_scheme) !sounding variables: - if(.not.allocated(rho_p) ) allocate(rho_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(th_p) ) allocate(th_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(pi_p) ) allocate(pi_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(pres_p) ) allocate(pres_p(ims:ime,kms:kme,jms:jme)) - if(.not.allocated(z_p) ) allocate(z_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(dz_p) ) allocate(dz_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(w_p) ) allocate(w_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(rho_p) ) allocate(rho_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(th_p) ) allocate(th_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(pi_p) ) allocate(pi_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(pres_p)) allocate(pres_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(z_p) ) allocate(z_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(dz_p) ) allocate(dz_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(w_p) ) allocate(w_p(ims:ime,kms:kme,jms:jme) ) !mass mixing ratios: - if(.not.allocated(qv_p) ) allocate(qv_p(ims:ime,kms:kme,jms:jme)) - if(.not.allocated(qc_p) ) allocate(qc_p(ims:ime,kms:kme,jms:jme)) - if(.not.allocated(qr_p) ) allocate(qr_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(qv_p)) allocate(qv_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(qc_p)) allocate(qc_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(qr_p)) allocate(qr_p(ims:ime,kms:kme,jms:jme)) !surface precipitation: if(.not.allocated(rainnc_p) ) allocate(rainnc_p(ims:ime,jms:jme) ) if(.not.allocated(rainncv_p)) allocate(rainncv_p(ims:ime,jms:jme)) - if(.not.allocated(ctt_p) ) allocate(ctt_p(ims:ime,jms:jme) ) - - microp_select: select case(microp_scheme) - - case ("mp_thompson","mp_wsm6") + microp_select: select case(trim(microp_scheme)) + case ("mp_thompson","mp_thompson_aerosols","mp_wsm6") !mass mixing ratios: - if(.not.allocated(qi_p) ) allocate(qi_p(ims:ime,kms:kme,jms:jme)) - if(.not.allocated(qs_p) ) allocate(qs_p(ims:ime,kms:kme,jms:jme)) - if(.not.allocated(qg_p) ) allocate(qg_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(qi_p)) allocate(qi_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(qs_p)) allocate(qs_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(qg_p)) allocate(qg_p(ims:ime,kms:kme,jms:jme)) !surface precipitation: if(.not.allocated(sr_p) ) allocate(sr_p(ims:ime,jms:jme) ) @@ -147,28 +141,36 @@ subroutine allocate_microphysics(configs) if(.not.allocated(graupelncv_p)) allocate(graupelncv_p(ims:ime,jms:jme)) !cloud water,cloud ice,and snow effective radii: - if(.not.allocated(recloud_p) ) allocate(recloud_p(ims:ime,kms:kme,jms:jme)) - if(.not.allocated(reice_p) ) allocate(reice_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(resnow_p) ) allocate(resnow_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(recloud_p)) allocate(recloud_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(reice_p) ) allocate(reice_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(resnow_p) ) allocate(resnow_p(ims:ime,kms:kme,jms:jme) ) - microp2_select: select case(microp_scheme) + !precipitation flux: + if(.not.allocated(rainprod_p)) allocate(rainprod_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(evapprod_p)) allocate(evapprod_p(ims:ime,kms:kme,jms:jme)) - case("mp_thompson") - !number concentrations: + microp2_select: select case(trim(microp_scheme)) + case("mp_thompson","mp_thompson_aerosols") if(.not.allocated(ntc_p)) allocate(ntc_p(ims:ime,jms:jme)) if(.not.allocated(muc_p)) allocate(muc_p(ims:ime,jms:jme)) if(.not.allocated(ni_p) ) allocate(ni_p(ims:ime,kms:kme,jms:jme)) if(.not.allocated(nr_p) ) allocate(nr_p(ims:ime,kms:kme,jms:jme)) - if(.not.allocated(rainprod_p)) allocate(rainprod_p(ims:ime,kms:kme,jms:jme)) - if(.not.allocated(evapprod_p)) allocate(evapprod_p(ims:ime,kms:kme,jms:jme)) + microp3_select: select case(trim(microp_scheme)) + case("mp_thompson_aerosols") + if(.not.allocated(nifa2d_p)) allocate(nifa2d_p(ims:ime,jms:jme)) + if(.not.allocated(nwfa2d_p)) allocate(nwfa2d_p(ims:ime,jms:jme)) + if(.not.allocated(nc_p) ) allocate(nc_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(nifa_p) ) allocate(nifa_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(nwfa_p) ) allocate(nwfa_p(ims:ime,kms:kme,jms:jme)) - case default + case default + end select microp3_select + case default end select microp2_select case default - end select microp_select end subroutine allocate_microphysics @@ -188,68 +190,74 @@ subroutine deallocate_microphysics(configs) call mpas_pool_get_config(configs,'config_microp_scheme',microp_scheme) !sounding variables: - if(allocated(rho_p) ) deallocate(rho_p ) - if(allocated(th_p) ) deallocate(th_p ) - if(allocated(pi_p) ) deallocate(pi_p ) - if(allocated(pres_p) ) deallocate(pres_p ) - if(allocated(z_p) ) deallocate(z_p ) - if(allocated(dz_p) ) deallocate(dz_p ) - if(allocated(w_p) ) deallocate(w_p ) + if(allocated(rho_p) ) deallocate(rho_p ) + if(allocated(th_p) ) deallocate(th_p ) + if(allocated(pi_p) ) deallocate(pi_p ) + if(allocated(pres_p)) deallocate(pres_p) + if(allocated(z_p) ) deallocate(z_p ) + if(allocated(dz_p) ) deallocate(dz_p ) + if(allocated(w_p) ) deallocate(w_p ) !mass mixing ratios: - if(allocated(qv_p) ) deallocate(qv_p ) - if(allocated(qc_p) ) deallocate(qc_p ) - if(allocated(qr_p) ) deallocate(qr_p ) + if(allocated(qv_p)) deallocate(qv_p) + if(allocated(qc_p)) deallocate(qc_p) + if(allocated(qr_p)) deallocate(qr_p) !surface precipitation: - if(allocated(rainnc_p) ) deallocate(rainnc_p ) - if(allocated(rainncv_p) ) deallocate(rainncv_p ) - if(allocated(ctt_p) ) deallocate(ctt_p ) - - microp_select: select case(microp_scheme) + if(allocated(rainnc_p) ) deallocate(rainnc_p ) + if(allocated(rainncv_p)) deallocate(rainncv_p) - case ("mp_thompson","mp_wsm6") + microp_select: select case(trim(microp_scheme)) + case ("mp_thompson","mp_thompson_aerosols","mp_wsm6") !mass mixing ratios: - if(allocated(qi_p) ) deallocate(qi_p ) - if(allocated(qs_p) ) deallocate(qs_p ) - if(allocated(qg_p) ) deallocate(qg_p ) + if(allocated(qi_p)) deallocate(qi_p) + if(allocated(qs_p)) deallocate(qs_p) + if(allocated(qg_p)) deallocate(qg_p) !surface precipitation: - if(allocated(sr_p) ) deallocate(sr_p ) - if(allocated(snownc_p) ) deallocate(snownc_p ) - if(allocated(snowncv_p) ) deallocate(snowncv_p ) - if(allocated(graupelnc_p) ) deallocate(graupelnc_p ) - if(allocated(graupelncv_p) ) deallocate(graupelncv_p ) + if(allocated(sr_p) ) deallocate(sr_p ) + if(allocated(snownc_p) ) deallocate(snownc_p ) + if(allocated(snowncv_p) ) deallocate(snowncv_p ) + if(allocated(graupelnc_p) ) deallocate(graupelnc_p ) + if(allocated(graupelncv_p)) deallocate(graupelncv_p) !cloud water,cloud ice,and snow effective radii: - if(allocated(recloud_p) ) deallocate(recloud_p ) - if(allocated(reice_p) ) deallocate(reice_p ) - if(allocated(resnow_p) ) deallocate(resnow_p ) + if(allocated(recloud_p)) deallocate(recloud_p) + if(allocated(reice_p) ) deallocate(reice_p ) + if(allocated(resnow_p) ) deallocate(resnow_p ) - microp2_select: select case(microp_scheme) + !precipitation flux: + if(allocated(rainprod_p)) deallocate(rainprod_p) + if(allocated(evapprod_p)) deallocate(evapprod_p) - case("mp_thompson") - !number concentrations: + microp2_select: select case(trim(microp_scheme)) + case("mp_thompson","mp_thompson_aerosols") if(allocated(ntc_p)) deallocate(ntc_p) if(allocated(muc_p)) deallocate(muc_p) if(allocated(ni_p) ) deallocate(ni_p ) if(allocated(nr_p) ) deallocate(nr_p ) - if(allocated(rainprod_p)) deallocate(rainprod_p) - if(allocated(evapprod_p)) deallocate(evapprod_p) + microp3_select: select case(trim(microp_scheme)) + case("mp_thompson_aerosols") + if(allocated(nifa2d_p)) deallocate(nifa2d_p) + if(allocated(nwfa2d_p)) deallocate(nwfa2d_p) + if(allocated(nc_p) ) deallocate(nc_p ) + if(allocated(nifa_p) ) deallocate(nifa_p ) + if(allocated(nwfa_p) ) deallocate(nwfa_p ) - case default + case default + end select microp3_select + case default end select microp2_select case default - end select microp_select end subroutine deallocate_microphysics !================================================================================================================= - subroutine microphysics_init(dminfo,configs,mesh,sfc_input,diag_physics) + subroutine init_microphysics(dminfo,configs,mesh,state,time_lev,sfc_input,diag_physics) !================================================================================================================= !input arguments: @@ -257,11 +265,14 @@ subroutine microphysics_init(dminfo,configs,mesh,sfc_input,diag_physics) type(mpas_pool_type),intent(in):: configs type(mpas_pool_type),intent(in):: mesh type(mpas_pool_type),intent(in):: sfc_input + integer,intent(in):: time_lev !inout arguments: type(mpas_pool_type),intent(inout):: diag_physics + type(mpas_pool_type),intent(inout):: state !local pointer: + logical,pointer:: do_restart character(len=StrKIND),pointer:: microp_scheme !CCPP-compliant flags: @@ -269,31 +280,41 @@ subroutine microphysics_init(dminfo,configs,mesh,sfc_input,diag_physics) integer:: errflg !----------------------------------------------------------------------------------------------------------------- +!call mpas_log_write(' ') +!call mpas_log_write('--- enter subroutine init_microphysics:') !initialization of CCPP-compliant flags: errmsg = ' ' errflg = 0 call mpas_pool_get_config(configs,'config_microp_scheme',microp_scheme) + call mpas_pool_get_config(configs,'config_do_restart' ,do_restart ) - microp_select: select case(microp_scheme) + microp_select: select case(trim(microp_scheme)) + case("mp_thompson","mp_thompson_aerosols") + call thompson_init(l_mp_tables) + call init_thompson_clouddroplets_forMPAS(mesh,sfc_input,diag_physics) - case("mp_thompson") - call thompson_init(l_mp_tables) - call init_thompson_clouddroplets_forMPAS(mesh,sfc_input,diag_physics) + microp2_select: select case(trim(microp_scheme)) + case("mp_thompson_aerosols") + call init_thompson_aerosols_forMPAS(do_restart,dminfo,mesh,state,time_lev,diag_physics) - case("mp_wsm6") - call mp_wsm6_init(den0=rho_a,denr=rho_r,dens=rho_s,cl=cliq,cpv=cpv, & - hail_opt=hail_opt,errmsg=errmsg,errflg=errflg) + case default + end select microp2_select - case default + case("mp_wsm6") + call mp_wsm6_init(den0=rho_a,denr=rho_r,dens=rho_s,cl=cliq,cpv=cpv, & + hail_opt=hail_opt,errmsg=errmsg,errflg=errflg) - end select microp_select + case default + end select microp_select + +!call mpas_log_write('--- end subroutine init_microphysics:') - end subroutine microphysics_init + end subroutine init_microphysics !================================================================================================================= - subroutine driver_microphysics(configs,mesh,state,time_lev,diag,diag_physics,tend,itimestep,its,ite) + subroutine driver_microphysics(configs,mesh,state,time_lev,diag,diag_physics,tend_physics,tend,itimestep,its,ite) !================================================================================================================= use mpas_constants, only : rvord @@ -310,6 +331,7 @@ subroutine driver_microphysics(configs,mesh,state,time_lev,diag,diag_physics,ten type(mpas_pool_type),intent(inout):: state type(mpas_pool_type),intent(inout):: diag type(mpas_pool_type),intent(inout):: diag_physics + type(mpas_pool_type),intent(inout):: tend_physics type(mpas_pool_type),intent(inout):: tend !local pointers: @@ -342,13 +364,12 @@ subroutine driver_microphysics(configs,mesh,state,time_lev,diag,diag_physics,ten call precip_from_MPAS(configs,diag_physics,its,ite) !... initialization of soundings for non-hydrostatic dynamical cores. - call microphysics_from_MPAS(configs,mesh,state,time_lev,diag,diag_physics,its,ite) + call microphysics_from_MPAS(configs,mesh,state,time_lev,diag,diag_physics,tend_physics,its,ite) !... call to different cloud microphysics schemes: - microp_select: select case(microp_scheme) - + microp_select: select case(trim(microp_scheme)) case ("mp_kessler") - call mpas_timer_start('Kessler') + call mpas_timer_start('mp_kessler') call kessler( & t = th_p , qv = qv_p , qc = qc_p , & qr = qr_p , rho = rho_p , pii = pi_p , & @@ -361,11 +382,11 @@ subroutine driver_microphysics(configs,mesh,state,time_lev,diag,diag_physics,ten 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('Kessler') + call mpas_timer_stop('mp_kessler') case ("mp_thompson") + call mpas_timer_start('mp_thompson') istep = 1 - call mpas_timer_start('Thompson') do while (istep .le. n_microp) call mp_gt_driver( & th = th_p , qv = qv_p , qc = qc_p , & @@ -378,14 +399,40 @@ subroutine driver_microphysics(configs,mesh,state,time_lev,diag,diag_physics,ten sr = sr_p , rainprod = rainprod_p , evapprod = evapprod_p , & re_cloud = recloud_p , re_ice = reice_p , re_snow = resnow_p , & has_reqc = has_reqc , has_reqi = has_reqi , has_reqs = has_reqs , & - ntc = ntc_p , muc = muc_p , & + ntc = ntc_p , muc = muc_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 & ) istep = istep + 1 enddo - call mpas_timer_stop('Thompson') + call mpas_timer_stop('mp_thompson') + + case ("mp_thompson_aerosols") + call mpas_timer_start('mp_thompson_aerosols') + istep = 1 + do while (istep .le. n_microp) + call mp_gt_driver( & + th = th_p , qv = qv_p , qc = qc_p , & + qr = qr_p , qi = qi_p , qs = qs_p , & + qg = qg_p , ni = ni_p , nr = nr_p , & + pii = pi_p , p = pres_p , dz = dz_p , & + w = w_p , dt_in = dt_microp , itimestep = itimestep , & + rainnc = rainnc_p , rainncv = rainncv_p , snownc = snownc_p , & + snowncv = snowncv_p , graupelnc = graupelnc_p , graupelncv = graupelncv_p , & + sr = sr_p , rainprod = rainprod_p , evapprod = evapprod_p , & + re_cloud = recloud_p , re_ice = reice_p , re_snow = resnow_p , & + has_reqc = has_reqc , has_reqi = has_reqi , has_reqs = has_reqs , & + nc = nc_p , nifa = nifa_p , nwfa = nwfa_p , & + nifa2d = nifa2d_p , nwfa2d = nwfa2d_p , ntc = ntc_p , & + muc = muc_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 & + ) + istep = istep + 1 + enddo + call mpas_timer_stop('mp_thompson_aerosols') case ("mp_wsm6") call mpas_timer_start('mp_wsm6') @@ -414,16 +461,15 @@ subroutine driver_microphysics(configs,mesh,state,time_lev,diag,diag_physics,ten call mpas_timer_stop('mp_wsm6') case default - end select microp_select !... calculate the 10cm radar reflectivity and relative humidity, if needed: if (l_diags) then - !ensure that we only call compute_radar_reflectivity() if we are using an MPS that supports !the computation of simulated radar reflectivity: if(trim(microp_scheme) == "mp_wsm6" .or. & - trim(microp_scheme) == "mp_thompson") then + trim(microp_scheme) == "mp_thompson" .or. & + trim(microp_scheme) == "mp_thompson_aerosols") then call compute_radar_reflectivity(configs,diag_physics,its,ite) else call mpas_log_write('*** NOTICE: NOT computing simulated radar reflectivity') @@ -433,22 +479,14 @@ subroutine driver_microphysics(configs,mesh,state,time_lev,diag,diag_physics,ten !calculate the relative humidity over water if the temperature is strictly greater than 0.C, !over ice otherwise. call compute_relhum(diag,its,ite) - end if -!... diagnostic the clout top temperature - call wrfcttcalc(pres_p = pres_p, pi_p = pi_p, th_p = th_p, qci = qi_p , qcw = qc_p , & - qvp = qv_p, ght = z_p, ctt = ctt_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 ) - !... copy updated precipitation from the wrf-physics grid back to the geodesic-dynamics grid: call precip_to_MPAS(configs,diag_physics,its,ite) !... copy updated cloud microphysics variables from the wrf-physics grid back to the geodesic- ! dynamics grid: - call microphysics_to_MPAS(configs,mesh,state,time_lev,diag,diag_physics,tend,itimestep,its,ite) + call microphysics_to_MPAS(configs,mesh,state,time_lev,diag,diag_physics,tend_physics,tend,its,ite) !... deallocation of all microphysics arrays: !$OMP BARRIER @@ -502,9 +540,8 @@ subroutine precip_from_MPAS(configs,diag_physics,its,ite) enddo !variables specific to different cloud microphysics schemes: - microp_select: select case(microp_scheme) - - case ("mp_thompson","mp_wsm6") + microp_select: select case(trim(microp_scheme)) + case ("mp_thompson","mp_thompson_aerosols","mp_wsm6") do j = jts, jte do i = its, ite snowncv_p(i,j) = 0._RKIND @@ -512,7 +549,6 @@ subroutine precip_from_MPAS(configs,diag_physics,its,ite) snownc_p(i,j) = 0._RKIND graupelnc_p(i,j) = 0._RKIND sr_p(i,j) = 0._RKIND - ctt_p(i,j) = 0._RKIND enddo enddo @@ -523,7 +559,6 @@ subroutine precip_from_MPAS(configs,diag_physics,its,ite) enddo case default - end select microp_select end subroutine precip_from_MPAS @@ -544,7 +579,7 @@ subroutine precip_to_MPAS(configs,diag_physics,its,ite) integer,dimension(:),pointer:: i_rainnc real(kind=RKIND),pointer:: config_bucket_rainnc - real(kind=RKIND),dimension(:),pointer:: precipw,precipci,ctt + real(kind=RKIND),dimension(:),pointer:: precipw real(kind=RKIND),dimension(:),pointer:: graupelnc,rainnc,snownc real(kind=RKIND),dimension(:),pointer:: graupelncv,rainncv,snowncv,sr @@ -566,12 +601,9 @@ subroutine precip_to_MPAS(configs,diag_physics,its,ite) call mpas_pool_get_array(diag_physics,'snownc' ,snownc ) call mpas_pool_get_array(diag_physics,'snowncv' ,snowncv ) call mpas_pool_get_array(diag_physics,'sr' ,sr ) - call mpas_pool_get_array(diag_physics,'ctt' ,ctt ) - call mpas_pool_get_array(diag_physics,'precipci' ,precipci ) do i = its,ite precipw(i) = 0._RKIND - precipci(i)= 0._RKIND enddo !variables common to all cloud microphysics schemes: @@ -598,18 +630,15 @@ subroutine precip_to_MPAS(configs,diag_physics,its,ite) enddo enddo - + !CR: negative rainc values correction: - !where (rainnc < 0._RKIND) - ! rainnc = 0._RKIND - !endwhere - - + where (rainnc < 0._RKIND) + rainnc = 0._RKIND + endwhere !variables specific to different cloud microphysics schemes: - microp_select_init: select case(microp_scheme) - - case ("mp_thompson","mp_wsm6") + microp_select: select case(trim(microp_scheme)) + case ("mp_thompson","mp_thompson_aerosols","mp_wsm6") do j = jts,jte do i = its,ite !time-step precipitation: @@ -620,19 +649,11 @@ subroutine precip_to_MPAS(configs,diag_physics,its,ite) !accumulated precipitation: snownc(i) = snownc(i) + snowncv(i) graupelnc(i) = graupelnc(i) + graupelncv(i) - !-srf adding column ice and cloud content, like precipw - do k = kts,kte - rho_a = rho_p(i,k,j) / (1._RKIND + qv_p(i,k,j)) - precipci(i) = precipci(i) + (qc_p(i,k,j) + qi_p(i,k,j)) * rho_a * dz_p(i,k,j) - enddo - !-srf adding cloud top temperature - ctt(i) = ctt_p(i,j) enddo enddo case default - - end select microp_select_init + end select microp_select end subroutine precip_to_MPAS @@ -649,6 +670,7 @@ subroutine compute_radar_reflectivity(configs,diag_physics,its,ite) !local pointers: character(len=StrKIND),pointer:: microp_scheme + real(kind=RKIND),dimension(:,:),pointer:: refl10cm real(kind=RKIND),dimension(:),pointer:: refl10cm_max,refl10cm_1km,refl10cm_1km_max !local variables and arrays: @@ -660,12 +682,12 @@ subroutine compute_radar_reflectivity(configs,diag_physics,its,ite) call mpas_pool_get_config(configs,'config_microp_scheme',microp_scheme) + call mpas_pool_get_array(diag_physics,'refl10cm',refl10cm) call mpas_pool_get_array(diag_physics,'refl10cm_max',refl10cm_max) call mpas_pool_get_array(diag_physics,'refl10cm_1km',refl10cm_1km) call mpas_pool_get_array(diag_physics,'refl10cm_1km_max',refl10cm_1km_max) - microp_select: select case(microp_scheme) - + microp_select: select case(trim(microp_scheme)) case ("mp_kessler") call physics_error_fatal('--- calculation of radar reflectivity is not available' // & 'with kessler cloud microphysics') @@ -690,7 +712,7 @@ subroutine compute_radar_reflectivity(configs,diag_physics,its,ite) qs1d(k) = qs_p(i,k,j) qg1d(k) = qg_p(i,k,j) dBZ1d(k) = -35._RKIND - zp(k) = z_p(i,k,j) - z_p(i,1,j)+0.5*dz_p(i,1,j) ! height AGL + zp(k) = z_p(i,k,j) - z_p(i,1,j) + 0.5*dz_p(i,k,j) ! height AGL enddo call refl10cm_wsm6(qv1d,qr1d,qs1d,qg1d,t1d,p1d,dBZ1d,kts,kte) @@ -698,6 +720,7 @@ subroutine compute_radar_reflectivity(configs,diag_physics,its,ite) kp = 1 do k = kts,kte dBZ1d(k) = max(-35._RKIND,dBZ1d(k)) + refl10cm(k,i) = dBZ1d(k) if(zp(k) .lt. 1000.) kp = k enddo refl10cm_max(i) = maxval(dBZ1d(:)) @@ -717,7 +740,7 @@ subroutine compute_radar_reflectivity(configs,diag_physics,its,ite) if(allocated(dBz1d)) deallocate(dBZ1d) if(allocated(zp) ) deallocate(zp ) - case ("mp_thompson") + case ("mp_thompson","mp_thompson_aerosols") if(.not.allocated(p1d) ) allocate(p1d(kts:kte) ) if(.not.allocated(t1d) ) allocate(t1d(kts:kte) ) if(.not.allocated(qv1d) ) allocate(qv1d(kts:kte) ) @@ -741,7 +764,7 @@ subroutine compute_radar_reflectivity(configs,diag_physics,its,ite) qg1d(k) = qg_p(i,k,j) nr1d(k) = nr_p(i,k,j) dBZ1d(k) = -35._RKIND - zp(k) = z_p(i,k,j) - z_p(i,1,j)+0.5*dz_p(i,1,j) ! height AGL + zp(k) = z_p(i,k,j) - z_p(i,1,j) + 0.5*dz_p(i,k,j) ! height AGL enddo call calc_refl10cm(qv1d,qc1d,qr1d,nr1d,qs1d,qg1d,t1d,p1d,dBZ1d,kts,kte,i,j) @@ -749,6 +772,7 @@ subroutine compute_radar_reflectivity(configs,diag_physics,its,ite) kp = 1 do k = kts,kte dBZ1d(k) = max(-35._RKIND,dBZ1d(k)) + refl10cm(k,i) = dBZ1d(k) if(zp(k) .lt. 1000.) kp = k enddo refl10cm_max(i) = maxval(dBZ1d(:)) @@ -771,7 +795,6 @@ subroutine compute_radar_reflectivity(configs,diag_physics,its,ite) if(allocated(zp) ) deallocate(zp ) case default - end select microp_select end subroutine compute_radar_reflectivity diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_pbl.F b/src/core_atmosphere/physics/mpas_atmphys_driver_pbl.F index 6969ff6e5..72a411aeb 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_driver_pbl.F +++ b/src/core_atmosphere/physics/mpas_atmphys_driver_pbl.F @@ -127,60 +127,61 @@ subroutine allocate_pbl(configs) case("bl_ysu") !from surface-layer model: - if(.not.allocated(br_p) ) allocate(br_p(ims:ime,jms:jme) ) - if(.not.allocated(ctopo_p) ) allocate(ctopo_p(ims:ime,jms:jme) ) - if(.not.allocated(ctopo2_p) ) allocate(ctopo2_p(ims:ime,jms:jme) ) - if(.not.allocated(delta_p) ) allocate(delta_p(ims:ime,jms:jme) ) - if(.not.allocated(psih_p) ) allocate(psih_p(ims:ime,jms:jme) ) - if(.not.allocated(psim_p) ) allocate(psim_p(ims:ime,jms:jme) ) - if(.not.allocated(u10_p) ) allocate(u10_p(ims:ime,jms:jme) ) - if(.not.allocated(v10_p) ) allocate(v10_p(ims:ime,jms:jme) ) - if(.not.allocated(exch_p) ) allocate(exch_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(wstar_p) ) allocate(wstar_p(ims:ime,jms:jme) ) + if(.not.allocated(br_p) ) allocate(br_p(ims:ime,jms:jme) ) + if(.not.allocated(ctopo_p) ) allocate(ctopo_p(ims:ime,jms:jme) ) + if(.not.allocated(ctopo2_p)) allocate(ctopo2_p(ims:ime,jms:jme) ) + if(.not.allocated(delta_p) ) allocate(delta_p(ims:ime,jms:jme) ) + if(.not.allocated(psih_p) ) allocate(psih_p(ims:ime,jms:jme) ) + if(.not.allocated(psim_p) ) allocate(psim_p(ims:ime,jms:jme) ) + if(.not.allocated(u10_p) ) allocate(u10_p(ims:ime,jms:jme) ) + if(.not.allocated(v10_p) ) allocate(v10_p(ims:ime,jms:jme) ) + if(.not.allocated(exch_p) ) allocate(exch_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(wstar_p) ) allocate(wstar_p(ims:ime,jms:jme) ) case("bl_mynn") - if(.not.allocated(kbl_plume_p) ) allocate(kbl_plume_p(ims:ime,jms:jme) ) - - if(.not.allocated(dx_p) ) allocate(dx_p(ims:ime,jms:jme) ) - if(.not.allocated(ch_p) ) allocate(ch_p(ims:ime,jms:jme) ) - if(.not.allocated(qsfc_p) ) allocate(qsfc_p(ims:ime,jms:jme) ) - if(.not.allocated(rmol_p) ) allocate(rmol_p(ims:ime,jms:jme) ) - if(.not.allocated(tsk_p) ) allocate(tsk_p(ims:ime,jms:jme) ) - if(.not.allocated(maxwidthbl_p) ) allocate(maxwidthbl_p(ims:ime,jms:jme) ) - if(.not.allocated(maxmfbl_p) ) allocate(maxmfbl_p(ims:ime,jms:jme) ) - if(.not.allocated(zbl_plume_p) ) allocate(zbl_plume_p(ims:ime,jms:jme) ) - - if(.not.allocated(cov_p) ) allocate(cov_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(qke_p) ) allocate(qke_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(qsq_p) ) allocate(qsq_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(tsq_p) ) allocate(tsq_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(qkeadv_p) ) allocate(qkeadv_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(elpbl_p) ) allocate(elpbl_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(tkepbl_p) ) allocate(tkepbl_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(sh3d_p) ) allocate(sh3d_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(sm3d_p) ) allocate(sm3d_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(dqke_p) ) allocate(dqke_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(qbuoy_p) ) allocate(qbuoy_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(qdiss_p) ) allocate(qdiss_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(qshear_p) ) allocate(qshear_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(qwt_p) ) allocate(qwt_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(qcbl_p) ) allocate(qcbl_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(qibl_p) ) allocate(qibl_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(cldfrabl_p) ) allocate(cldfrabl_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(edmfa_p) ) allocate(edmfa_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(edmfw_p) ) allocate(edmfw_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(edmfqt_p) ) allocate(edmfqt_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(edmfthl_p) ) allocate(edmfthl_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(edmfent_p) ) allocate(edmfent_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(edmfqc_p) ) allocate(edmfqc_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(subthl_p) ) allocate(subthl_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(subqv_p) ) allocate(subqv_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(detthl_p) ) allocate(detthl_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(detqv_p) ) allocate(detqv_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(kbl_plume_p) ) allocate(kbl_plume_p(ims:ime,jms:jme) ) + if(.not.allocated(dx_p) ) allocate(dx_p(ims:ime,jms:jme) ) + if(.not.allocated(ch_p) ) allocate(ch_p(ims:ime,jms:jme) ) + if(.not.allocated(qsfc_p) ) allocate(qsfc_p(ims:ime,jms:jme) ) + if(.not.allocated(rmol_p) ) allocate(rmol_p(ims:ime,jms:jme) ) + if(.not.allocated(tsk_p) ) allocate(tsk_p(ims:ime,jms:jme) ) + if(.not.allocated(maxwidthbl_p)) allocate(maxwidthbl_p(ims:ime,jms:jme) ) + if(.not.allocated(maxmfbl_p) ) allocate(maxmfbl_p(ims:ime,jms:jme) ) + if(.not.allocated(zbl_plume_p) ) allocate(zbl_plume_p(ims:ime,jms:jme) ) + if(.not.allocated(cov_p) ) allocate(cov_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(qke_p) ) allocate(qke_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(qsq_p) ) allocate(qsq_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(tsq_p) ) allocate(tsq_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(qkeadv_p) ) allocate(qkeadv_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(elpbl_p) ) allocate(elpbl_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(tkepbl_p) ) allocate(tkepbl_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(sh3d_p) ) allocate(sh3d_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(sm3d_p) ) allocate(sm3d_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(dqke_p) ) allocate(dqke_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(qbuoy_p) ) allocate(qbuoy_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(qdiss_p) ) allocate(qdiss_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(qshear_p) ) allocate(qshear_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(qwt_p) ) allocate(qwt_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(qcbl_p) ) allocate(qcbl_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(qibl_p) ) allocate(qibl_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(cldfrabl_p) ) allocate(cldfrabl_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(edmfa_p) ) allocate(edmfa_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(edmfw_p) ) allocate(edmfw_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(edmfqt_p) ) allocate(edmfqt_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(edmfthl_p) ) allocate(edmfthl_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(edmfent_p) ) allocate(edmfent_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(edmfqc_p) ) allocate(edmfqc_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(subthl_p) ) allocate(subthl_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(subqv_p) ) allocate(subqv_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(detthl_p) ) allocate(detthl_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(detqv_p) ) allocate(detqv_p(ims:ime,kms:kme,jms:jme) ) !additional tendencies: - if(.not.allocated(rqsblten_p) ) allocate(rqsblten_p(ims:ime,kms:kme,jms:jme) ) - if(.not.allocated(rniblten_p) ) allocate(rniblten_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(rqsblten_p) ) allocate(rqsblten_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(rncblten_p) ) allocate(rncblten_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(rniblten_p) ) allocate(rniblten_p(ims:ime,kms:kme,jms:jme) ) + if(.not.allocated(rnifablten_p)) allocate(rnifablten_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(rnwfablten_p)) allocate(rnwfablten_p(ims:ime,kms:kme,jms:jme)) !allocation of additional arrays: if(.not.allocated(pattern_spp_pbl)) allocate(pattern_spp_pbl(ims:ime,kms:kme,jms:jme)) @@ -235,60 +236,62 @@ subroutine deallocate_pbl(configs) case("bl_ysu") !from surface-layer model: - if(allocated(br_p) ) deallocate(br_p ) - if(allocated(ctopo_p) ) deallocate(ctopo_p ) - if(allocated(ctopo2_p) ) deallocate(ctopo2_p ) - if(allocated(delta_p) ) deallocate(delta_p ) - if(allocated(psih_p) ) deallocate(psih_p ) - if(allocated(psim_p) ) deallocate(psim_p ) - if(allocated(u10_p) ) deallocate(u10_p ) - if(allocated(v10_p) ) deallocate(v10_p ) - if(allocated(exch_p) ) deallocate(exch_p ) - if(allocated(wstar_p) ) deallocate(wstar_p ) + if(allocated(br_p) ) deallocate(br_p ) + if(allocated(ctopo_p) ) deallocate(ctopo_p ) + if(allocated(ctopo2_p)) deallocate(ctopo2_p) + if(allocated(delta_p) ) deallocate(delta_p ) + if(allocated(psih_p) ) deallocate(psih_p ) + if(allocated(psim_p) ) deallocate(psim_p ) + if(allocated(u10_p) ) deallocate(u10_p ) + if(allocated(v10_p) ) deallocate(v10_p ) + if(allocated(exch_p) ) deallocate(exch_p ) + if(allocated(wstar_p) ) deallocate(wstar_p ) case("bl_mynn") - if(allocated(kbl_plume_p) ) deallocate(kbl_plume_p ) - - if(allocated(dx_p) ) deallocate(dx_p ) - if(allocated(ch_p) ) deallocate(ch_p ) - if(allocated(qsfc_p) ) deallocate(qsfc_p ) - if(allocated(rmol_p) ) deallocate(rmol_p ) - if(allocated(tsk_p) ) deallocate(tsk_p ) - if(allocated(maxwidthbl_p) ) deallocate(maxwidthbl_p ) - if(allocated(maxmfbl_p) ) deallocate(maxmfbl_p ) - if(allocated(zbl_plume_p) ) deallocate(zbl_plume_p ) - - if(allocated(cov_p) ) deallocate(cov_p ) - if(allocated(qke_p) ) deallocate(qke_p ) - if(allocated(qsq_p) ) deallocate(qsq_p ) - if(allocated(tsq_p) ) deallocate(tsq_p ) - if(allocated(qkeadv_p) ) deallocate(qkeadv_p ) - if(allocated(elpbl_p) ) deallocate(elpbl_p ) - if(allocated(tkepbl_p) ) deallocate(tkepbl_p ) - if(allocated(sh3d_p) ) deallocate(sh3d_p ) - if(allocated(sm3d_p) ) deallocate(sm3d_p ) - if(allocated(dqke_p) ) deallocate(dqke_p ) - if(allocated(qbuoy_p) ) deallocate(qbuoy_p ) - if(allocated(qdiss_p) ) deallocate(qdiss_p ) - if(allocated(qshear_p) ) deallocate(qshear_p ) - if(allocated(qwt_p) ) deallocate(qwt_p ) - if(allocated(qcbl_p) ) deallocate(qcbl_p ) - if(allocated(qibl_p) ) deallocate(qibl_p ) - if(allocated(cldfrabl_p) ) deallocate(cldfrabl_p ) - if(allocated(edmfa_p) ) deallocate(edmfa_p ) - if(allocated(edmfw_p) ) deallocate(edmfw_p ) - if(allocated(edmfqt_p) ) deallocate(edmfqt_p ) - if(allocated(edmfthl_p) ) deallocate(edmfthl_p ) - if(allocated(edmfent_p) ) deallocate(edmfent_p ) - if(allocated(edmfqc_p) ) deallocate(edmfqc_p ) - if(allocated(subthl_p) ) deallocate(subthl_p ) - if(allocated(subqv_p) ) deallocate(subqv_p ) - if(allocated(detthl_p) ) deallocate(detthl_p ) - if(allocated(detqv_p) ) deallocate(detqv_p ) + if(allocated(kbl_plume_p) ) deallocate(kbl_plume_p ) + if(allocated(dx_p) ) deallocate(dx_p ) + if(allocated(ch_p) ) deallocate(ch_p ) + if(allocated(qsfc_p) ) deallocate(qsfc_p ) + if(allocated(rmol_p) ) deallocate(rmol_p ) + if(allocated(tsk_p) ) deallocate(tsk_p ) + if(allocated(maxwidthbl_p)) deallocate(maxwidthbl_p) + if(allocated(maxmfbl_p) ) deallocate(maxmfbl_p ) + if(allocated(zbl_plume_p) ) deallocate(zbl_plume_p ) + + if(allocated(cov_p) ) deallocate(cov_p ) + if(allocated(qke_p) ) deallocate(qke_p ) + if(allocated(qsq_p) ) deallocate(qsq_p ) + if(allocated(tsq_p) ) deallocate(tsq_p ) + if(allocated(qkeadv_p) ) deallocate(qkeadv_p ) + if(allocated(elpbl_p) ) deallocate(elpbl_p ) + if(allocated(tkepbl_p) ) deallocate(tkepbl_p ) + if(allocated(sh3d_p) ) deallocate(sh3d_p ) + if(allocated(sm3d_p) ) deallocate(sm3d_p ) + if(allocated(dqke_p) ) deallocate(dqke_p ) + if(allocated(qbuoy_p) ) deallocate(qbuoy_p ) + if(allocated(qdiss_p) ) deallocate(qdiss_p ) + if(allocated(qshear_p) ) deallocate(qshear_p ) + if(allocated(qwt_p) ) deallocate(qwt_p ) + if(allocated(qcbl_p) ) deallocate(qcbl_p ) + if(allocated(qibl_p) ) deallocate(qibl_p ) + if(allocated(cldfrabl_p) ) deallocate(cldfrabl_p ) + if(allocated(edmfa_p) ) deallocate(edmfa_p ) + if(allocated(edmfw_p) ) deallocate(edmfw_p ) + if(allocated(edmfqt_p) ) deallocate(edmfqt_p ) + if(allocated(edmfthl_p) ) deallocate(edmfthl_p ) + if(allocated(edmfent_p) ) deallocate(edmfent_p ) + if(allocated(edmfqc_p) ) deallocate(edmfqc_p ) + if(allocated(subthl_p) ) deallocate(subthl_p ) + if(allocated(subqv_p) ) deallocate(subqv_p ) + if(allocated(detthl_p) ) deallocate(detthl_p ) + if(allocated(detqv_p) ) deallocate(detqv_p ) !additional tendencies: - if(allocated(rqsblten_p) ) deallocate(rqsblten_p ) - if(allocated(rniblten_p) ) deallocate(rniblten_p ) + if(allocated(rqsblten_p) ) deallocate(rqsblten_p ) + if(allocated(rncblten_p) ) deallocate(rncblten_p ) + if(allocated(rniblten_p) ) deallocate(rniblten_p ) + if(allocated(rnifablten_p)) deallocate(rnifablten_p) + if(allocated(rnwfablten_p)) deallocate(rnwfablten_p) !deallocation of additional arrays: if(allocated(pattern_spp_pbl)) deallocate(pattern_spp_pbl) @@ -485,8 +488,11 @@ subroutine pbl_from_MPAS(configs,mesh,sfc_input,diag_physics,tend_physics,its,it qshear_p(i,k,j) = 0._RKIND qwt_p(i,k,j) = 0._RKIND - rqsblten_p(i,k,j) = 0._RKIND - rniblten_p(i,k,j) = 0._RKIND + rqsblten_p(i,k,j) = 0._RKIND + rncblten_p(i,k,j) = 0._RKIND + rniblten_p(i,k,j) = 0._RKIND + rnifablten_p(i,k,j) = 0._RKIND + rnwfablten_p(i,k,j) = 0._RKIND pattern_spp_pbl(i,k,j) = 0._RKIND enddo @@ -546,7 +552,7 @@ subroutine pbl_to_MPAS(configs,diag_physics,tend_physics,its,ite) real(kind=RKIND),dimension(:),pointer :: hpbl real(kind=RKIND),dimension(:,:),pointer:: kzh,kzm,kzq real(kind=RKIND),dimension(:,:),pointer:: rublten,rvblten,rthblten,rqvblten,rqcblten,rqiblten,rqsblten - real(kind=RKIND),dimension(:,:),pointer:: rniblten + real(kind=RKIND),dimension(:,:),pointer:: rncblten,rniblten,rnifablten,rnwfablten !local pointers for YSU scheme: real(kind=RKIND),dimension(:,:),pointer:: exch_h @@ -649,7 +655,6 @@ subroutine pbl_to_MPAS(configs,diag_physics,tend_physics,its,ite) call mpas_pool_get_array(diag_physics,'det_qv' ,det_qv ) call mpas_pool_get_array(tend_physics,'rqsblten' ,rqsblten ) - call mpas_pool_get_array(tend_physics,'rniblten' ,rniblten ) do j = jts,jte do k = kts,kte @@ -683,11 +688,35 @@ subroutine pbl_to_MPAS(configs,diag_physics,tend_physics,its,ite) qwt(k,i) = qwt_p(i,k,j) rqsblten(k,i) = rqsblten_p(i,k,j) - rniblten(k,i) = rniblten_p(i,k,j) enddo enddo enddo + if(f_ni) then + call mpas_pool_get_array(tend_physics,'rniblten',rniblten) + do j = jts,jte + do k = kts,kte + do i = its,ite + rniblten(k,i) = rniblten_p(i,k,j) + enddo + enddo + enddo + endif + if(f_nc .and. f_nifa .and. f_nwfa) then + call mpas_pool_get_array(tend_physics,'rncblten' ,rncblten ) + call mpas_pool_get_array(tend_physics,'rnifablten',rnifablten) + call mpas_pool_get_array(tend_physics,'rnwfablten',rnwfablten) + do j = jts,jte + do k = kts,kte + do i = its,ite + rncblten(k,i) = rncblten_p(i,k,j) + rnifablten(k,i) = rnifablten_p(i,k,j) + rnwfablten(k,i) = rnwfablten_p(i,k,j) + enddo + enddo + enddo + endif + case default end select pbl_select @@ -713,10 +742,10 @@ subroutine init_pbl(configs) pbl_select: select case (trim(pbl_scheme)) case("bl_mynn") - call mpas_log_write('--- enter subroutine bl_mynn_init:') +! call mpas_log_write('--- enter subroutine bl_mynn_init:') call bl_mynn_init(cp,cpv,cice,cliq,ep_1,ep_2,gravity,karman,P0,R_d,R_v,svp1,svp2,svp3,svpt0, & xlf,xls,xlv,errmsg,errflg) - call mpas_log_write('--- end subroutine bl_mynn_mpas_init:') +! call mpas_log_write('--- end subroutine bl_mynn_init:') case default @@ -873,58 +902,60 @@ subroutine driver_pbl(itimestep,configs,mesh,sfc_input,diag_physics,tend_physics call mpas_timer_start('bl_mynn') call mynn_bl_driver( & - f_qc = f_qc , f_qi = f_qi , f_qs = f_qs , & - f_qoz = f_qoz , f_nc = f_nc , f_ni = f_ni , & - f_nifa = f_nifa , f_nwfa = f_nwfa , f_nbca = f_nbca , & - icloud_bl = icloud_bl , delt = dt_pbl , dx = dx_p , & - xland = xland_p , ps = psfc_p , ts = tsk_p , & - qsfc = qsfc_p , ust = ust_p , ch = ch_p , & - hfx = hfx_p , qfx = qfx_p , rmol = rmol_p , & - wspd = wspd_p , znt = znt_p , uoce = uoce_p , & - voce = voce_p , dz = dz_p , u = u_p , & - v = v_p , w = w_p , th = th_p , & - tt = t_p , p = pres_hyd_p , exner = pi_p , & - rho = rho_p , qv = qv_p , qc = qc_p , & - qi = qi_p , qs = qs_p , ni = ni_p , & - rthraten = rthraten_p , pblh = hpbl_p , kpbl = kpbl_p , & - cldfra_bl = cldfrabl_p , qc_bl = qcbl_p , qi_bl = qibl_p , & - maxwidth = maxwidthbl_p , maxmf = maxmfbl_p , ktop_plume = kbl_plume_p , & - ztop_plume = zbl_plume_p , dqke = dqke_p , qke_adv = qkeadv_p , & - tsq = tsq_p , qsq = qsq_p , cov = cov_p , & - el_pbl = elpbl_p , rublten = rublten_p , rvblten = rvblten_p , & - rthblten = rthblten_p , rqvblten = rqvblten_p , rqcblten = rqcblten_p , & - rqiblten = rqiblten_p , rqsblten = rqsblten_p , rniblten = rniblten_p , & - edmf_a = edmfa_p , edmf_w = edmfw_p , edmf_qt = edmfqt_p , & - edmf_thl = edmfthl_p , edmf_ent = edmfent_p , edmf_qc = edmfqc_p , & - sub_thl = subthl_p , sub_sqv = subqv_p , det_thl = detthl_p , & - det_sqv = detqv_p , exch_h = kzh_p , exch_m = kzm_p , & - qke = qke_p , qwt = qwt_p , qshear = qshear_p , & - qbuoy = qbuoy_p , qdiss = qdiss_p , sh3d = sh3d_p , & - sm3d = sm3d_p , spp_pbl = spp_pbl , pattern_spp = pattern_spp_pbl , & - do_restart = config_do_restart , & - do_DAcycling = config_do_DAcycling , & - initflag = initflag , & - bl_mynn_tkeadvect = bl_mynn_tkeadvect , & - bl_mynn_tkebudget = bl_mynn_tkebudget , & - bl_mynn_cloudpdf = bl_mynn_cloudpdf , & - bl_mynn_mixlength = bl_mynn_mixlength , & - bl_mynn_closure = bl_mynn_closure , & - bl_mynn_stfunc = bl_mynn_stfunc , & - bl_mynn_topdown = bl_mynn_topdown , & - bl_mynn_scaleaware = bl_mynn_scaleaware , & - bl_mynn_dheat_opt = bl_mynn_dheat_opt , & - bl_mynn_edmf = bl_mynn_edmf , & - bl_mynn_edmf_dd = bl_mynn_edmf_dd , & - bl_mynn_edmf_mom = bl_mynn_edmf_mom , & - bl_mynn_edmf_tke = bl_mynn_edmf_tke , & - bl_mynn_output = bl_mynn_edmf_output , & - bl_mynn_mixscalars = bl_mynn_mixscalars , & - bl_mynn_cloudmix = bl_mynn_cloudmix , & - bl_mynn_mixqt = bl_mynn_mixqt , & - 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 , & - errmsg = errmsg , errflg = errflg & + f_qc = f_qc , f_qi = f_qi , f_qs = f_qs , & + f_qoz = f_qoz , f_nc = f_nc , f_ni = f_ni , & + f_nifa = f_nifa , f_nwfa = f_nwfa , f_nbca = f_nbca , & + icloud_bl = icloud_bl , delt = dt_pbl , dx = dx_p , & + xland = xland_p , ps = psfc_p , ts = tsk_p , & + qsfc = qsfc_p , ust = ust_p , ch = ch_p , & + hfx = hfx_p , qfx = qfx_p , rmol = rmol_p , & + wspd = wspd_p , znt = znt_p , uoce = uoce_p , & + voce = voce_p , dz = dz_p , u = u_p , & + v = v_p , w = w_p , th = th_p , & + tt = t_p , p = pres_hyd_p , exner = pi_p , & + rho = rho_p , qv = qv_p , qc = qc_p , & + qi = qi_p , qs = qs_p , nc = nc_p , & + ni = ni_p , nifa = nifa_p , nwfa = nwfa_p , & + rthraten = rthraten_p , pblh = hpbl_p , kpbl = kpbl_p , & + cldfra_bl = cldfrabl_p , qc_bl = qcbl_p , qi_bl = qibl_p , & + maxwidth = maxwidthbl_p , maxmf = maxmfbl_p , ktop_plume = kbl_plume_p , & + ztop_plume = zbl_plume_p , dqke = dqke_p , qke_adv = qkeadv_p , & + tsq = tsq_p , qsq = qsq_p , cov = cov_p , & + el_pbl = elpbl_p , rublten = rublten_p , rvblten = rvblten_p , & + rthblten = rthblten_p , rqvblten = rqvblten_p , rqcblten = rqcblten_p , & + rqiblten = rqiblten_p , rqsblten = rqsblten_p , rncblten = rncblten_p , & + rniblten = rniblten_p , rnifablten = rnifablten_p , rnwfablten = rnwfablten_p , & + edmf_a = edmfa_p , edmf_w = edmfw_p , edmf_qt = edmfqt_p , & + edmf_thl = edmfthl_p , edmf_ent = edmfent_p , edmf_qc = edmfqc_p , & + sub_thl = subthl_p , sub_sqv = subqv_p , det_thl = detthl_p , & + det_sqv = detqv_p , exch_h = kzh_p , exch_m = kzm_p , & + qke = qke_p , qwt = qwt_p , qshear = qshear_p , & + qbuoy = qbuoy_p , qdiss = qdiss_p , sh3d = sh3d_p , & + sm3d = sm3d_p , spp_pbl = spp_pbl , pattern_spp = pattern_spp_pbl , & + do_restart = config_do_restart , & + do_DAcycling = config_do_DAcycling , & + initflag = initflag , & + bl_mynn_tkeadvect = bl_mynn_tkeadvect , & + bl_mynn_tkebudget = bl_mynn_tkebudget , & + bl_mynn_cloudpdf = bl_mynn_cloudpdf , & + bl_mynn_mixlength = bl_mynn_mixlength , & + bl_mynn_closure = bl_mynn_closure , & + bl_mynn_stfunc = bl_mynn_stfunc , & + bl_mynn_topdown = bl_mynn_topdown , & + bl_mynn_scaleaware = bl_mynn_scaleaware , & + bl_mynn_dheat_opt = bl_mynn_dheat_opt , & + bl_mynn_edmf = bl_mynn_edmf , & + bl_mynn_edmf_dd = bl_mynn_edmf_dd , & + bl_mynn_edmf_mom = bl_mynn_edmf_mom , & + bl_mynn_edmf_tke = bl_mynn_edmf_tke , & + bl_mynn_output = bl_mynn_edmf_output , & + bl_mynn_mixscalars = bl_mynn_mixscalars , & + bl_mynn_cloudmix = bl_mynn_cloudmix , & + bl_mynn_mixqt = bl_mynn_mixqt , & + 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 , & + errmsg = errmsg , errflg = errflg & ) call mpas_timer_stop('bl_mynn') ! call mpas_log_write('--- exit subroutine mynn_bl_driver:') diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_radiation_lw.F b/src/core_atmosphere/physics/mpas_atmphys_driver_radiation_lw.F index 60dbebb3e..dfa327fea 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_driver_radiation_lw.F +++ b/src/core_atmosphere/physics/mpas_atmphys_driver_radiation_lw.F @@ -9,7 +9,7 @@ module mpas_atmphys_driver_radiation_lw 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_driver_radiation_sw, only: radconst use mpas_atmphys_constants @@ -138,7 +138,6 @@ subroutine allocate_radiation_lw(configs,xtime_s) if(.not.allocated(rthratenlw_p) ) allocate(rthratenlw_p(ims:ime,kms:kme,jms:jme) ) radiation_lw_select: select case (trim(radt_lw_scheme)) - case("rrtmg_lw") if(.not.allocated(recloud_p) ) allocate(recloud_p(ims:ime,kms:kme,jms:jme) ) @@ -202,7 +201,6 @@ subroutine allocate_radiation_lw(configs,xtime_s) endif case default - end select radiation_lw_select end subroutine allocate_radiation_lw @@ -243,7 +241,6 @@ subroutine deallocate_radiation_lw(configs) if(allocated(rthratenlw_p) ) deallocate(rthratenlw_p ) radiation_lw_select: select case (trim(radt_lw_scheme)) - case("rrtmg_lw") if(allocated(recloud_p) ) deallocate(recloud_p ) if(allocated(reice_p) ) deallocate(reice_p ) @@ -292,7 +289,6 @@ subroutine deallocate_radiation_lw(configs) if(allocated(aerosolcp_p) ) deallocate(aerosolcp_p ) case default - end select radiation_lw_select end subroutine deallocate_radiation_lw @@ -320,9 +316,9 @@ subroutine radiation_lw_from_MPAS(xtime_s,configs,mesh,state,time_lev,diag_physi !local pointers: logical,pointer:: config_o3climatology + logical,pointer:: config_microp_re character(len=StrKIND),pointer:: radt_lw_scheme character(len=StrKIND),pointer:: microp_scheme - logical,pointer:: config_microp_re real(kind=RKIND),dimension(:),pointer :: latCell,lonCell real(kind=RKIND),dimension(:),pointer :: skintemp,snow,xice,xland @@ -339,10 +335,10 @@ subroutine radiation_lw_from_MPAS(xtime_s,configs,mesh,state,time_lev,diag_physi !----------------------------------------------------------------------------------------------------------------- + call mpas_pool_get_config(configs,'config_microp_re' ,config_microp_re ) call mpas_pool_get_config(configs,'config_o3climatology' ,config_o3climatology) call mpas_pool_get_config(configs,'config_radt_lw_scheme',radt_lw_scheme ) call mpas_pool_get_config(configs,'config_microp_scheme' ,microp_scheme ) - call mpas_pool_get_config(configs,'config_microp_re' ,config_microp_re ) call mpas_pool_get_array(mesh,'latCell',latCell) call mpas_pool_get_array(mesh,'lonCell',lonCell) @@ -415,10 +411,9 @@ subroutine radiation_lw_from_MPAS(xtime_s,configs,mesh,state,time_lev,diag_physi enddo radiation_lw_select: select case (trim(radt_lw_scheme)) - case("rrtmg_lw") microp_select: select case(microp_scheme) - case("mp_thompson","mp_wsm6") + case("mp_thompson","mp_thompson_aerosols","mp_wsm6") if(config_microp_re) then call mpas_pool_get_array(diag_physics,'re_cloud',re_cloud) call mpas_pool_get_array(diag_physics,'re_ice' ,re_ice ) @@ -610,7 +605,6 @@ subroutine radiation_lw_from_MPAS(xtime_s,configs,mesh,state,time_lev,diag_physi enddo case default - end select radiation_lw_select end subroutine radiation_lw_from_MPAS @@ -629,9 +623,9 @@ subroutine radiation_lw_to_MPAS(configs,diag_physics,tend_physics,its,ite) integer,intent(in):: its,ite !local pointers: + logical,pointer:: config_microp_re character(len=StrKIND),pointer:: radt_lw_scheme character(len=StrKIND),pointer:: microp_scheme - logical,pointer:: config_microp_re real(kind=RKIND),dimension(:),pointer :: glw,lwcf,lwdnb,lwdnbc,lwdnt,lwdntc,lwupb,lwupbc, & lwupt,lwuptc,olrtoa @@ -645,9 +639,9 @@ subroutine radiation_lw_to_MPAS(configs,diag_physics,tend_physics,its,ite) !----------------------------------------------------------------------------------------------------------------- - call mpas_pool_get_config(configs,'config_radt_lw_scheme',radt_lw_scheme ) - call mpas_pool_get_config(configs,'config_microp_scheme' ,microp_scheme ) call mpas_pool_get_config(configs,'config_microp_re' ,config_microp_re) + call mpas_pool_get_config(configs,'config_microp_scheme' ,microp_scheme ) + call mpas_pool_get_config(configs,'config_radt_lw_scheme',radt_lw_scheme ) call mpas_pool_get_array(diag_physics,'glw' ,glw ) call mpas_pool_get_array(diag_physics,'lwcf' ,lwcf ) @@ -690,7 +684,7 @@ subroutine radiation_lw_to_MPAS(configs,diag_physics,tend_physics,its,ite) case("rrtmg_lw") microp_select: select case(microp_scheme) - case("mp_thompson","mp_wsm6") + case("mp_thompson","mp_thompson_aerosols","mp_wsm6") call mpas_pool_get_array(diag_physics,'rre_cloud',rre_cloud) call mpas_pool_get_array(diag_physics,'rre_ice' ,rre_ice ) call mpas_pool_get_array(diag_physics,'rre_snow' ,rre_snow ) @@ -795,7 +789,6 @@ subroutine init_radiation_lw(dminfo,configs,mesh,atm_input,diag,diag_physics,sta call mpas_pool_get_config(configs,'config_radt_lw_scheme',radt_lw_scheme) radiation_lw_select: select case (trim(radt_lw_scheme)) - case ("rrtmg_lw") call rrtmg_initlw_forMPAS(dminfo) @@ -803,7 +796,6 @@ subroutine init_radiation_lw(dminfo,configs,mesh,atm_input,diag,diag_physics,sta call camradinit(dminfo,mesh,atm_input,diag,diag_physics,state,time_lev) case default - end select radiation_lw_select end subroutine init_radiation_lw @@ -831,50 +823,67 @@ subroutine driver_radiation_lw(xtime_s,configs,mesh,state,time_lev,diag_physics, !local pointers: logical,pointer:: config_o3climatology character(len=StrKIND),pointer:: radt_lw_scheme + character(len=StrKIND),pointer:: radt_cld_overlap,radt_cld_dcorrlen !local variables: integer:: o3input + integer:: cldovrlp,idcor real(kind=RKIND):: radt,xtime_m !----------------------------------------------------------------------------------------------------------------- !call mpas_log_write(' --- enter subroutine driver_radiation_lw: ') - call mpas_pool_get_config(configs,'config_o3climatology' ,config_o3climatology) - call mpas_pool_get_config(configs,'config_radt_lw_scheme',radt_lw_scheme ) + call mpas_pool_get_config(configs,'config_o3climatology' ,config_o3climatology) + call mpas_pool_get_config(configs,'config_radt_lw_scheme' ,radt_lw_scheme ) + call mpas_pool_get_config(configs,'config_radt_cld_overlap' ,radt_cld_overlap ) + call mpas_pool_get_config(configs,'config_radt_cld_dcorrlen',radt_cld_dcorrlen ) !copy MPAS arrays to local arrays: call radiation_lw_from_MPAS(xtime_s,configs,mesh,state,time_lev,diag_physics,atm_input,sfc_input,its,ite) !call to longwave radiation scheme: radiation_lw_select: select case (trim(radt_lw_scheme)) - case ("rrtmg_lw") o3input = 0 if(config_o3climatology) o3input = 2 - call mpas_timer_start('RRTMG_lw') + !initialization of cloud overlap option: + if(trim(radt_cld_overlap) == "none" ) cldovrlp = 0 + if(trim(radt_cld_overlap) == "random" ) cldovrlp = 1 + if(trim(radt_cld_overlap) == "maximum_random" ) cldovrlp = 2 + if(trim(radt_cld_overlap) == "maximum" ) cldovrlp = 3 + if(trim(radt_cld_overlap) == "exponential" ) cldovrlp = 4 + if(trim(radt_cld_overlap) == "exponential_random") cldovrlp = 5 + + idcor = 0 + if(trim(radt_cld_overlap)=="exponential" .or. trim(radt_cld_overlap)=="exponential_random") then + if(trim(radt_cld_dcorrlen) == "constant" ) idcor = 0 + if(trim(radt_cld_dcorrlen) == "latitude_varying") idcor = 1 + endif + + call mpas_timer_start('rrtmg_lwrad') call rrtmg_lwrad( & - p3d = pres_hyd_p , p8w = pres2_hyd_p , pi3d = pi_p , & - t3d = t_p , t8w = t2_p , dz8w = dz_p , & -! qv3d = qv_p , qc3d = qc_p , qi3d = qi_p , & -! qs3d = qs_p , cldfra3d = cldfrac_p , tsk = tsk_p , & - qv3d = qvrad_p , qc3d = qcrad_p , qi3d = qirad_p , & - qs3d = qsrad_p , cldfra3d = cldfrac_p , tsk = tsk_p , & - emiss = sfc_emiss_p , xland = xland_p , xice = xice_p , & - snow = snow_p , icloud = icloud , o3input = o3input , & - noznlevels = num_oznlevels , pin = pin_p , o3clim = o3clim_p , & - glw = glw_p , olr = olrtoa_p , lwcf = lwcf_p , & - rthratenlw = rthratenlw_p , has_reqc = has_reqc , has_reqi = has_reqi , & - has_reqs = has_reqs , re_cloud = recloud_p , re_ice = reice_p , & - re_snow = resnow_p , rre_cloud = rrecloud_p , rre_ice = rreice_p , & - rre_snow = rresnow_p , lwupt = lwupt_p , lwuptc = lwuptc_p , & - lwdnt = lwdnt_p , lwdntc = lwdntc_p , lwupb = lwupb_p , & - lwupbc = lwupbc_p , lwdnb = lwdnb_p , lwdnbc = lwdnbc_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 & + p3d = pres_hyd_p , p8w = pres2_hyd_p , pi3d = pi_p , & + t3d = t_p , t8w = t2_p , dz8w = dz_p , & + qv3d = qvrad_p , qc3d = qcrad_p , qi3d = qirad_p , & + qs3d = qsrad_p , cldfra3d = cldfrac_p , tsk = tsk_p , & + emiss = sfc_emiss_p , xland = xland_p , xice = xice_p , & + snow = snow_p , xlat = xlat_p , julday = julday , & + icloud = icloud , cldovrlp = cldovrlp , idcor = idcor , & + o3input = o3input , noznlevels = num_oznlevels , pin = pin_p , & + o3clim = o3clim_p , glw = glw_p , olr = olrtoa_p , & + lwcf = lwcf_p , rthratenlw = rthratenlw_p , has_reqc = has_reqc , & + has_reqi = has_reqi , has_reqs = has_reqs , re_cloud = recloud_p , & + re_ice = reice_p , re_snow = resnow_p , rre_cloud = rrecloud_p , & + rre_ice = rreice_p , rre_snow = rresnow_p , lwupt = lwupt_p , & + lwuptc = lwuptc_p , lwdnt = lwdnt_p , lwdntc = lwdntc_p , & + lwupb = lwupb_p , lwupbc = lwupbc_p , lwdnb = lwdnb_p , & + lwdnbc = lwdnbc_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('RRTMG_lw') + call mpas_timer_stop('rrtmg_lwrad') case ("cam_lw") xtime_m = xtime_s/60. @@ -941,7 +950,6 @@ subroutine driver_radiation_lw(xtime_s,configs,mesh,state,time_lev,diag_physics, call mpas_timer_stop('CAMRAD_lw') case default - end select radiation_lw_select !copy local arrays to MPAS grid: diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_radiation_sw.F b/src/core_atmosphere/physics/mpas_atmphys_driver_radiation_sw.F index a69553891..dc5a30bde 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_driver_radiation_sw.F +++ b/src/core_atmosphere/physics/mpas_atmphys_driver_radiation_sw.F @@ -9,7 +9,7 @@ module mpas_atmphys_driver_radiation_sw 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_manager, only: gmt,curr_julday,julday,year @@ -18,6 +18,8 @@ module mpas_atmphys_driver_radiation_sw use mpas_atmphys_vars !wrf physics: + use module_mp_thompson_aerosols + use module_ra_rrtmg_sw_aerosols use module_ra_cam use module_ra_rrtmg_sw @@ -87,6 +89,14 @@ module mpas_atmphys_driver_radiation_sw ! Laura D. Fowler (laura@ucar.edu) / 2023-04-21. ! * removed the variables f_qv and f_qg in the call to subroutine camrad. ! Laura D. Fowler (laura@ucar.edu) / 2024-02-13. +! * in subroutine radiation_sw_from_MPAS, added the calculation of the optical properties of "water-friendly" and +! "ice-friendly" aerosols from the Thompson cloud microphysics scheme for use in the RRTMG short-wave radiation +! code. +! Laura D. Fowler (laura@ucar.edu) / 2024-05-16. +! * in subroutine driver_radiation_sw, modified the argument list in the call to subroutine rrtmg_sw to include +! the optical properties of "water-friendly" and "ice-friendly" aerosols from the Thompson cloud microphysics +! scheme. +! Laura D. Fowler (laura@ucar.edu) / 2024-05-16. contains @@ -101,10 +111,12 @@ subroutine allocate_radiation_sw(configs,xtime_s) real(kind=RKIND),intent(in):: xtime_s !local pointers: - character(len=StrKIND),pointer:: radt_sw_scheme + character(len=StrKIND),pointer:: mp_scheme, & + radt_sw_scheme !----------------------------------------------------------------------------------------------------------------- + call mpas_pool_get_config(configs,'config_microp_scheme' ,mp_scheme ) call mpas_pool_get_config(configs,'config_radt_sw_scheme',radt_sw_scheme) if(.not.allocated(f_ice) ) allocate(f_ice(ims:ime,kms:kme,jms:jme) ) @@ -134,7 +146,6 @@ subroutine allocate_radiation_sw(configs,xtime_s) if(.not.allocated(rthratensw_p) ) allocate(rthratensw_p(ims:ime,kms:kme,jms:jme) ) radiation_sw_select: select case (trim(radt_sw_scheme)) - case("rrtmg_sw") if(.not.allocated(recloud_p) ) allocate(recloud_p(ims:ime,kms:kme,jms:jme) ) if(.not.allocated(reice_p) ) allocate(reice_p(ims:ime,kms:kme,jms:jme) ) @@ -161,6 +172,20 @@ subroutine allocate_radiation_sw(configs,xtime_s) if(.not.allocated(pin_p) ) allocate(pin_p(num_oznlevels) ) if(.not.allocated(o3clim_p) ) allocate(o3clim_p(ims:ime,1:num_oznlevels,jms:jme)) + if(.not.allocated(tauaer_p) ) allocate(tauaer_p(ims:ime,kms:kme,jms:jme,nbndsw) ) + if(.not.allocated(ssaaer_p) ) allocate(ssaaer_p(ims:ime,kms:kme,jms:jme,nbndsw) ) + if(.not.allocated(asyaer_p) ) allocate(asyaer_p(ims:ime,kms:kme,jms:jme,nbndsw) ) + + aerosol_select: select case(mp_scheme) + case("mp_thompson_aerosols") + if(.not.allocated(ht_p) ) allocate(ht_p(ims:ime,jms:jme) ) + if(.not.allocated(taer_type_p)) allocate(taer_type_p(ims:ime,jms:jme)) + if(.not.allocated(taod5502d_p)) allocate(taod5502d_p(ims:ime,jms:jme)) + if(.not.allocated(taod5503d_p)) allocate(taod5503d_p(ims:ime,kms:kme,jms:jme)) + + case default + end select aerosol_select + case("cam_sw") if(.not.allocated(glw_p) ) allocate(glw_p(ims:ime,jms:jme) ) if(.not.allocated(lwcf_p) ) allocate(lwcf_p(ims:ime,jms:jme) ) @@ -217,10 +242,12 @@ subroutine deallocate_radiation_sw(configs) type(mpas_pool_type),intent(in):: configs !local pointers: - character(len=StrKIND),pointer:: radt_sw_scheme + character(len=StrKIND),pointer:: mp_scheme, & + radt_sw_scheme !----------------------------------------------------------------------------------------------------------------- + call mpas_pool_get_config(configs,'config_microp_scheme' ,mp_scheme ) call mpas_pool_get_config(configs,'config_radt_sw_scheme',radt_sw_scheme) if(allocated(f_ice) ) deallocate(f_ice ) @@ -247,7 +274,6 @@ subroutine deallocate_radiation_sw(configs) if(allocated(rthratensw_p) ) deallocate(rthratensw_p ) radiation_sw_select: select case (trim(radt_sw_scheme)) - case("rrtmg_sw") if(allocated(recloud_p) ) deallocate(recloud_p ) if(allocated(reice_p) ) deallocate(reice_p ) @@ -274,6 +300,20 @@ subroutine deallocate_radiation_sw(configs) if(allocated(pin_p) ) deallocate(pin_p ) if(allocated(o3clim_p) ) deallocate(o3clim_p ) + if(allocated(tauaer_p) ) deallocate(tauaer_p ) + if(allocated(ssaaer_p) ) deallocate(ssaaer_p ) + if(allocated(asyaer_p) ) deallocate(asyaer_p ) + + aerosol_select: select case(mp_scheme) + case("mp_thompson","mp_thompson_aerosols") + if(allocated(ht_p) ) deallocate(ht_p ) + if(allocated(taer_type_p)) deallocate(taer_type_p) + if(allocated(taod5502d_p)) deallocate(taod5502d_p) + if(allocated(taod5503d_p)) deallocate(taod5503d_p) + + case default + end select aerosol_select + case("cam_sw") if(allocated(pin_p) ) deallocate(pin_p ) if(allocated(m_hybi_p) ) deallocate(m_hybi_p ) @@ -334,24 +374,27 @@ subroutine radiation_sw_from_MPAS(configs,mesh,state,time_lev,diag_physics,atm_i !local pointers: logical,pointer:: config_o3climatology + logical,pointer:: config_microp_re character(len=StrKIND),pointer:: radt_sw_scheme character(len=StrKIND),pointer:: microp_scheme - logical,pointer:: config_microp_re real(kind=RKIND),dimension(:),pointer :: latCell,lonCell real(kind=RKIND),dimension(:),pointer :: skintemp,snow,xice,xland real(kind=RKIND),dimension(:),pointer :: m_ps,pin real(kind=RKIND),dimension(:),pointer :: sfc_albedo,sfc_emiss + real(kind=RKIND),dimension(:),pointer :: taod5502d + real(kind=RKIND),dimension(:,:),pointer :: zgrid real(kind=RKIND),dimension(:,:),pointer :: cldfrac,m_hybi,o3clim real(kind=RKIND),dimension(:,:),pointer :: re_cloud,re_ice,re_snow + real(kind=RKIND),dimension(:,:),pointer :: taod5503d real(kind=RKIND),dimension(:,:,:),pointer:: aerosols,ozmixm !----------------------------------------------------------------------------------------------------------------- + call mpas_pool_get_config(configs,'config_microp_re' ,config_microp_re ) call mpas_pool_get_config(configs,'config_o3climatology' ,config_o3climatology) call mpas_pool_get_config(configs,'config_radt_sw_scheme',radt_sw_scheme ) call mpas_pool_get_config(configs,'config_microp_scheme' ,microp_scheme ) - call mpas_pool_get_config(configs,'config_microp_re' ,config_microp_re ) call mpas_pool_get_array(mesh,'latCell',latCell) call mpas_pool_get_array(mesh,'lonCell',lonCell) @@ -416,6 +459,9 @@ subroutine radiation_sw_from_MPAS(configs,mesh,state,time_lev,diag_physics,atm_i swupbc_p(i,j) = 0.0_RKIND swupt_p(i,j) = 0.0_RKIND swuptc_p(i,j) = 0.0_RKIND + swddir_p(i,j) = 0.0_RKIND + swddni_p(i,j) = 0.0_RKIND + swddif_p(i,j) = 0.0_RKIND enddo do k = kts,kte @@ -440,13 +486,24 @@ subroutine radiation_sw_from_MPAS(configs,mesh,state,time_lev,diag_physics,atm_i case default end select radiation_sw_select0 + aer_opt = 0 + do n = 1,nbndsw + do j = jts,jte + do k = kts,kte + do i = its,ite + tauaer_p(i,k,j,n) = 0._RKIND + ssaaer_p(i,k,j,n) = 1._RKIND + asyaer_p(i,k,j,n) = 0._RKIND + enddo + enddo + enddo + enddo radiation_sw_select: select case (trim(radt_sw_scheme)) case("rrtmg_sw") - microp_select: select case(microp_scheme) - case("mp_thompson","mp_wsm6") + case("mp_thompson","mp_thompson_aerosols","mp_wsm6") if(config_microp_re) then call mpas_pool_get_array(diag_physics,'re_cloud',re_cloud) call mpas_pool_get_array(diag_physics,'re_ice' ,re_ice ) @@ -480,6 +537,63 @@ subroutine radiation_sw_from_MPAS(configs,mesh,state,time_lev,diag_physics,atm_i case default end select microp_select + aerosol_select: select case(microp_scheme) + case("mp_thompson_aerosols") + call mpas_pool_get_array(mesh,'zgrid',zgrid) + call mpas_pool_get_array(diag_physics,'taod5502d',taod5502d) + call mpas_pool_get_array(diag_physics,'taod5503d',taod5503d) + + aer_opt = 3 + do j = jts,jte + do i = its,ite + ht_p(i,j) = zgrid(1,i) + if(xland_p(i,j)==1._RKIND) then + taer_type_p(i,j) = 1 + elseif(xland_p(i,j)==2._RKIND) then + taer_type_p(i,j) = 3 + endif + enddo + enddo + + !--- calculation of the 550 nm optical depth of the water- and ice-friendly aerosols: + call gt_aod( & + p_phy = pres_hyd_p , dz8w = dz_p , t_phy = t_p , qvapor = qv_p , & + nwfa = nwfa_p , nifa = nifa_p , taod5503d = taod5503d_p , & + 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 j = jts,jte + do i = its,ite + taod5502d_p(i,j) = 0._RKIND + do k = kts,kte + taod5502d_p(i,j) = taod5502d_p(i,j) + taod5503d_p(i,k,j) + taod5503d(k,i) = taod5503d_p(i,k,j) + enddo + taod5502d(i) = taod5502d_p(i,j) + enddo + enddo + + !--- calculation of the spectral optical depth, single-scattering albedo, and asymmetry factor + !as a function of the 550 nm optical depth of the water- and ice-friendly aerosols: + call calc_aerosol_rrtmg_sw( & + ht = ht_p , dz8w = dz_p , & + p = pres_hyd_p , t3d = t_p , & + qv3d = qv_p , tauaer = tauaer_p , & + ssaaer = ssaaer_p , asyaer = asyaer_p , & + aod5502d = taod5502d_p , aod5503d = taod5503d_p , & + aer_type = taer_type_p , & + aer_aod550_opt = taer_aod550_opt , aer_angexp_opt = taer_angexp_opt , & + aer_ssa_opt = taer_ssa_opt , aer_asy_opt = taer_asy_opt , & + aer_aod550_val = aer_aod550_val , aer_angexp_val = aer_angexp_val , & + aer_ssa_val = aer_ssa_val , aer_asy_val = aer_asy_val , & + ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , & + its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte & + ) + + case default + end select aerosol_select + do j = jts,jte do k = kts,kte+2 do i = its,ite @@ -601,7 +715,6 @@ subroutine radiation_sw_from_MPAS(configs,mesh,state,time_lev,diag_physics,atm_i enddo case default - end select radiation_sw_select end subroutine radiation_sw_from_MPAS @@ -660,6 +773,9 @@ subroutine radiation_sw_to_MPAS(configs,diag_physics,tend_physics,its,ite) swupbc(i) = swupbc_p(i,j) swupt(i) = swupt_p(i,j) swuptc(i) = swuptc_p(i,j) + swddir(i) = swddir_p(i,j) + swddni(i) = swddni_p(i,j) + swddif(i) = swddif_p(i,j) enddo do k = kts,kte @@ -687,7 +803,6 @@ subroutine radiation_sw_to_MPAS(configs,diag_physics,tend_physics,its,ite) enddo case default end select radiation_sw_select - !call mpas_log_write('--- enter subroutine radiation_sw_to_MPAS:') !call mpas_log_write(' ') @@ -719,7 +834,6 @@ subroutine init_radiation_sw(dminfo,configs,mesh,atm_input,diag,diag_physics,sta !call to shortwave radiation scheme: radiation_sw_select: select case (trim(radt_sw_scheme)) - case ("rrtmg_sw") call rrtmg_initsw_forMPAS(dminfo) @@ -727,7 +841,6 @@ subroutine init_radiation_sw(dminfo,configs,mesh,atm_input,diag,diag_physics,sta call camradinit(dminfo,mesh,atm_input,diag,diag_physics,state,time_lev) case default - end select radiation_sw_select end subroutine init_radiation_sw @@ -758,16 +871,20 @@ subroutine driver_radiation_sw(itimestep,configs,mesh,state,time_lev,diag_physic !local pointers: logical,pointer:: config_o3climatology character(len=StrKIND),pointer:: radt_sw_scheme + character(len=StrKIND),pointer:: radt_cld_overlap,radt_cld_dcorrlen !local variables: integer:: o3input + integer:: cldovrlp,idcor real(kind=RKIND):: radt,xtime_m !----------------------------------------------------------------------------------------------------------------- !call mpas_log_write(' --- enter subroutine driver_radiation_sw: $i',intArgs=(/itimestep/)) - call mpas_pool_get_config(configs,'config_o3climatology' ,config_o3climatology) - call mpas_pool_get_config(configs,'config_radt_sw_scheme',radt_sw_scheme ) + call mpas_pool_get_config(configs,'config_o3climatology' ,config_o3climatology ) + call mpas_pool_get_config(configs,'config_radt_sw_scheme',radt_sw_scheme ) + call mpas_pool_get_config(configs,'config_radt_cld_overlap' ,radt_cld_overlap ) + call mpas_pool_get_config(configs,'config_radt_cld_dcorrlen',radt_cld_dcorrlen ) xtime_m = xtime_s/60. @@ -795,40 +912,55 @@ subroutine driver_radiation_sw(itimestep,configs,mesh,state,time_lev,diag_physic !call to shortwave radiation scheme: radiation_sw_select: select case (trim(radt_sw_scheme)) - case ("rrtmg_sw") o3input = 0 if(config_o3climatology) o3input = 2 - call mpas_timer_start('RRTMG_sw') + !initialization of cloud overlap option: + if(trim(radt_cld_overlap) == "none" ) cldovrlp = 0 + if(trim(radt_cld_overlap) == "random" ) cldovrlp = 1 + if(trim(radt_cld_overlap) == "maximum_random" ) cldovrlp = 2 + if(trim(radt_cld_overlap) == "maximum" ) cldovrlp = 3 + if(trim(radt_cld_overlap) == "exponential" ) cldovrlp = 4 + if(trim(radt_cld_overlap) == "exponential_random") cldovrlp = 5 + + idcor = 0 + if(trim(radt_cld_overlap)=="exponential" .or. trim(radt_cld_overlap)=="exponential_random") then + if(trim(radt_cld_dcorrlen) == "constant" ) idcor = 0 + if(trim(radt_cld_dcorrlen) == "latitude_varying") idcor = 1 + endif + + call mpas_timer_start('rrtmg_swrad') call rrtmg_swrad( & - p3d = pres_hyd_p , p8w = pres2_hyd_p , pi3d = pi_p , & - t3d = t_p , t8w = t2_p , dz8w = dz_p , & -! qv3d = qv_p , qc3d = qc_p , qi3d = qi_p , & -! qs3d = qs_p , cldfra3d = cldfrac_p , tsk = tsk_p , & - qv3d = qvrad_p , qc3d = qcrad_p , qi3d = qirad_p , & - qs3d = qsrad_p , cldfra3d = cldfrac_p , tsk = tsk_p , & - albedo = sfc_albedo_p , xland = xland_p , xice = xice_p , & - snow = snow_p , coszr = coszr_p , xtime = xtime_m , & - gmt = gmt , julday = julday , radt = radt , & - degrad = degrad , declin = declin , solcon = solcon , & - xlat = xlat_p , xlong = xlon_p , icloud = icloud , & - o3input = o3input , noznlevels = num_oznlevels , pin = pin_p , & - o3clim = o3clim_p , gsw = gsw_p , swcf = swcf_p , & - rthratensw = rthratensw_p , has_reqc = has_reqc , has_reqi = has_reqi , & - has_reqs = has_reqs , re_cloud = recloud_p , re_ice = reice_p , & - re_snow = resnow_p , swupt = swupt_p , swuptc = swuptc_p , & - swdnt = swdnt_p , swdntc = swdntc_p , swupb = swupb_p , & - swupbc = swupbc_p , swdnb = swdnb_p , swdnbc = swdnbc_p , & - swddir = swddir_p , swddni = swddni_p , swddif = swddif_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 & + p3d = pres_hyd_p , p8w = pres2_hyd_p , pi3d = pi_p , & + t3d = t_p , t8w = t2_p , dz8w = dz_p , & +! qv3d = qv_p , qc3d = qc_p , qi3d = qi_p , & +! qs3d = qs_p , cldfra3d = cldfrac_p , tsk = tsk_p , & + qv3d = qvrad_p , qc3d = qcrad_p , qi3d = qirad_p , & + qs3d = qsrad_p , cldfra3d = cldfrac_p , tsk = tsk_p , & + albedo = sfc_albedo_p , xland = xland_p , xice = xice_p , & + snow = snow_p , coszr = coszr_p , xtime = xtime_m , & + gmt = gmt , julday = julday , radt = radt , & + degrad = degrad , declin = declin , solcon = solcon , & + xlat = xlat_p , xlong = xlon_p , icloud = icloud , & + cldovrlp = cldovrlp , idcor = idcor , o3input = o3input , & + noznlevels = num_oznlevels , pin = pin_p , o3clim = o3clim_p , & + gsw = gsw_p , swcf = swcf_p , rthratensw = rthratensw_p , & + has_reqc = has_reqc , has_reqi = has_reqi , has_reqs = has_reqs , & + re_cloud = recloud_p , re_ice = reice_p , re_snow = resnow_p , & + aer_opt = aer_opt , tauaer3d = tauaer_p , ssaaer3d = ssaaer_p , & + asyaer3d = asyaer_p , swupt = swupt_p , swuptc = swuptc_p , & + swdnt = swdnt_p , swdntc = swdntc_p , swupb = swupb_p , & + swupbc = swupbc_p , swdnb = swdnb_p , swdnbc = swdnbc_p , & + swddir = swddir_p , swddni = swddni_p , swddif = swddif_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('RRTMG_sw') + call mpas_timer_stop('rrtmg_swrad') case ("cam_sw") - call mpas_timer_start('CAMRAD_sw') + call mpas_timer_start('camrad_sw') call camrad( dolw = .false. , dosw = .true. , & p_phy = pres_hyd_p , p8w = pres2_hyd_p , & pi_phy = pi_p , t_phy = t_p , & @@ -876,10 +1008,9 @@ subroutine driver_radiation_sw(itimestep,configs,mesh,state,time_lev,diag_physic 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('CAMRAD_sw') + call mpas_timer_stop('camrad_sw') case default - end select radiation_sw_select !copy local arrays to MPAS grid: diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_seaice.F b/src/core_atmosphere/physics/mpas_atmphys_driver_seaice.F index 7894a8142..92aa12a84 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_driver_seaice.F +++ b/src/core_atmosphere/physics/mpas_atmphys_driver_seaice.F @@ -36,9 +36,19 @@ module mpas_atmphys_driver_seaice !================================================================================================================= - subroutine allocate_seaice + subroutine allocate_seaice(configs) !================================================================================================================= +!input arguments: + type(mpas_pool_type),intent(in):: configs + +!local pointers: + character(len=StrKIND),pointer:: lsm_scheme + +!----------------------------------------------------------------------------------------------------------------- + + call mpas_pool_get_config(configs,'config_lsm_scheme',lsm_scheme) + if(.not.allocated(acsnom_p) ) allocate(acsnom_p(ims:ime,jms:jme) ) if(.not.allocated(acsnow_p) ) allocate(acsnow_p(ims:ime,jms:jme) ) if(.not.allocated(albsi_p) ) allocate(albsi_p(ims:ime,jms:jme) ) @@ -55,8 +65,6 @@ subroutine allocate_seaice if(.not.allocated(hfx_p) ) allocate(hfx_p(ims:ime,jms:jme) ) if(.not.allocated(qfx_p) ) allocate(qfx_p(ims:ime,jms:jme) ) if(.not.allocated(lh_p) ) allocate(lh_p(ims:ime,jms:jme) ) - if(.not.allocated(noahres_p) ) allocate(noahres_p(ims:ime,jms:jme) ) - if(.not.allocated(potevp_p) ) allocate(potevp_p(ims:ime,jms:jme) ) if(.not.allocated(rainbl_p) ) allocate(rainbl_p(ims:ime,jms:jme) ) if(.not.allocated(sfc_albedo_p)) allocate(sfc_albedo_p(ims:ime,jms:jme)) if(.not.allocated(sfc_emiss_p) ) allocate(sfc_emiss_p(ims:ime,jms:jme) ) @@ -65,7 +73,6 @@ subroutine allocate_seaice if(.not.allocated(snow_p) ) allocate(snow_p(ims:ime,jms:jme) ) if(.not.allocated(snowc_p) ) allocate(snowc_p(ims:ime,jms:jme) ) if(.not.allocated(snowh_p) ) allocate(snowh_p(ims:ime,jms:jme) ) - if(.not.allocated(snopcx_p) ) allocate(snopcx_p(ims:ime,jms:jme) ) if(.not.allocated(snowsi_p) ) allocate(snowsi_p(ims:ime,jms:jme) ) if(.not.allocated(swdown_p) ) allocate(swdown_p(ims:ime,jms:jme) ) if(.not.allocated(sr_p) ) allocate(sr_p(ims:ime,jms:jme) ) @@ -73,9 +80,6 @@ subroutine allocate_seaice if(.not.allocated(xice_p) ) allocate(xice_p(ims:ime,jms:jme) ) if(.not.allocated(z0_p) ) allocate(z0_p(ims:ime,jms:jme) ) if(.not.allocated(znt_p) ) allocate(znt_p(ims:ime,jms:jme) ) - if(.not.allocated(q2_p) ) allocate(q2_p(ims:ime,jms:jme) ) - 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(tsk_sea) ) allocate(tsk_sea(ims:ime,jms:jme) ) if(.not.allocated(tsk_ice) ) allocate(tsk_ice(ims:ime,jms:jme) ) @@ -85,12 +89,31 @@ subroutine allocate_seaice if(.not.allocated(tslb_p)) allocate(tslb_p(ims:ime,1:num_soils,jms:jme)) + sf_select: select case(trim(lsm_scheme)) + case("sf_noah") + if(.not.allocated(noahres_p)) allocate(noahres_p(ims:ime,jms:jme)) + if(.not.allocated(potevp_p) ) allocate(potevp_p(ims:ime,jms:jme) ) + if(.not.allocated(snopcx_p) ) allocate(snopcx_p(ims:ime,jms:jme) ) + + case default + end select sf_select + end subroutine allocate_seaice !================================================================================================================= - subroutine deallocate_seaice + subroutine deallocate_seaice(configs) !================================================================================================================= +!input arguments: + type(mpas_pool_type),intent(in):: configs + +!local pointers: + character(len=StrKIND),pointer:: lsm_scheme + +!----------------------------------------------------------------------------------------------------------------- + + call mpas_pool_get_config(configs,'config_lsm_scheme',lsm_scheme) + if(allocated(acsnom_p) ) deallocate(acsnom_p ) if(allocated(acsnow_p) ) deallocate(acsnow_p ) if(allocated(albsi_p) ) deallocate(albsi_p ) @@ -107,8 +130,6 @@ subroutine deallocate_seaice if(allocated(hfx_p) ) deallocate(hfx_p ) if(allocated(qfx_p) ) deallocate(qfx_p ) if(allocated(lh_p) ) deallocate(lh_p ) - if(allocated(noahres_p) ) deallocate(noahres_p ) - if(allocated(potevp_p) ) deallocate(potevp_p ) if(allocated(rainbl_p) ) deallocate(rainbl_p ) if(allocated(sfc_albedo_p)) deallocate(sfc_albedo_p) if(allocated(sfc_emiss_p) ) deallocate(sfc_emiss_p ) @@ -117,7 +138,6 @@ subroutine deallocate_seaice if(allocated(snow_p) ) deallocate(snow_p ) if(allocated(snowc_p) ) deallocate(snowc_p ) if(allocated(snowh_p) ) deallocate(snowh_p ) - if(allocated(snopcx_p) ) deallocate(snopcx_p ) if(allocated(snowsi_p) ) deallocate(snowsi_p ) if(allocated(swdown_p) ) deallocate(swdown_p ) if(allocated(sr_p) ) deallocate(sr_p ) @@ -125,9 +145,6 @@ subroutine deallocate_seaice if(allocated(xice_p) ) deallocate(xice_p ) if(allocated(z0_p) ) deallocate(z0_p ) if(allocated(znt_p) ) deallocate(znt_p ) - if(allocated(q2_p) ) deallocate(q2_p ) - if(allocated(t2m_p) ) deallocate(t2m_p ) - if(allocated(th2m_p) ) deallocate(th2m_p ) if(allocated(chs_sea) ) deallocate(chs_sea ) if(allocated(chs2_sea) ) deallocate(chs2_sea ) @@ -146,6 +163,15 @@ subroutine deallocate_seaice if(allocated(tslb_p)) deallocate(tslb_p) + sf_select: select case(trim(lsm_scheme)) + case("sf_noah") + if(allocated(noahres_p)) deallocate(noahres_p) + if(allocated(potevp_p) ) deallocate(potevp_p ) + if(allocated(snopcx_p) ) deallocate(snopcx_p ) + + case default + end select sf_select + end subroutine deallocate_seaice !================================================================================================================= @@ -160,6 +186,7 @@ subroutine seaice_from_MPAS(configs,diag_physics,sfc_input,its,ite) !local pointers: character(len=StrKIND),pointer:: convection_scheme, & + lsm_scheme, & microp_scheme real(kind=RKIND),dimension(:),pointer:: acsnom,acsnow,br,chs,chs2,cpm,cqs2,qgh,qsfc,glw,gsw,grdflx,hfx, & @@ -175,6 +202,7 @@ subroutine seaice_from_MPAS(configs,diag_physics,sfc_input,its,ite) !call mpas_log_write('--- enter subroutine seaice_from_MPAS:') call mpas_pool_get_config(configs,'config_convection_scheme',convection_scheme) + call mpas_pool_get_config(configs,'config_lsm_scheme' ,lsm_scheme ) call mpas_pool_get_config(configs,'config_microp_scheme' ,microp_scheme ) call mpas_pool_get_array(diag_physics,'acsnom' ,acsnom ) @@ -192,12 +220,10 @@ subroutine seaice_from_MPAS(configs,diag_physics,sfc_input,its,ite) call mpas_pool_get_array(diag_physics,'hfx' ,hfx ) call mpas_pool_get_array(diag_physics,'qfx' ,qfx ) 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,'sfc_albedo',sfc_albedo) 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,'snopcx' ,snopcx ) call mpas_pool_get_array(diag_physics,'z0' ,z0 ) call mpas_pool_get_array(diag_physics,'znt' ,znt ) @@ -236,9 +262,6 @@ subroutine seaice_from_MPAS(configs,diag_physics,sfc_input,its,ite) albsi_p(i,j) = seaice_albedo_default snowsi_p(i,j) = seaice_snowdepth_min icedepth_p(i,j) = seaice_thickness_default - !--- inout optional variables: - potevp_p(i,j) = potevp(i) - snopcx_p(i,j) = snopcx(i) !--- output variables: hfx_p(i,j) = hfx(i) @@ -248,8 +271,6 @@ subroutine seaice_from_MPAS(configs,diag_physics,sfc_input,its,ite) grdflx_p(i,j) = grdflx(i) qsfc_p(i,j) = qsfc(i) chs2_p(i,j) = chs2(i) - !--- output optional variables: - noahres_p(i,j) = noahres(i) !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 @@ -290,6 +311,24 @@ subroutine seaice_from_MPAS(configs,diag_physics,sfc_input,its,ite) endif enddo + sf_select: select case(trim(lsm_scheme)) + case("sf_noah") + 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,'snopcx' ,snopcx ) + + do j = jts,jte + do i = its,ite + !--- inout and out optional variables: + noahres_p(i,j) = noahres(i) + potevp_p(i,j) = potevp(i) + snopcx_p(i,j) = snopcx(i) + enddo + enddo + + case default + end select sf_select + !call mpas_log_write('--- end subroutine seaice_from_MPAS:') end subroutine seaice_from_MPAS @@ -307,10 +346,11 @@ subroutine seaice_to_MPAS(configs,diag_physics,sfc_input,its,ite) !local pointers: character(len=StrKIND),pointer:: config_microp_scheme + character(len=StrKIND),pointer:: lsm_scheme + real(kind=RKIND),dimension(:),pointer:: acsnom,acsnow,chs,chs2,cpm,cqs2,qgh,qsfc,grdflx,hfx, qfx,lh,noahres, & potevp,sfc_albedo,sfc_emiss,sfcrunoff,snopcx,z0,znt real(kind=RKIND),dimension(:),pointer:: snow,snowc,snowh,skintemp,xice - real(kind=RKIND),dimension(:),pointer:: t2m,th2m,q2 real(kind=RKIND),dimension(:,:),pointer:: tslb !local variables and arrays: @@ -319,6 +359,8 @@ subroutine seaice_to_MPAS(configs,diag_physics,sfc_input,its,ite) !----------------------------------------------------------------------------------------------------------------- !call mpas_log_write('--- enter subroutine seaice_to_MPAS:') + call mpas_pool_get_config(configs,'config_lsm_scheme',lsm_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,'chs' ,chs ) @@ -331,17 +373,13 @@ subroutine seaice_to_MPAS(configs,diag_physics,sfc_input,its,ite) call mpas_pool_get_array(diag_physics,'hfx' ,hfx ) call mpas_pool_get_array(diag_physics,'qfx' ,qfx ) 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,'sfc_albedo',sfc_albedo) 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,'snopcx' ,snopcx ) + 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,'snow' ,snow ) call mpas_pool_get_array(sfc_input,'snowc' ,snowc ) @@ -350,7 +388,7 @@ subroutine seaice_to_MPAS(configs,diag_physics,sfc_input,its,ite) call mpas_pool_get_array(sfc_input,'tslb' ,tslb ) call mpas_pool_get_array(sfc_input,'xice' ,xice ) -!--- weigh local variables needed in the calculation of t2m, th2m, and q2 over seaice points: +!--- reconstruct local variables as functions of the seaice fraction: do j = jts,jte do i = its,ite if(xice_p(i,j).ge.xice_threshold .and. xice_p(i,j).le.1._RKIND) then @@ -371,16 +409,6 @@ subroutine seaice_to_MPAS(configs,diag_physics,sfc_input,its,ite) enddo enddo - 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 , & - 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 & - ) - !--- update all variables: do j = jts,jte do i = its,ite @@ -396,15 +424,10 @@ subroutine seaice_to_MPAS(configs,diag_physics,sfc_input,its,ite) acsnom(i) = acsnom_p(i,j) acsnow(i) = acsnow_p(i,j) sfcrunoff(i) = sfcrunoff_p(i,j) - !--- inout optional variables: - potevp(i) = potevp_p(i,j) - snopcx(i) = snopcx_p(i,j) !--- output variables: znt(i) = znt_p(i,j) grdflx(i) = grdflx_p(i,j) - !--- output optional variables: - noahres(i) = noahres_p(i,j) chs(i) = chs_p(i,j) chs2(i) = chs2_p(i,j) @@ -416,14 +439,27 @@ subroutine seaice_to_MPAS(configs,diag_physics,sfc_input,its,ite) lh(i) = lh_p(i,j) sfc_albedo(i) = sfc_albedo_p(i,j) sfc_emiss(i) = sfc_emiss_p(i,j) - - !--- 2-meter diagnostics: - q2(i) = q2_p(i,j) - t2m(i) = t2m_p(i,j) - th2m(i) = th2m_p(i,j) enddo enddo + sf_select: select case(trim(lsm_scheme)) + case("sf_noah") + 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,'snopcx' ,snopcx ) + + do j = jts,jte + do i = its,ite + !--- inout and out optional variables: + noahres(i) = noahres_p(i,j) + potevp(i) = potevp_p(i,j) + snopcx(i) = snopcx_p(i,j) + enddo + enddo + + case default + end select sf_select + !call mpas_log_write('--- end subroutine seaice_to_MPAS:') end subroutine seaice_to_MPAS @@ -441,44 +477,82 @@ subroutine driver_seaice(configs,diag_physics,sfc_input,its,ite) type(mpas_pool_type),intent(inout):: sfc_input !local pointers: - integer:: i,j + character(len=StrKIND),pointer:: lsm_scheme !----------------------------------------------------------------------------------------------------------------- !call mpas_log_write(' ') !call mpas_log_write('--- enter subroutine driver_seaice: xice_threshold = $r',realArgs=(/xice_threshold/)) + call mpas_pool_get_config(configs,'config_lsm_scheme',lsm_scheme) + !copy MPAS arrays to local arrays: call seaice_from_MPAS(configs,diag_physics,sfc_input,its,ite) - 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 & - ) + sf_select: select case(trim(lsm_scheme)) + case("sf_noah") + 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 , 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 , acsnow = acsnow_p , & + acsnom = acsnom_p , sfcrunoff = sfcrunoff_p , albsi = albsi_p , & + snowsi = snowsi_p , icedepth = icedepth_p , dt = dt_pbl , & + frpcpn = frpcpn , noahres = noahres_p , potevp = potevp_p , & + snopcx = snopcx_p , & + 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 & + ) + + + case("sf_noahmp") + 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 , 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 , acsnow = acsnow_p , & + acsnom = acsnom_p , sfcrunoff = sfcrunoff_p , albsi = albsi_p , & + snowsi = snowsi_p , icedepth = icedepth_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 & + ) + + case default + end select sf_select !copy local arrays to MPAS grid: call seaice_to_MPAS(configs,diag_physics,sfc_input,its,ite) diff --git a/src/core_atmosphere/physics/mpas_atmphys_driver_sfclayer.F b/src/core_atmosphere/physics/mpas_atmphys_driver_sfclayer.F index 9fb5d4b19..f5fa6de96 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_driver_sfclayer.F +++ b/src/core_atmosphere/physics/mpas_atmphys_driver_sfclayer.F @@ -148,7 +148,7 @@ subroutine allocate_sfclayer(configs) if(.not.allocated(xland_p) ) allocate(xland_p(ims:ime,jms:jme) ) if(.not.allocated(zol_p) ) allocate(zol_p(ims:ime,jms:jme) ) if(.not.allocated(znt_p) ) allocate(znt_p(ims:ime,jms:jme) ) - + if(.not.allocated(sgsgustcu_p)) allocate(sgsgustcu_p(ims:ime,jms:jme) ) if(.not.allocated(hfx_spr_p) ) allocate(hfx_spr_p(ims:ime,jms:jme) ) if(.not.allocated(lh_spr_p) ) allocate(lh_spr_p(ims:ime,jms:jme) ) @@ -410,7 +410,7 @@ subroutine sfclayer_from_MPAS(configs,mesh,diag_physics,sfc_input,its,ite, & real(kind=RKIND),dimension(:,:),pointer:: buoyx real(kind=RKIND),dimension(:,:,:),pointer:: scalars real :: wspd_local, factor1, factor2, gspd_local -!----------------------------------------------------------------------------------------------------------------- +!----------------------------------------------------------------------------------------------------------------- !input variables: call mpas_pool_get_config(configs,'config_frac_seaice' ,config_frac_seaice) @@ -769,9 +769,6 @@ subroutine sfclayer_to_MPAS(configs,sfc_input,diag_physics,its,ite) call mpas_pool_get_array(diag_physics,'lh_spr' ,lh_spr ) call mpas_pool_get_array(diag_physics,'hfx_spr',hfx_spr) - - call mpas_pool_get_array(diag_physics,'lh_spr' ,lh_spr ) - call mpas_pool_get_array(diag_physics,'hfx_spr',hfx_spr) !output variables: call mpas_pool_get_array(diag_physics,'q2' ,q2 ) call mpas_pool_get_array(diag_physics,'t2m' ,t2m ) @@ -1086,71 +1083,71 @@ subroutine driver_sfclayer(itimestep,configs,mesh,diag_physics,sfc_input,its,ite call mpas_timer_start('sf_monin_obukhov_rev') call mpas_log_write('--- enter subroutine sfclayrev:') call sfclayrev( & - p3d = pres_hyd_p , psfc = psfc_p , t3d = t_p , & - u3d = u_p , v3d = v_p , qv3d = qv_p , & - dz8w = dz_p , cp = cp , g = gravity , & - rovcp = rcp , R = R_d , xlv = xlv , & - chs = chs_p , chs2 = chs2_p , cqs2 = cqs2_p , & - cpm = cpm_p , znt = znt_p , ust = ust_p , & - pblh = hpbl_p , mavail = mavail_p , zol = zol_p , & - mol = mol_p , regime = regime_p , psim = psim_p , & - psih = psih_p , fm = fm_p , fh = fh_p , & - xland = xland_p , hfx = hfx_p , qfx = qfx_p , & - lh = lh_p , tsk = tsk_p , flhc = flhc_p , & - flqc = flqc_p , qgh = qgh_p , qsfc = qsfc_p , & - 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_p , svp1 = svp1 , & - svp2 = svp2 , svp3 = svp3 , svpt0 = svpt0 , & - ep1 = ep_1 , ep2 = ep_2 , karman = karman , & - eomeg = eomeg , stbolt = stbolt , P1000mb = P0 , & - ustm = ustm_p , ck = ck_p , cka = cka_p , & - cd = cd_p , cda = cda_p , isftcflx = isftcflx , & - iz0tlnd = iz0tlnd , shalwater_z0 = shalwater_flag , shalwater_depth = shalwater_depth , & - water_depth = waterdepth_p , scm_force_flux = scm_force_flux , & - errmsg = errmsg , errflg = errflg , & - 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 & + p3d = pres_hyd_p , psfc = psfc_p , t3d = t_p , & + u3d = u_p , v3d = v_p , qv3d = qv_p , & + dz8w = dz_p , cp = cp , g = gravity , & + rovcp = rcp , R = R_d , xlv = xlv , & + chs = chs_p , chs2 = chs2_p , cqs2 = cqs2_p , & + cpm = cpm_p , znt = znt_p , ust = ust_p , & + pblh = hpbl_p , mavail = mavail_p , zol = zol_p , & + mol = mol_p , regime = regime_p , psim = psim_p , & + psih = psih_p , fm = fm_p , fh = fh_p , & + xland = xland_p , hfx = hfx_p , qfx = qfx_p , & + lh = lh_p , tsk = tsk_p , flhc = flhc_p , & + flqc = flqc_p , qgh = qgh_p , qsfc = qsfc_p , & + 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_p , svp1 = svp1 , & + svp2 = svp2 , svp3 = svp3 , svpt0 = svpt0 , & + ep1 = ep_1 , ep2 = ep_2 , karman = karman , & + p1000mb = P0 , lakemask = lakemask_p , ustm = ustm_p , & + ck = ck_p , cka = cka_p , cd = cd_p , & + cda = cda_p , isftcflx = isftcflx , iz0tlnd = iz0tlnd , & + shalwater_z0 = shalwater_flag , water_depth = waterdepth_p , scm_force_flux = scm_force_flux , & + errmsg = errmsg , errflg = errflg , & + 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_log_write('--- end subroutine sfclayrev:') if(config_frac_seaice) then call mpas_log_write('--- enter subroutine sfclayrev seaice:') call sfclayrev( & - p3d = pres_hyd_p , psfc = psfc_p , t3d = t_p , & - u3d = u_p , v3d = v_p , qv3d = qv_p , & - dz8w = dz_p , cp = cp , g = gravity , & - rovcp = rcp , R = R_d , xlv = xlv , & - chs = chs_sea , chs2 = chs2_sea , cqs2 = cqs2_sea , & - cpm = cpm_sea , znt = znt_sea , ust = ust_sea , & - pblh = hpbl_p , mavail = mavail_sea , zol = zol_sea , & - mol = mol_sea , regime = regime_sea , psim = psim_sea , & - psih = psih_sea , fm = fm_sea , fh = fh_sea , & - xland = xland_sea , hfx = hfx_sea , qfx = qfx_sea , & - lh = lh_sea , tsk = tsk_sea , flhc = flhc_sea , & - flqc = flqc_sea , qgh = qgh_sea , qsfc = qsfc_sea , & - 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_p , svp1 = svp1 , & - svp2 = svp2 , svp3 = svp3 , svpt0 = svpt0 , & - ep1 = ep_1 , ep2 = ep_2 , karman = karman , & - eomeg = eomeg , stbolt = stbolt , P1000mb = P0 , & - ustm = ustm_sea , ck = ck_sea , cka = cka_sea , & - cd = cd_sea , cda = cda_sea , isftcflx = isftcflx , & - iz0tlnd = iz0tlnd , shalwater_z0 = shalwater_flag , shalwater_depth = shalwater_depth , & - water_depth = waterdepth_p , scm_force_flux = scm_force_flux , & - errmsg = errmsg , errflg = errflg , & - 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 & + p3d = pres_hyd_p , psfc = psfc_p , t3d = t_p , & + u3d = u_p , v3d = v_p , qv3d = qv_p , & + dz8w = dz_p , cp = cp , g = gravity , & + rovcp = rcp , R = R_d , xlv = xlv , & + chs = chs_sea , chs2 = chs2_sea , cqs2 = cqs2_sea , & + cpm = cpm_sea , znt = znt_sea , ust = ust_sea , & + pblh = hpbl_p , mavail = mavail_sea , zol = zol_sea , & + mol = mol_sea , regime = regime_sea , psim = psim_sea , & + psih = psih_sea , fm = fm_sea , fh = fh_sea , & + xland = xland_sea , hfx = hfx_sea , qfx = qfx_sea , & + lh = lh_sea , tsk = tsk_sea , flhc = flhc_sea , & + flqc = flqc_sea , qgh = qgh_sea , qsfc = qsfc_sea , & + 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_p , svp1 = svp1 , & + svp2 = svp2 , svp3 = svp3 , svpt0 = svpt0 , & + ep1 = ep_1 , ep2 = ep_2 , karman = karman , & + p1000mb = P0 , lakemask = lakemask_p , ustm = ustm_sea , & + ck = ck_sea , cka = cka_sea , cd = cd_sea , & + cda = cda_sea , isftcflx = isftcflx , iz0tlnd = iz0tlnd , & + shalwater_z0 = shalwater_flag , water_depth = waterdepth_p , scm_force_flux = scm_force_flux , & + errmsg = errmsg , errflg = errflg , & + 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_log_write('--- end subroutine sfclayrev seaice:') endif call mpas_timer_stop('sf_monin_obukhov_rev') + case("sf_mynn") call mpas_timer_start('sf_mynn') call sfclay_mynn( & @@ -1185,6 +1182,7 @@ subroutine driver_sfclayer(itimestep,configs,mesh,diag_physics,sfc_input,its,ite its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte & ) + if(config_frac_seaice) then call sfclay_mynn( & p3d = pres_hyd_p , pi3d = pi_p , psfcpa = psfc_p , & @@ -1217,6 +1215,7 @@ subroutine driver_sfclayer(itimestep,configs,mesh,diag_physics,sfc_input,its,ite 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 mpas_timer_stop('sf_mynn') diff --git a/src/core_atmosphere/physics/mpas_atmphys_finalize.F b/src/core_atmosphere/physics/mpas_atmphys_finalize.F index 8ad924819..5367d8328 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_finalize.F +++ b/src/core_atmosphere/physics/mpas_atmphys_finalize.F @@ -9,7 +9,9 @@ module mpas_atmphys_finalize use mpas_pool_routines + use mpas_atmphys_lsm_noahmpfinalize,only: sf_noahmp_deallocate use module_mp_thompson + use cires_ugwpv1_module implicit none private @@ -24,7 +26,9 @@ module mpas_atmphys_finalize ! * added subroutine mp_thompson_deallocate which deallocate arrays used in the initialization of the Thompson ! cloud microphysics scheme. these arrays contain coefficients for collection,collision,freezing, ... ! Laura D. Fowler (laura@ucar.edu) / 2016-03-22. - +! * added subroutine ugwpv1_ngw_deallocate which deallocates arrays used in the initialization of the +! non-stationary gravity wave (NGW) scheme +! Michael D. toy (michael.toy@noaa.gov) / 2024-10-21 contains @@ -37,14 +41,28 @@ subroutine atmphys_finalize(configs) type(mpas_pool_type),intent(in):: configs !local variables and pointers: - character(len=StrKIND),pointer:: config_microp_scheme + character(len=StrKIND),pointer:: config_lsm_scheme, & + config_microp_scheme + character(len=StrKIND),pointer:: config_gwdo_scheme + logical,pointer:: config_ngw_scheme !----------------------------------------------------------------------------------------------------------------- + call mpas_pool_get_config(configs,'config_lsm_scheme' ,config_lsm_scheme ) call mpas_pool_get_config(configs,'config_microp_scheme',config_microp_scheme) + call mpas_pool_get_config(configs,'config_gwdo_scheme',config_gwdo_scheme) + call mpas_pool_get_config(configs,'config_ngw_scheme',config_ngw_scheme) + + if(trim(config_lsm_scheme) == 'sf_noahmp') & + call sf_noahmp_deallocate - if(trim(config_microp_scheme) == 'mp_thompson') & + if(trim(config_microp_scheme) == 'mp_thompson' .or. & + trim(config_microp_scheme) == 'mp_thompson_aerosols') then call mp_thompson_deallocate + endif + + if((trim(config_gwdo_scheme) == 'bl_ugwp_gwdo').and.config_ngw_scheme) & + call ugwpv1_ngw_deallocate end subroutine atmphys_finalize @@ -92,6 +110,16 @@ subroutine mp_thompson_deallocate end subroutine mp_thompson_deallocate + +!================================================================================================================= + subroutine ugwpv1_ngw_deallocate +!================================================================================================================= + + call cires_ugwp_dealloc + + end subroutine ugwpv1_ngw_deallocate + + !================================================================================================================= end module mpas_atmphys_finalize !================================================================================================================= diff --git a/src/core_atmosphere/physics/mpas_atmphys_init.F b/src/core_atmosphere/physics/mpas_atmphys_init.F index 1e9c790db..4cf54fefb 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_init.F +++ b/src/core_atmosphere/physics/mpas_atmphys_init.F @@ -11,17 +11,20 @@ module mpas_atmphys_init use mpas_pool_routines use mpas_timekeeping - use mpas_atmphys_driver_convection, only: init_convection + use mpas_atmphys_driver_convection,only: init_convection use mpas_atmphys_driver_lsm,only: init_lsm - use mpas_atmphys_driver_microphysics + use mpas_atmphys_driver_microphysics,only: init_microphysics use mpas_atmphys_driver_pbl,only: init_pbl - use mpas_atmphys_driver_radiation_lw, only: init_radiation_lw - use mpas_atmphys_driver_radiation_sw, only: init_radiation_sw - use mpas_atmphys_driver_sfclayer + use mpas_atmphys_driver_radiation_lw,only: init_radiation_lw + use mpas_atmphys_driver_radiation_sw,only: init_radiation_sw + use mpas_atmphys_driver_sfclayer,only: init_sfclayer use mpas_atmphys_vars,only: f_qc,f_qr,f_qi,f_qs,f_qg,f_qoz,f_nc,f_ni,f_nifa,f_nwfa,f_nbca use mpas_atmphys_landuse use mpas_atmphys_o3climatology + use mpas_atmphys_lsm_noahmpinit,only: init_lsm_noahmp + + use bl_ugwpv1_ngw, only: ugwpv1_ngw_init implicit none private @@ -68,18 +71,23 @@ module mpas_atmphys_init ! Laura D. Fowler (laura@ucar.edu) / 2016-10-18. ! * added the subroutine init_physics_flags to initialize f_qc,f_qr,f_qi,f_qs,f_qg,f_nc,and f_ni. ! Laura D. Fowler (laura@ucar.edu) / 2024-02-14. +! * added call to subroutine init_lsm_noahmp to initialize the Noah-MP land surface scheme. +! Laura D. Fowler (laura@ucar.edu) / 2024-03-11. contains !================================================================================================================= - subroutine physics_init(dminfo,clock,configs,mesh,diag,tend,state,time_lev,diag_physics, & - atm_input,sfc_input) + subroutine physics_init(dminfo,stream_manager,clock,configs,mesh,diag,tend,state,time_lev,diag_physics, & + diag_physics_noahmp,ngw_input,atm_input,sfc_input,output_noahmp) !================================================================================================================= +use mpas_stream_manager + !input arguments: type(dm_info),intent(in):: dminfo + type(MPAS_streamManager_type),intent(inout):: stream_manager type(mpas_pool_type),intent(in):: mesh type(mpas_pool_type),intent(in):: configs type(MPAS_Clock_type),intent(in):: clock @@ -91,12 +99,16 @@ subroutine physics_init(dminfo,clock,configs,mesh,diag,tend,state,time_lev,diag_ type(mpas_pool_type),intent(inout):: diag type(mpas_pool_type),intent(inout):: tend type(mpas_pool_type),intent(inout):: diag_physics + type(mpas_pool_type),intent(inout):: diag_physics_noahmp + type(mpas_pool_type),intent(inout):: ngw_input type(mpas_pool_type),intent(inout):: atm_input type(mpas_pool_type),intent(inout):: sfc_input + type(mpas_pool_type),intent(inout):: output_noahmp !local pointers: - logical,pointer:: config_do_restart, & - config_o3climatology + logical,pointer:: config_do_restart, & + config_o3climatology, & + config_oml1d character(len=StrKIND),pointer:: & config_convection_scheme, & @@ -108,39 +120,46 @@ subroutine physics_init(dminfo,clock,configs,mesh,diag,tend,state,time_lev,diag_ config_radt_sw_scheme integer,pointer:: nCellsSolve,nLags - integer,dimension(:),pointer :: i_rainc,i_rainnc - integer,dimension(:),pointer :: i_acswdnb,i_acswdnbc,i_acswdnt,i_acswdntc, & - i_acswupb,i_acswupbc,i_acswupt,i_acswuptc, & - i_aclwdnb,i_aclwdnbc,i_aclwdnt,i_aclwdntc, & - i_aclwupb,i_aclwupbc,i_aclwupt,i_aclwuptc - - real(kind=RKIND),dimension(:),pointer :: acswdnb,acswdnbc,acswdnt,acswdntc, & - acswupb,acswupbc,acswupt,acswuptc, & - aclwdnb,aclwdnbc,aclwdnt,aclwdntc, & - aclwupb,aclwupbc,aclwupt,aclwuptc - real(kind=RKIND),dimension(:),pointer :: nsteps_accum,ndays_accum,tday_accum, & - tyear_accum,tyear_mean - real(kind=RKIND),dimension(:),pointer :: sst,sstsk,tmn,xice,xicem + integer,dimension(:),pointer:: i_rainc,i_rainnc + integer,dimension(:),pointer:: i_acswdnb,i_acswdnbc,i_acswdnt,i_acswdntc, & + i_acswupb,i_acswupbc,i_acswupt,i_acswuptc, & + i_aclwdnb,i_aclwdnbc,i_aclwdnt,i_aclwdntc, & + i_aclwupb,i_aclwupbc,i_aclwupt,i_aclwuptc + + real(kind=RKIND),dimension(:),pointer:: acswdnb,acswdnbc,acswdnt,acswdntc, & + acswupb,acswupbc,acswupt,acswuptc, & + aclwdnb,aclwdnbc,aclwdnt,aclwdntc, & + aclwupb,aclwupbc,aclwupt,aclwuptc + real(kind=RKIND),dimension(:),pointer:: nsteps_accum,ndays_accum,tday_accum, & + tyear_accum,tyear_mean + real(kind=RKIND),dimension(:),pointer:: sst,sstsk,tmn,xice,xicem real(kind=RKIND),dimension(:,:),pointer:: tlag - real(kind=RKIND),dimension(:),pointer :: t_oml, t_oml_initial, t_oml_200m_initial - real(kind=RKIND),dimension(:),pointer :: h_oml, h_oml_initial, hu_oml, hv_oml - real(kind=RKIND), pointer :: config_oml_hml0 - integer,pointer:: nCells - logical,pointer:: config_oml1d - - + real(kind=RKIND),pointer:: config_oml_hml0 + real(kind=RKIND),dimension(:),pointer:: t_oml,t_oml_initial,t_oml_200m_initial + real(kind=RKIND),dimension(:),pointer:: h_oml,h_oml_initial,hu_oml,hv_oml + real(kind=RKIND),dimension(:),pointer:: rdzw,dzu + real(kind=RKIND),pointer:: config_dt + integer,pointer:: nCells,nVertLevels + character(len=StrKIND),pointer:: gwdo_scheme + logical,pointer:: ngw_scheme + integer,pointer:: ntau_d1y + real(kind=RKIND),pointer:: knob_ugwp_tauamp + real(kind=RKIND),dimension(:),pointer:: ugwp_taulat + integer,dimension(:),pointer:: jindx1_tau, jindx2_tau + real(kind=RKIND),dimension(:),pointer:: ddy_j1tau, ddy_j2tau + real(kind=RKIND),dimension(:),pointer:: latCell !local variables and arrays: type(MPAS_Time_Type):: currTime logical:: init_done integer:: ierr,julday - integer:: iCell,iLag,iEdge,nEdges_m + integer:: iCell,iLag !----------------------------------------------------------------------------------------------------------------- -! call mpas_log_write('') -! call mpas_log_write('--- enter subroutine physics_init:') +!call mpas_log_write('') +!call mpas_log_write('--- enter subroutine physics_init:') call mpas_pool_get_config(configs,'config_do_restart' ,config_do_restart ) call mpas_pool_get_config(configs,'config_o3climatology' ,config_o3climatology ) @@ -211,7 +230,13 @@ subroutine physics_init(dminfo,clock,configs,mesh,diag,tend,state,time_lev,diag_ call mpas_pool_get_array(diag_physics,'hv_oml' ,hv_oml) call mpas_pool_get_config(configs,'config_oml1d' ,config_oml1d ) call mpas_pool_get_config(configs,'config_oml_hml0' ,config_oml_hml0 ) + call mpas_pool_get_config(configs,'config_gwdo_scheme' ,gwdo_scheme ) + call mpas_pool_get_config(configs,'config_ngw_scheme' ,ngw_scheme ) + call mpas_pool_get_config(configs,'config_dt' ,config_dt ) call mpas_pool_get_dimension(mesh,'nCells',nCells) + call mpas_pool_get_dimension(mesh,'nVertLevels',nVertLevels ) + call mpas_pool_get_array(mesh,'rdzw' ,rdzw ) + call mpas_pool_get_array(mesh,'dzu' ,dzu ) currTime = mpas_get_clock_time(clock,MPAS_NOW,ierr) call mpas_get_time(curr_time=currTime,DoY=julday,ierr=ierr) @@ -284,7 +309,7 @@ subroutine physics_init(dminfo,clock,configs,mesh,diag,tend,state,time_lev,diag_ !initialization of xicem: if(.not.config_do_restart) then -! call mpas_log_write('--- initialization of xicem:') +! call mpas_log_write('--- initialization of xicem:') do iCell = 1, nCellsSolve xicem(iCell) = xice(iCell) enddo @@ -294,47 +319,47 @@ subroutine physics_init(dminfo,clock,configs,mesh,diag,tend,state,time_lev,diag_ !sea-surface temperature is applied. This avoids having the array sstsk equal to !zero over land: if(.not. config_do_restart) then -! call mpas_log_write('--- initialization of sstsk:') +! call mpas_log_write('--- initialization of sstsk:') do iCell = 1, nCellsSolve sstsk(iCell) = sst(iCell) enddo endif -! initialized the 1D ocean mixed-layer model (code from wrf module_sf_oml) - if (config_oml1d) then - if (.not. config_do_restart) then - call mpas_log_write('--- initialization of 1D ocean mixed layer model ') - do iCell = 1, nCellsSolve - t_oml(iCell) = sst(iCell) - t_oml_initial(iCell) = sst(iCell) - end do - if (config_oml_hml0 .gt. 0) then - do iCell = 1, nCellsSolve - h_oml(iCell) = config_oml_hml0 - h_oml_initial(iCell) = config_oml_hml0 - hu_oml(iCell) = 0. - hv_oml(iCell) = 0. - t_oml_200m_initial(iCell) = sst(iCell) - 5. - end do - else if (config_oml_hml0 .eq. 0) then -! initializing with climatological mixed layer depth only - do iCell = 1, nCellsSolve - h_oml(iCell) = h_oml_initial(iCell) - hu_oml(iCell) = 0. - hv_oml(iCell) = 0. - t_oml_200m_initial(iCell) = sst(iCell) - 5. - end do - else - do iCell = 1, nCellsSolve - h_oml(iCell) = h_oml_initial(iCell) - ! WRF COMMENT: - ! fill in near coast area with SST: 200 K was set as missing value in ocean pre-processing code - if( (t_oml_200m_initial(iCell) > 200.) .and. (t_oml_200m_initial(iCell) <= 200.) ) & - t_oml_200m_initial(iCell) = sst(iCell) - end do - end if - end if - end if +!initialized the 1D ocean mixed-layer model (code from wrf module_sf_oml): + if(config_oml1d) then + if(.not. config_do_restart) then + call mpas_log_write('--- initialization of 1D ocean mixed layer model ') + do iCell = 1, nCellsSolve + t_oml(iCell) = sst(iCell) + t_oml_initial(iCell) = sst(iCell) + enddo + if(config_oml_hml0 .gt. 0) then + do iCell = 1, nCellsSolve + h_oml(iCell) = config_oml_hml0 + h_oml_initial(iCell) = config_oml_hml0 + hu_oml(iCell) = 0. + hv_oml(iCell) = 0. + t_oml_200m_initial(iCell) = sst(iCell) - 5. + enddo + elseif(config_oml_hml0 .eq. 0) then +! initializing with climatological mixed layer depth only: + do iCell = 1, nCellsSolve + h_oml(iCell) = h_oml_initial(iCell) + hu_oml(iCell) = 0. + hv_oml(iCell) = 0. + t_oml_200m_initial(iCell) = sst(iCell) - 5. + enddo + else + do iCell = 1, nCellsSolve + h_oml(iCell) = h_oml_initial(iCell) + ! WRF COMMENT: + ! fill in near coast area with SST: 200 K was set as missing value in ocean pre-processing code + if( (t_oml_200m_initial(iCell) > 200.) .and. (t_oml_200m_initial(iCell) <= 200.) ) & + t_oml_200m_initial(iCell) = sst(iCell) + enddo + endif + endif + endif !initialization of temperatures needed for updating the deep soil temperature: if(.not. config_do_restart) then @@ -363,7 +388,7 @@ subroutine physics_init(dminfo,clock,configs,mesh,diag,tend,state,time_lev,diag_ !initialization of cloud microphysics processes: if(config_microp_scheme .ne. 'off') & - call microphysics_init(dminfo,configs,mesh,sfc_input,diag_physics) + call init_microphysics(dminfo,configs,mesh,state,time_lev,sfc_input,diag_physics) !initialization of PBL processes: if(config_pbl_scheme .ne. 'off') call init_pbl(configs) @@ -372,10 +397,13 @@ subroutine physics_init(dminfo,clock,configs,mesh,diag,tend,state,time_lev,diag_ if(config_sfclayer_scheme .ne. 'off') call init_sfclayer(configs) !initialization of land-surface model: -!if(.not. config_do_restart) then -! if(config_lsm_scheme .ne. 'off') call init_lsm(dminfo,mesh,configs,diag_physics,sfc_input) -!endif - if(config_lsm_scheme .ne. 'off') call init_lsm(dminfo,mesh,configs,diag_physics,sfc_input) + if(config_lsm_scheme .ne. 'off') then + if(config_lsm_scheme .eq. 'sf_noah') then + call init_lsm(dminfo,mesh,configs,diag_physics,sfc_input) + elseif(config_lsm_scheme .eq. 'sf_noahmp') then + call init_lsm_noahmp(configs,mesh,clock,diag_physics,diag_physics_noahmp,output_noahmp,sfc_input) + endif + endif !initialization of shortwave radiation processes: init_done = .false. @@ -404,6 +432,30 @@ subroutine physics_init(dminfo,clock,configs,mesh,diag,tend,state,time_lev,diag_ endif endif +!initialization of non-stationary gravity wave drag + if(trim(gwdo_scheme).eq.'bl_ugwp_gwdo') then + ! Read in ugwp_oro_data + call MPAS_stream_mgr_read(stream_manager, streamID='ugwp_oro_data_in', whence=MPAS_STREAM_NEAREST, ierr=ierr) + call MPAS_stream_mgr_reset_alarms(stream_manager, streamID='ugwp_oro_data_in', direction=MPAS_STREAM_INPUT, ierr=ierr) + if (ngw_scheme) then + call mpas_log_write('Initializing non-stationary GWD scheme',masterOnly=.true.) + call MPAS_stream_mgr_read(stream_manager, streamID='ugwp_ngw_in', whence=MPAS_STREAM_NEAREST, ierr=ierr) + call MPAS_stream_mgr_reset_alarms(stream_manager, streamID='ugwp_ngw_in', direction=MPAS_STREAM_INPUT, ierr=ierr) + call mpas_pool_get_config(configs,'config_knob_ugwp_tauamp', knob_ugwp_tauamp) + call mpas_pool_get_dimension(mesh,'lat',ntau_d1y) + call mpas_pool_get_array(ngw_input,'LATS',ugwp_taulat) + call mpas_pool_get_array(ngw_input,'jindx1_tau' ,jindx1_tau ) + call mpas_pool_get_array(ngw_input,'jindx2_tau' ,jindx2_tau ) + call mpas_pool_get_array(ngw_input,'ddy_j1tau' ,ddy_j1tau ) + call mpas_pool_get_array(ngw_input,'ddy_j2tau' ,ddy_j2tau ) + call mpas_pool_get_array(mesh,'latCell',latCell) + call mpas_log_write('--- Initializing UGWP non-stationary GWD parameters ---',masterOnly=.true.) + call ugwpv1_ngw_init(latCell,nVertLevels,config_dt,rdzw,dzu,ntau_d1y, & + knob_ugwp_tauamp,ugwp_taulat,jindx1_tau,jindx2_tau,ddy_j1tau,ddy_j2tau) + call mpas_log_write('--- UGWP non-stationary GWD parameters initialized ---',masterOnly=.true.) + endif + endif + ! call mpas_log_write('') ! call mpas_log_write('--- end subroutine physics_init') ! call mpas_log_write('') @@ -423,7 +475,7 @@ subroutine init_physics_flags(state,f_qc,f_qr,f_qi,f_qs,f_qg,f_qoz,f_nc,f_ni,f_n !local pointers: integer,pointer:: index_qc,index_qr,index_qi,index_qs,index_qg - integer,pointer:: index_ni + integer,pointer:: index_nc,index_ni,index_nifa,index_nwfa !----------------------------------------------------------------------------------------------------------------- @@ -447,15 +499,20 @@ subroutine init_physics_flags(state,f_qc,f_qr,f_qi,f_qs,f_qg,f_qoz,f_nc,f_ni,f_n if(index_qg .gt. -1) f_qg = .true. !initializes the logical assigned to number concentrations: - f_nc = .false. !nc is not defined in Registry.xml - therefore f_nc is initialized to false. + f_nc = .false. f_ni = .false. - f_nifa = .false. !nifa is not defined in Registry.xml - therefore f_nc is initialized to false. - f_nwfa = .false. !nwfa is not defined in Registry.xml - therefore f_nc is initialized to false. + f_nifa = .false. + f_nwfa = .false. f_nbca = .false. !nbca is not defined in Registry.xml - therefore f_nc is initialized to false. - - call mpas_pool_get_dimension(state,'index_ni',index_ni) - - if(index_ni .gt. -1) f_ni = .true. + call mpas_pool_get_dimension(state,'index_nc' ,index_nc ) + call mpas_pool_get_dimension(state,'index_ni' ,index_ni ) + call mpas_pool_get_dimension(state,'index_nifa',index_nifa) + call mpas_pool_get_dimension(state,'index_nwfa',index_nwfa) + + if(index_nc .gt. -1) f_nc = .true. + if(index_ni .gt. -1) f_ni = .true. + if(index_nifa .gt. -1) f_nifa = .true. + if(index_nwfa .gt. -1) f_nwfa = .true. end subroutine init_physics_flags diff --git a/src/core_atmosphere/physics/mpas_atmphys_init_microphysics.F b/src/core_atmosphere/physics/mpas_atmphys_init_microphysics.F index 7ea396c6c..509bb86fa 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_init_microphysics.F +++ b/src/core_atmosphere/physics/mpas_atmphys_init_microphysics.F @@ -5,20 +5,23 @@ ! 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 ! +#define DM_BCAST_MACRO(A) call mpas_dmpar_bcast_real4s(dminfo,size(A),A) !================================================================================================================= module mpas_atmphys_init_microphysics use mpas_dmpar use mpas_kind_types + use mpas_log use mpas_pool_routines use mpas_atmphys_utilities -!use module_mp_thompson, only: is_aerosol_aware,naCCN0,naCCN1,naIN0,naIN1,ntb_arc,ntb_arw,ntb_art,ntb_arr, & -! ntb_ark,tnccn_act + use module_mp_thompson, only: is_aerosol_aware,naCCN0,naCCN1,naIN0,naIN1,ntb_arc,ntb_arw,ntb_art,ntb_arr, & + ntb_ark,tnccn_act implicit none private - public:: init_thompson_clouddroplets_forMPAS + public:: init_thompson_clouddroplets_forMPAS, & + init_thompson_aerosols_forMPAS !MPAS main initialization of the Thompson parameterization of cloud microphysics with nucleation of cloud !droplets based on distributions of CCNs and INs (aerosol-aware parameterization). @@ -29,6 +32,15 @@ module mpas_atmphys_init_microphysics ! ---------------------------------------- ! * added "use mpas_dmpar" at the top of the module. ! Laura D. Fowler (laura@ucar.edu) / 2016-04-04. +! * modified the initialization of nifa and nwfa.If nifa and nwfa are already available in the initial conditions +! using the climatological GOCART data,do not recalculate nifa and nwfa using an exponential profile of CCN and +! IN as a function of height. +! Laura D. Fowler (laura@ucar.edu) / 2016-05-27. +! * modified the subroutine init_thompson_aerosols_forMPAS for exact restartibility when using the microphysics +! option "mp_thompson_aerosols". +! Laura D. Fowler (laura@ucar.edu) / 2018-02-23. +! * changed the definition of DM_BCAST_MACRO to compile table_ccnAct with the default DOUBLE PRECISION. +! Laura D. Fowler (laura@ucar.edu) / 2018-03-07. contains @@ -80,8 +92,225 @@ subroutine init_thompson_clouddroplets_forMPAS(mesh,sfc_input,diag_physics) end subroutine init_thompson_clouddroplets_forMPAS !================================================================================================================= - end module mpas_atmphys_init_microphysics + subroutine init_thompson_aerosols_forMPAS(do_restart,dminfo,mesh,state,time_lev,diag_physics) +!================================================================================================================= + +!input variables: + type(dm_info),intent(in):: dminfo + type(mpas_pool_type),intent(in):: mesh + logical,intent(in):: do_restart + integer,intent(in):: time_lev + +!inout variables: + type(mpas_pool_type),intent(inout):: diag_physics + type(mpas_pool_type),intent(inout):: state + +!local variables and pointers: + integer,pointer:: nCellsSolve,nVertLevels + integer,pointer:: index_nifa,index_nwfa + + real(kind=RKIND),dimension(:),pointer :: areaCell + real(kind=RKIND),dimension(:),pointer :: nifa2d,nwfa2d + real(kind=RKIND),dimension(:,:),pointer :: zgrid,zz + real(kind=RKIND),dimension(:,:),pointer :: rho_zz,nifa,nwfa + real(kind=RKIND),dimension(:,:,:),pointer:: scalars + + character(len=StrKIND):: mess + + integer:: iCell, k + + real(kind=RKIND):: max_test + real(kind=RKIND):: airmass + real(kind=RKIND):: h_01 + real(kind=RKIND):: niIN3,niCCN3 + real(kind=RKIND):: nifa_max,nifa_min,global_nifa_max,global_nifa_min + real(kind=RKIND):: nwfa_max,nwfa_min,global_nwfa_max,global_nwfa_min + real(kind=RKIND),dimension(:,:),allocatable:: hgt + +!----------------------------------------------------------------------------------------------------------------- +!call mpas_log_write('--- enter subroutine init_thompson_aerosols_forMPAS:') + + is_aerosol_aware = .true. + +!... read a static file containing CCN activation of aerosols. The data were created from a parcel model by +!... Feingold & Heymsfield with further changes by Eidhammer and Kriedenweis. + call table_ccnAct(dminfo) + call mpas_log_write('--- end read table_ccnAct:') + +!... if do_restart is true, then we do not need to check the initialization of nwfa, nifa, and nwfa2d. If false, +! then, we proceed with the initialization: + if(do_restart) return + + call mpas_pool_get_dimension(mesh,'nCellsSolve',nCellsSolve) + call mpas_pool_get_dimension(mesh,'nVertLevels',nVertLevels) + + call mpas_pool_get_array(mesh,'areaCell',areaCell) + call mpas_pool_get_array(mesh,'zgrid' ,zgrid ) + call mpas_pool_get_array(mesh,'zz' ,zz ) + + call mpas_pool_get_array(diag_physics,'nifa2d',nifa2d) + call mpas_pool_get_array(diag_physics,'nwfa2d',nwfa2d) + + call mpas_pool_get_dimension(state,'index_nifa' ,index_nifa ) + call mpas_pool_get_dimension(state,'index_nwfa' ,index_nwfa ) + + call mpas_pool_get_array(state,'scalars',scalars,time_lev) + nifa => scalars(index_nifa,:,:) + nwfa => scalars(index_nwfa,:,:) + + call mpas_pool_get_array(state,'rho_zz',rho_zz,time_lev) + + if(.not.allocated(hgt)) allocate(hgt(1:nVertLevels,1:nCellsSolve)) + do iCell = 1, nCellsSolve + do k = 1, nVertLevels + hgt(k,iCell) = 0.5_RKIND * (zgrid(k,iCell)+zgrid(k+1,iCell)) + enddo + enddo + +!... initialize the distribution of hygroscopic ("water friendly") aerosols if not already initialized using +! GOCART data: + global_nwfa_min = 0._RKIND + global_nwfa_max = 0._RKIND + nwfa_min = minval(nwfa(:,1:nCellsSolve)) + nwfa_max = maxval(nwfa(:,1:nCellsSolve)) + call mpas_dmpar_min_real(dminfo,nwfa_min,global_nwfa_min) + call mpas_dmpar_max_real(dminfo,nwfa_max,global_nwfa_max) + call mpas_log_write('--- global_nwfa_min = $r',realArgs=(/global_nwfa_min/)) + call mpas_log_write('--- global_nwfa_max = $r',realArgs=(/global_nwfa_max/)) + + if(global_nwfa_min == 0._RKIND .and. global_nwfa_max == 0._RKIND) then + call mpas_log_write('--- initialize nwfa using an exponential distribution of CCN as a function of height.') + do iCell = 1, nCellsSolve + if(hgt(1,iCell).le.1000.0) then + h_01 = 0.8 + elseif(hgt(1,iCell).ge.2500.0) then + h_01 = 0.01 + else + h_01 = 0.8*cos(hgt(1,iCell)*0.001 - 1.0) + endif + niCCN3 = -1.0*ALOG(naCCN1/naCCN0)/h_01 + nwfa(1,iCell) = naCCN1+naCCN0*exp(-((hgt(2,iCell)-hgt(1,iCell))/1000.)*niCCN3) + do k = 2, nVertLevels + nwfa(k,iCell) = naCCN1+naCCN0*exp(-((hgt(k,iCell)-hgt(1,iCell))/1000.)*niCCN3) + enddo + enddo + else + call mpas_log_write('--- initialize nwfa using the climatological GOCART data.') + endif + +!... initialize the distribution of nonhygroscopic ("ice friendly") aerosols if not already initialized using +! GOCART data: + global_nifa_min = 0._RKIND + global_nifa_max = 0._RKIND + nifa_min = minval(nifa(:,1:nCellsSolve)) + nifa_max = maxval(nifa(:,1:nCellsSolve)) + call mpas_dmpar_min_real(dminfo,nifa_min,global_nifa_min) + call mpas_dmpar_max_real(dminfo,nifa_max,global_nifa_max) + call mpas_log_write('--- global_nifa_min = $r',realArgs=(/global_nifa_min/)) + call mpas_log_write('--- global_nifa_max = $r',realArgs=(/global_nifa_max/)) + + if(global_nifa_min == 0._RKIND .and. global_nifa_max == 0._RKIND) then + call mpas_log_write('--- initialize nifa using an exponential distribution of IN as a function of height.') + do iCell = 1, nCellsSolve + if(hgt(1,iCell).le.1000.0) then + h_01 = 0.8 + elseif(hgt(1,iCell).ge.2500.0) then + h_01 = 0.01 + else + h_01 = 0.8*cos(hgt(1,iCell)*0.001 - 1.0) + endif + niIN3 = -1.0*ALOG(naIN1/naIN0)/h_01 + nifa(1,iCell) = naIN1+naIN0*exp(-((hgt(2,iCell)-hgt(1,iCell))/1000.)*niIN3) + do k = 2, nVertLevels + nifa(k,iCell) = naIN1+naIN0*exp(-((hgt(k,iCell)-hgt(1,iCell))/1000.)*niIN3) + enddo + enddo + else + call mpas_log_write('--- initialize nifa using the climatological GOCART data.') + endif + +!... scale the lowest level aerosol data into an emissions rate. This is very far from ideal, but +!... need higher emissions where larger amount of (climo) existing and lesser emissions where there +!... exists fewer to begin as a first-order simplistic approach. Later, proper connection to emission +!... inventory would be better, but, for now, scale like this: +!... where: Nwfa=50 per cc, emit 0.875E4 aerosols per second per grid box unit +!... that was tested as ~(20kmx20kmx50m = 2.E10 m**3). + + k = 1 + do iCell = 1, nCellsSolve + airmass = rho_zz(k,iCell)*zz(k,iCell) + airmass = airmass*(zgrid(k+1,iCell)-zgrid(k,iCell))*areaCell(iCell) ! (in kg) + nwfa2d(iCell) = nwfa(k,iCell)*0.000196*airmass*0.5e-10 + nifa2d(iCell) = 0._RKIND +! call mpas_log_write('$i $r $r $r',intArgs=(/iCell/),realArgs=(/airmass,nwfa2d(iCell),nifa2d(iCell)/)) + enddo + +!... deallocate local arrays: + if(allocated(hgt)) deallocate(hgt) + +!call mpas_log_write('--- end subroutine init_thompson_aerosols_forMPAS.') + + end subroutine init_thompson_aerosols_forMPAS + !================================================================================================================= + subroutine table_ccnAct(dminfo) +!================================================================================================================= + +!input variables: + type(dm_info),intent(in):: dminfo - - +!local variables: + logical:: opened + integer:: ccn_unit,i,istat + character(len=StrKIND):: errmess +!----------------------------------------------------------------------------------------------------------------- + + if(.not.allocated(tnccn_act)) allocate(tnccn_act(ntb_arc,ntb_arw,ntb_art,ntb_arr,ntb_ark)) + +!get a unit to open binary file: + istat = -999 + if(dminfo % my_proc_id == IO_NODE) then + do i = 10,99 + inquire(i,opened = opened,iostat=istat) + if(.not. opened ) then + ccn_unit = i + exit + endif + enddo + if(istat /= 0) & + call physics_error_fatal('mpas_atmphys_init_microphysics table_ccnAct: Can not '// & + 'find unused fortran unit to read in lookup table.' ) + endif + +!distribute unit to other processors: + call mpas_dmpar_bcast_int(dminfo,ccn_unit) + +!open binary file: + istat = -999 + if(dminfo % my_proc_id == IO_NODE) then + open(ccn_unit,file='CCN_ACTIVATE_DATA',form='UNFORMATTED',status='OLD',iostat=istat) + if(istat /= 0) then + write(errmess,'(A,I4)') 'mpas_atmphys_init_microphysics table_ccnAct:: '// & + 'error opening CCN_ACTIVATE_DATA on unit', ccn_unit + call physics_error_fatal(errmess) + endif + endif + +!read and broadcast data to all nodes: + istat = -999 + if(dminfo % my_proc_id == IO_NODE) then + read(ccn_unit,iostat=istat) tnccn_act + if(istat /= 0) then + write(errmess,'(A,I4)') 'mpas_atmphys_init_microphysics table_ccnAct:: '// & + 'error reading tnccn_act on unit', ccn_unit + call physics_error_fatal(errmess) + endif + endif + + DM_BCAST_MACRO(tnccn_act) + + end subroutine table_ccnAct + +!================================================================================================================= + end module mpas_atmphys_init_microphysics +!================================================================================================================= diff --git a/src/core_atmosphere/physics/mpas_atmphys_interface.F b/src/core_atmosphere/physics/mpas_atmphys_interface.F index 289b600bf..f6d491f87 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_interface.F +++ b/src/core_atmosphere/physics/mpas_atmphys_interface.F @@ -77,11 +77,13 @@ subroutine allocate_forall_physics(configs) type(mpas_pool_type),intent(in):: configs !local pointers: - character(len=StrKIND),pointer:: pbl_scheme,convection_scheme - +!-srf + character(len=StrKIND),pointer:: microp_scheme,pbl_scheme,convection_scheme +!-srf !----------------------------------------------------------------------------------------------------------------- - call mpas_pool_get_config(configs,'config_pbl_scheme',pbl_scheme) + call mpas_pool_get_config(configs,'config_microp_scheme',microp_scheme) + call mpas_pool_get_config(configs,'config_pbl_scheme' ,pbl_scheme ) if(.not.allocated(psfc_p) ) allocate(psfc_p(ims:ime,jms:jme) ) if(.not.allocated(ptop_p) ) allocate(ptop_p(ims:ime,jms:jme) ) @@ -114,23 +116,33 @@ subroutine allocate_forall_physics(configs) if(.not.allocated(qs_p) ) allocate(qs_p(ims:ime,kms:kme,jms:jme) ) if(.not.allocated(qg_p) ) allocate(qg_p(ims:ime,kms:kme,jms:jme) ) - pbl_select: select case (trim(pbl_scheme)) + microp_select: select case(trim(microp_scheme)) + case("mp_thompson_aerosols") + if(.not.allocated(nifa_p)) allocate(nifa_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(nwfa_p)) allocate(nwfa_p(ims:ime,kms:kme,jms:jme)) + + case default + end select microp_select + + pbl_select: select case(trim(pbl_scheme)) case("bl_mynn") + if(.not.allocated(nc_p)) allocate(nc_p(ims:ime,kms:kme,jms:jme)) if(.not.allocated(ni_p)) allocate(ni_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(nifa_p)) allocate(nifa_p(ims:ime,kms:kme,jms:jme)) + if(.not.allocated(nwfa_p)) allocate(nwfa_p(ims:ime,kms:kme,jms:jme)) case default - end select pbl_select - +!-srf call mpas_pool_get_config(configs,'config_convection_scheme',convection_scheme) convection_select: select case(trim(convection_scheme)) case("cu_gf_monan") if(.not.allocated(cnvcf_p)) allocate(cnvcf_p(ims:ime,kms:kme,jms:jme)) if(.not.allocated(buoyx_p)) allocate(buoyx_p(ims:ime,kms:kme,jms:jme)) case default +!-srf end select convection_select - !... arrays used for calculating the hydrostatic pressure and exner function: if(.not.allocated(psfc_hyd_p) ) allocate(psfc_hyd_p(ims:ime,jms:jme) ) if(.not.allocated(psfc_hydd_p) ) allocate(psfc_hydd_p(ims:ime,jms:jme) ) @@ -150,11 +162,13 @@ subroutine deallocate_forall_physics(configs) type(mpas_pool_type),intent(in):: configs !local pointers: - character(len=StrKIND),pointer:: pbl_scheme,convection_scheme - +!-srf + character(len=StrKIND),pointer:: microp_scheme,pbl_scheme,convection_scheme +!-srf !----------------------------------------------------------------------------------------------------------------- - call mpas_pool_get_config(configs,'config_pbl_scheme',pbl_scheme) + call mpas_pool_get_config(configs,'config_microp_scheme',microp_scheme) + call mpas_pool_get_config(configs,'config_pbl_scheme' ,pbl_scheme ) if(allocated(psfc_p) ) deallocate(psfc_p ) if(allocated(ptop_p) ) deallocate(ptop_p ) @@ -187,14 +201,25 @@ subroutine deallocate_forall_physics(configs) if(allocated(qs_p) ) deallocate(qs_p ) if(allocated(qg_p) ) deallocate(qg_p ) - pbl_select: select case (trim(pbl_scheme)) + microp_select: select case(trim(microp_scheme)) + case("mp_thompson_aerosols") + if(allocated(nifa_p)) deallocate(nifa_p) + if(allocated(nwfa_p)) deallocate(nwfa_p) + + case default + end select microp_select + + pbl_select: select case(trim(pbl_scheme)) case("bl_mynn") + if(allocated(nc_p)) deallocate(nc_p) if(allocated(ni_p)) deallocate(ni_p) + if(allocated(nifa_p)) deallocate(nifa_p) + if(allocated(nwfa_p)) deallocate(nwfa_p) case default - end select pbl_select - + +!-srf call mpas_pool_get_config(configs,'config_convection_scheme',convection_scheme) convection_select: select case(trim(convection_scheme)) case("cu_gf_monan") @@ -203,6 +228,7 @@ subroutine deallocate_forall_physics(configs) case default end select convection_select +!-srf if(allocated(psfc_hyd_p) ) deallocate(psfc_hyd_p ) if(allocated(psfc_hydd_p) ) deallocate(psfc_hydd_p ) @@ -231,13 +257,16 @@ subroutine MPAS_to_physics(configs,mesh,state,time_lev,diag,diag_physics,its,ite type(mpas_pool_type),intent(inout):: diag_physics !local pointers: - character(len=StrKIND),pointer:: pbl_scheme,convection_scheme +!-srf + character(len=StrKIND),pointer:: microp_scheme,pbl_scheme,convection_scheme +!-srf integer,pointer:: index_qv,index_qc,index_qr,index_qi,index_qs,index_qg - integer,pointer:: index_ni + integer,pointer:: index_nc,index_ni,index_nifa,index_nwfa +!-srf integer,pointer:: index_cnvcf, index_buoyx integer,pointer:: config_gf_cporg, config_gf_pcvol - +!-srf real(kind=RKIND),dimension(:),pointer :: latCell,lonCell real(kind=RKIND),dimension(:),pointer :: fzm,fzp,rdzw @@ -246,9 +275,11 @@ subroutine MPAS_to_physics(configs,mesh,state,time_lev,diag,diag_physics,its,ite real(kind=RKIND),dimension(:,:),pointer :: zz,exner,pressure_b,rtheta_p,rtheta_b real(kind=RKIND),dimension(:,:),pointer :: rho_zz,theta_m,pressure_p,u,v,w real(kind=RKIND),dimension(:,:),pointer :: qv,qc,qr,qi,qs,qg - real(kind=RKIND),dimension(:,:),pointer :: ni + real(kind=RKIND),dimension(:,:),pointer :: nc,ni,nifa,nwfa real(kind=RKIND),dimension(:,:,:),pointer:: scalars +!-srf real(kind=RKIND),dimension(:,:),pointer :: cnvcf,buoyx +!-srf !local variables: integer:: i,k,j @@ -268,7 +299,8 @@ subroutine MPAS_to_physics(configs,mesh,state,time_lev,diag,diag_physics,its,ite !call mpas_log_write('kts=$i kte=$i',intArgs=(/kts,kte/)) !initialization: - call mpas_pool_get_config(configs,'config_pbl_scheme',pbl_scheme) + call mpas_pool_get_config(configs,'config_microp_scheme',microp_scheme) + call mpas_pool_get_config(configs,'config_pbl_scheme' ,pbl_scheme ) call mpas_pool_get_array(mesh,'latCell',latCell) call mpas_pool_get_array(mesh,'lonCell',lonCell) @@ -340,23 +372,77 @@ subroutine MPAS_to_physics(configs,mesh,state,time_lev,diag,diag_physics,its,ite enddo enddo - pbl_select: select case (trim(pbl_scheme)) - case("bl_mynn") - call mpas_pool_get_dimension(state,'index_ni',index_ni) - ni => scalars(index_ni,:,:) - + microp_select: select case(trim(microp_scheme)) + case("mp_thompson_aerosols") + nullify(nifa) + nullify(nwfa) + call mpas_pool_get_dimension(state,'index_nifa',index_nifa) + call mpas_pool_get_dimension(state,'index_nwfa',index_nwfa) + nifa => scalars(index_nifa,:,:) + nwfa => scalars(index_nwfa,:,:) do j = jts,jte - do k = kts,kte - do i = its,ite - ni_p(i,k,j) = max(0.,ni(k,i)) - enddo - enddo + do k = kts,kte + do i = its,ite + nifa_p(i,k,j) = max(0.,nifa(k,i)) + nwfa_p(i,k,j) = max(0.,nwfa(k,i)) + enddo + enddo enddo case default + end select microp_select + pbl_select: select case(trim(pbl_scheme)) + case("bl_mynn") + do j = jts,jte + do k = kts,kte + do i = its,ite + nc_p(i,k,j) = 0._RKIND + ni_p(i,k,j) = 0._RKIND + nifa_p(i,k,j) = 0._RKIND + nwfa_p(i,k,j) = 0._RKIND + enddo + enddo + enddo + !initializes ni_p when running the options "mp_thompson" or "mp_thompson_aerosols": + if(f_ni) then + nullify(ni) + call mpas_pool_get_dimension(state,'index_ni',index_ni) + ni => scalars(index_ni,:,:) + do j = jts,jte + do k = kts,kte + do i = its,ite + ni_p(i,k,j) = max(0.,ni(k,i)) + enddo + enddo + enddo + endif + !initializes nc_p, nifa_p, and nwfa_p when running the option "mp_thompson_aerosols": + if(f_nc .and. f_nifa .and. f_nwfa) then + nullify(nc) + nullify(nifa) + nullify(nwfa) + call mpas_pool_get_dimension(state,'index_nc',index_nc) + call mpas_pool_get_dimension(state,'index_nifa',index_nifa) + call mpas_pool_get_dimension(state,'index_nwfa',index_nwfa) + nc => scalars(index_nc,:,:) + nifa => scalars(index_nifa,:,:) + nwfa => scalars(index_nwfa,:,:) + do j = jts,jte + do k = kts,kte + do i = its,ite + nc_p(i,k,j) = max(0.,nc(k,i)) + nifa_p(i,k,j) = max(0.,nifa(k,i)) + nwfa_p(i,k,j) = max(0.,nwfa(k,i)) + enddo + enddo + enddo + endif + + case default end select pbl_select - + +!-srf call mpas_pool_get_config(configs,'config_convection_scheme',convection_scheme) convection_select: select case(trim(convection_scheme)) case("cu_gf_monan") @@ -386,6 +472,7 @@ subroutine MPAS_to_physics(configs,mesh,state,time_lev,diag,diag_physics,its,ite endif case default end select convection_select +!-srf !calculation of the surface pressure using hydrostatic assumption down to the surface:: do j = jts,jte @@ -522,7 +609,7 @@ subroutine MPAS_to_physics(configs,mesh,state,time_lev,diag,diag_physics,its,ite end subroutine MPAS_to_physics !================================================================================================================= - subroutine microphysics_from_MPAS(configs,mesh,state,time_lev,diag,diag_physics,its,ite) + subroutine microphysics_from_MPAS(configs,mesh,state,time_lev,diag,diag_physics,tend_physics,its,ite) !================================================================================================================= !input variables: @@ -535,18 +622,23 @@ subroutine microphysics_from_MPAS(configs,mesh,state,time_lev,diag,diag_physics, integer,intent(in):: its,ite integer:: time_lev +!inout variables: + type(mpas_pool_type),intent(inout):: tend_physics + !local pointers: - character(len=StrKIND),pointer:: microp_scheme + character(len=StrKIND),pointer:: mp_scheme integer,pointer:: index_qv,index_qc,index_qr,index_qi,index_qs,index_qg - integer,pointer:: index_ni,index_nr - real(kind=RKIND),dimension(:),pointer :: nt_c,mu_c + integer,pointer:: index_nc,index_ni,index_nr,index_nifa,index_nwfa + real(kind=RKIND),dimension(:),pointer :: nifa2d,nwfa2d,nt_c,mu_c real(kind=RKIND),dimension(:,:),pointer :: zgrid,w real(kind=RKIND),dimension(:,:),pointer :: zz,exner,pressure_b real(kind=RKIND),dimension(:,:),pointer :: rho_zz,theta_m,pressure_p real(kind=RKIND),dimension(:,:),pointer :: qv,qc,qr,qi,qs,qg - real(kind=RKIND),dimension(:,:),pointer :: ni,nr + real(kind=RKIND),dimension(:,:),pointer :: nc,ni,nr,nifa,nwfa real(kind=RKIND),dimension(:,:),pointer :: rainprod,evapprod real(kind=RKIND),dimension(:,:),pointer :: re_cloud,re_ice,re_snow + real(kind=RKIND),dimension(:,:),pointer :: rthmpten,rqvmpten,rqcmpten,rqrmpten,rqimpten,rqsmpten,rqgmpten + real(kind=RKIND),dimension(:,:),pointer :: rncmpten,rnimpten,rnrmpten,rnifampten,rnwfampten real(kind=RKIND),dimension(:,:,:),pointer:: scalars !local variables: @@ -554,7 +646,7 @@ subroutine microphysics_from_MPAS(configs,mesh,state,time_lev,diag,diag_physics, !----------------------------------------------------------------------------------------------------------------- - call mpas_pool_get_config(configs,'config_microp_scheme',microp_scheme) + call mpas_pool_get_config(configs,'config_microp_scheme',mp_scheme) call mpas_pool_get_array(mesh,'zgrid',zgrid) call mpas_pool_get_array(mesh,'zz' ,zz ) @@ -563,31 +655,33 @@ subroutine microphysics_from_MPAS(configs,mesh,state,time_lev,diag,diag_physics, call mpas_pool_get_array(diag,'pressure_base',pressure_b) call mpas_pool_get_array(diag,'pressure_p' ,pressure_p) - call mpas_pool_get_array(diag_physics,'nt_c' ,nt_c ) - call mpas_pool_get_array(diag_physics,'mu_c' ,mu_c ) - call mpas_pool_get_array(diag_physics,'rainprod',rainprod) - call mpas_pool_get_array(diag_physics,'evapprod',evapprod) - call mpas_pool_get_array(diag_physics,'re_cloud',re_cloud) - call mpas_pool_get_array(diag_physics,'re_ice' ,re_ice ) - call mpas_pool_get_array(diag_physics,'re_snow' ,re_snow ) - call mpas_pool_get_array(state,'rho_zz' ,rho_zz ,time_lev) call mpas_pool_get_array(state,'theta_m',theta_m,time_lev) call mpas_pool_get_array(state,'w' ,w ,time_lev) - 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_ni' ,index_ni ) - call mpas_pool_get_dimension(state,'index_nr' ,index_nr ) + 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_array(state,'scalars',scalars,time_lev) - qv => scalars(index_qv,:,:) - qc => scalars(index_qc,:,:) - qr => scalars(index_qr,:,:) + qv => scalars(index_qv,:,:) + qc => scalars(index_qc,:,:) + qr => scalars(index_qr,:,:) !initialize variables needed in the cloud microphysics schemes: do j = jts, jte @@ -610,13 +704,21 @@ subroutine microphysics_from_MPAS(configs,mesh,state,time_lev,diag,diag_physics, enddo enddo -!additional initialization as function of cloud microphysics scheme: - microp_select_init: select case(microp_scheme) - - case ("mp_thompson","mp_wsm6") - qi => scalars(index_qi,:,:) - qs => scalars(index_qs,:,:) - qg => scalars(index_qg,:,:) +!initialize cloud water species and aerosols as function of cloud microphysics scheme: + mp_select: select case(trim(mp_scheme)) + case("mp_thompson","mp_thompson_aerosols","mp_wsm6") + 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) + qi => scalars(index_qi,:,:) + qs => scalars(index_qs,:,:) + qg => scalars(index_qg,:,:) + + call mpas_pool_get_array(diag_physics,'rainprod',rainprod) + call mpas_pool_get_array(diag_physics,'evapprod',evapprod) + call mpas_pool_get_array(diag_physics,'re_cloud',re_cloud) + call mpas_pool_get_array(diag_physics,'re_ice' ,re_ice ) + call mpas_pool_get_array(diag_physics,'re_snow' ,re_snow ) do j = jts, jte do k = kts, kte @@ -624,77 +726,168 @@ 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) + + rainprod_p(i,k,j) = rainprod(k,i) + evapprod_p(i,k,j) = evapprod(k,k) + 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 - microp2_select: select case(microp_scheme) - - case("mp_thompson") - ni => scalars(index_ni,:,:) - nr => scalars(index_nr,:,:) + mp2_select: select case(trim(mp_scheme)) + case("mp_thompson","mp_thompson_aerosols") + call mpas_pool_get_dimension(state,'index_ni',index_ni) + call mpas_pool_get_dimension(state,'index_nr',index_nr) + ni => scalars(index_ni,:,:) + nr => scalars(index_nr,:,:) + + call mpas_pool_get_array(diag_physics,'nt_c',nt_c) + call mpas_pool_get_array(diag_physics,'mu_c',mu_c) + do j = jts,jte + do i = its,ite + muc_p(i,j) = mu_c(i) + ntc_p(i,j) = nt_c(i) + enddo + do k = kts, kte + do i = its, ite + ni_p(i,k,j) = ni(k,i) + nr_p(i,k,j) = nr(k,i) + enddo + enddo + enddo + + mp3_select: select case(trim(mp_scheme)) + case("mp_thompson_aerosols") + call mpas_pool_get_dimension(state,'index_nc' ,index_nc ) + call mpas_pool_get_dimension(state,'index_nifa',index_nifa) + call mpas_pool_get_dimension(state,'index_nwfa',index_nwfa) + nc => scalars(index_nc,:,:) + nifa => scalars(index_nifa,:,:) + nwfa => scalars(index_nwfa,:,:) + + call mpas_pool_get_array(diag_physics,'nifa2d',nifa2d) + call mpas_pool_get_array(diag_physics,'nwfa2d',nwfa2d) + do j = jts,jte + do i = its,ite + nifa2d_p(i,j) = nifa2d(i) + nwfa2d_p(i,j) = nwfa2d(i) + enddo + do k = kts, kte + do i = its, ite + nc_p(i,k,j) = nc(k,i) + nifa_p(i,k,j) = nifa(k,i) + nwfa_p(i,k,j) = nwfa(k,i) + enddo + enddo + enddo + + case default + end select mp3_select + + case default + end select mp2_select - do j = jts,jte - do i = its,ite - muc_p(i,j) = mu_c(i) - ntc_p(i,j) = nt_c(i) - enddo - enddo - do j = jts, jte - do k = kts, kte - do i = its, ite - ni_p(i,k,j) = ni(k,i) - nr_p(i,k,j) = nr(k,i) - rainprod_p(i,k,j) = rainprod(k,i) - evapprod_p(i,k,j) = evapprod(k,i) - enddo - enddo - enddo + case default + end select mp_select + +!begin calculation of cloud microphysics tendencies: + mp_tend_select: select case(trim(mp_scheme)) + case("mp_thompson","mp_thompson_aerosols","mp_wsm6") + call mpas_pool_get_array(tend_physics,'rthmpten',rthmpten) + call mpas_pool_get_array(tend_physics,'rqvmpten',rqvmpten) + call mpas_pool_get_array(tend_physics,'rqcmpten',rqcmpten) + call mpas_pool_get_array(tend_physics,'rqrmpten',rqrmpten) + call mpas_pool_get_array(tend_physics,'rqimpten',rqimpten) + call mpas_pool_get_array(tend_physics,'rqsmpten',rqsmpten) + call mpas_pool_get_array(tend_physics,'rqgmpten',rqgmpten) - case default + do k = kts,kte + do i = its,ite + rthmpten(k,i) = theta_m(k,i)/(1._RKIND+R_v/R_d*max(0._RKIND,qv(k,i))) + rqvmpten(k,i) = qv(k,i) + rqcmpten(k,i) = qc(k,i) + rqrmpten(k,i) = qr(k,i) + rqimpten(k,i) = qi(k,i) + rqsmpten(k,i) = qs(k,i) + rqgmpten(k,i) = qg(k,i) + enddo + enddo - end select microp2_select + mp2_tend_select: select case(trim(mp_scheme)) + case("mp_thompson","mp_thompson_aerosols") + call mpas_pool_get_array(tend_physics,'rnimpten',rnimpten) + call mpas_pool_get_array(tend_physics,'rnrmpten',rnrmpten) + + do k = kts,kte + do i = its,ite + rnimpten(k,i) = ni(k,i) + rnrmpten(k,i) = nr(k,i) + enddo + enddo + + mp3_tend_select: select case(trim(mp_scheme)) + case("mp_thompson_aerosols") + call mpas_pool_get_array(tend_physics,'rncmpten',rncmpten) + call mpas_pool_get_array(tend_physics,'rnifampten',rnifampten) + call mpas_pool_get_array(tend_physics,'rnwfampten',rnwfampten) + + do k = kts,kte + do i = its,ite + rncmpten(k,i) = nc(k,i) + rnifampten(k,i) = nifa(k,i) + rnwfampten(k,i) = nwfa(k,i) + enddo + enddo + + case default + end select mp3_tend_select + + case default + end select mp2_tend_select case default - - end select microp_select_init + end select mp_tend_select end subroutine microphysics_from_MPAS !================================================================================================================= - subroutine microphysics_to_MPAS(configs,mesh,state,time_lev,diag,diag_physics,tend,itimestep,its,ite) + subroutine microphysics_to_MPAS(configs,mesh,state,time_lev,diag,diag_physics,tend_physics,tend,its,ite) !================================================================================================================= !input variables: type(mpas_pool_type),intent(in):: configs type(mpas_pool_type),intent(in):: mesh - integer,intent(in):: itimestep,time_lev + integer,intent(in):: time_lev integer,intent(in):: its,ite -!output variables: +!inout variables: type(mpas_pool_type),intent(inout):: state type(mpas_pool_type),intent(inout):: diag type(mpas_pool_type),intent(inout):: tend type(mpas_pool_type),intent(inout):: diag_physics + type(mpas_pool_type),intent(inout):: tend_physics + !local pointers: - character(len=StrKIND),pointer:: microp_scheme + character(len=StrKIND),pointer:: mp_scheme integer,pointer:: index_qv,index_qc,index_qr,index_qi,index_qs,index_qg - integer,pointer:: index_ni,index_nr + integer,pointer:: index_nc,index_ni,index_nr,index_nifa,index_nwfa real(kind=RKIND),dimension(:),pointer :: surface_pressure,tend_sfc_pressure + real(kind=RKIND),dimension(:),pointer :: nifa2d,nwfa2d real(kind=RKIND),dimension(:,:),pointer :: zgrid real(kind=RKIND),dimension(:,:),pointer :: zz,exner,exner_b,pressure_b,rtheta_p,rtheta_b real(kind=RKIND),dimension(:,:),pointer :: rho_zz,theta_m,pressure_p real(kind=RKIND),dimension(:,:),pointer :: rt_diabatic_tend real(kind=RKIND),dimension(:,:),pointer :: dtheta_dt_mp real(kind=RKIND),dimension(:,:),pointer :: qv,qc,qr,qi,qs,qg - real(kind=RKIND),dimension(:,:),pointer :: ni,nr - real(kind=RKIND),dimension(:,:),pointer :: rainprod,evapprod + real(kind=RKIND),dimension(:,:),pointer :: nc,ni,nr,nifa,nwfa + real(kind=RKIND),dimension(:,:),pointer :: rainprod,evapprod,refl10cm real(kind=RKIND),dimension(:,:),pointer :: re_cloud,re_ice,re_snow + real(kind=RKIND),dimension(:,:),pointer :: rthmpten,rqvmpten,rqcmpten,rqrmpten,rqimpten,rqsmpten,rqgmpten + real(kind=RKIND),dimension(:,:),pointer :: rncmpten,rnimpten,rnrmpten,rnifampten,rnwfampten real(kind=RKIND),dimension(:,:,:),pointer:: scalars !local variables: @@ -704,7 +897,7 @@ subroutine microphysics_to_MPAS(configs,mesh,state,time_lev,diag,diag_physics,te !----------------------------------------------------------------------------------------------------------------- - call mpas_pool_get_config(configs,'config_microp_scheme',microp_scheme) + call mpas_pool_get_config(configs,'config_microp_scheme',mp_scheme) call mpas_pool_get_array(mesh,'zz' ,zz ) call mpas_pool_get_array(mesh,'zgrid',zgrid) @@ -718,12 +911,6 @@ subroutine microphysics_to_MPAS(configs,mesh,state,time_lev,diag,diag_physics,te call mpas_pool_get_array(diag,'surface_pressure',surface_pressure) call mpas_pool_get_array(diag,'dtheta_dt_mp' ,dtheta_dt_mp ) - call mpas_pool_get_array(diag_physics,'rainprod',rainprod) - call mpas_pool_get_array(diag_physics,'evapprod',evapprod) - call mpas_pool_get_array(diag_physics,'re_cloud',re_cloud) - call mpas_pool_get_array(diag_physics,'re_ice' ,re_ice ) - call mpas_pool_get_array(diag_physics,'re_snow' ,re_snow ) - call mpas_pool_get_array(tend,'tend_sfc_pressure',tend_sfc_pressure) call mpas_pool_get_array(state,'rho_zz' ,rho_zz ,time_lev) @@ -732,12 +919,6 @@ subroutine microphysics_to_MPAS(configs,mesh,state,time_lev,diag,diag_physics,te 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_ni' ,index_ni ) - call mpas_pool_get_dimension(state,'index_nr' ,index_nr ) - call mpas_pool_get_array(state,'scalars',scalars,time_lev) qv => scalars(index_qv,:,:) qc => scalars(index_qc,:,:) @@ -779,7 +960,7 @@ subroutine microphysics_to_MPAS(configs,mesh,state,time_lev,diag,diag_physics,te enddo enddo -!updates the surface pressure and calculates the surface pressure tendency: +!update surface pressure and calculates the surface pressure tendency: do j = jts,jte do i = its,ite tem1 = zgrid(2,i)-zgrid(1,i) @@ -797,20 +978,32 @@ subroutine microphysics_to_MPAS(configs,mesh,state,time_lev,diag,diag_physics,te enddo enddo -!variables specific to different cloud microphysics schemes: - microp_select_init: select case(microp_scheme) +!update cloud water species and aerosols as functions of cloud microphysics schemes: + mp_select: select case(trim(mp_scheme)) + case("mp_thompson","mp_thompson_aerosols","mp_wsm6") + 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) + qi => scalars(index_qi,:,:) + qs => scalars(index_qs,:,:) + qg => scalars(index_qg,:,:) + + call mpas_pool_get_array(diag_physics,'rainprod',rainprod) + call mpas_pool_get_array(diag_physics,'evapprod',evapprod) + call mpas_pool_get_array(diag_physics,'re_cloud',re_cloud) + call mpas_pool_get_array(diag_physics,'re_ice' ,re_ice ) + call mpas_pool_get_array(diag_physics,'re_snow' ,re_snow ) + call mpas_pool_get_array(diag_physics,'refl10cm',refl10cm) - case ("mp_thompson","mp_wsm6") - qi => scalars(index_qi,:,:) - qs => scalars(index_qs,:,:) - qg => scalars(index_qg,:,:) - - do j = jts, jte - do k = kts, kte - do i = its, ite + do j = jts,jte + do k = kts,kte + do i = its,ite qi(k,i) = qi_p(i,k,j) qs(k,i) = qs_p(i,k,j) qg(k,i) = qg_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) @@ -818,30 +1011,113 @@ subroutine microphysics_to_MPAS(configs,mesh,state,time_lev,diag,diag_physics,te enddo enddo - microp2_select: select case(microp_scheme) - - case("mp_thompson") - ni => scalars(index_ni,:,:) - nr => scalars(index_nr,:,:) + mp2_select: select case(trim(mp_scheme)) + case("mp_thompson","mp_thompson_aerosols") + call mpas_pool_get_dimension(state,'index_ni',index_ni) + call mpas_pool_get_dimension(state,'index_nr',index_nr) + ni => scalars(index_ni,:,:) + nr => scalars(index_nr,:,:) + + do j = jts,jte + do k = kts,kte + do i = its,ite + ni(k,i) = ni_p(i,k,j) + nr(k,i) = nr_p(i,k,j) + enddo + enddo + enddo + + mp3_select: select case(trim(mp_scheme)) + case("mp_thompson_aerosols") + call mpas_pool_get_dimension(state,'index_nc' ,index_nc ) + call mpas_pool_get_dimension(state,'index_nifa',index_nifa) + call mpas_pool_get_dimension(state,'index_nwfa',index_nwfa) + nc => scalars(index_nc,:,:) + nifa => scalars(index_nifa,:,:) + nwfa => scalars(index_nwfa,:,:) + + call mpas_pool_get_array(diag_physics,'nifa2d',nifa2d) + call mpas_pool_get_array(diag_physics,'nwfa2d',nwfa2d) + do j = jts,jte + do i = its,ite + nifa2d(i) = nifa2d_p(i,j) + nwfa2d(i) = nwfa2d_p(i,j) + enddo + do k = kts, kte + do i = its, ite + nc(k,i) = nc_p(i,k,j) + nifa(k,i) = nifa_p(i,k,j) + nwfa(k,i) = nwfa_p(i,k,j) + enddo + enddo + enddo + + case default + end select mp3_select + + case default + end select mp2_select - do j = jts, jte - do k = kts, kte - do i = its, ite - ni(k,i) = ni_p(i,k,j) - nr(k,i) = nr_p(i,k,j) - rainprod(k,i) = rainprod_p(i,k,j) - evapprod(k,i) = evapprod_p(i,k,j) - enddo - enddo - enddo + case default + end select mp_select + +!end calculation of cloud microphysics tendencies: + mp_tend_select: select case(trim(mp_scheme)) + case("mp_thompson","mp_thompson_aerosols","mp_wsm6") + call mpas_pool_get_array(tend_physics,'rthmpten',rthmpten) + call mpas_pool_get_array(tend_physics,'rqvmpten',rqvmpten) + call mpas_pool_get_array(tend_physics,'rqcmpten',rqcmpten) + call mpas_pool_get_array(tend_physics,'rqrmpten',rqrmpten) + call mpas_pool_get_array(tend_physics,'rqimpten',rqimpten) + call mpas_pool_get_array(tend_physics,'rqsmpten',rqsmpten) + call mpas_pool_get_array(tend_physics,'rqgmpten',rqgmpten) - case default + do k = kts,kte + do i = its,ite + rthmpten(k,i) = (theta_m(k,i)/(1._RKIND+R_v/R_d*max(0._RKIND,qv(k,i)))-rthmpten(k,i))/dt_dyn + rqvmpten(k,i) = (qv(k,i)-rqvmpten(k,i))/dt_dyn + rqcmpten(k,i) = (qc(k,i)-rqcmpten(k,i))/dt_dyn + rqrmpten(k,i) = (qr(k,i)-rqrmpten(k,i))/dt_dyn + rqimpten(k,i) = (qi(k,i)-rqimpten(k,i))/dt_dyn + rqsmpten(k,i) = (qs(k,i)-rqsmpten(k,i))/dt_dyn + rqgmpten(k,i) = (qg(k,i)-rqgmpten(k,i))/dt_dyn + enddo + enddo - end select microp2_select + mp2_tend_select: select case(trim(mp_scheme)) + case("mp_thompson","mp_thompson_aerosols") + call mpas_pool_get_array(tend_physics,'rnimpten',rnimpten) + call mpas_pool_get_array(tend_physics,'rnrmpten',rnrmpten) + + do k = kts,kte + do i = its,ite + rnimpten(k,i) = (ni(k,i)-rnimpten(k,i))/dt_dyn + rnrmpten(k,i) = (nr(k,i)-rnrmpten(k,i))/dt_dyn + enddo + enddo + + mp3_tend_select: select case(trim(mp_scheme)) + case("mp_thompson_aerosols") + call mpas_pool_get_array(tend_physics,'rncmpten',rncmpten) + call mpas_pool_get_array(tend_physics,'rnifampten',rnifampten) + call mpas_pool_get_array(tend_physics,'rnwfampten',rnwfampten) + + do k = kts,kte + do i = its,ite + rncmpten(k,i) = (nc(k,i)-rncmpten(k,i))/dt_dyn + rnifampten(k,i) = (nifa(k,i)-rnifampten(k,i))/dt_dyn + rnwfampten(k,i) = (nwfa(k,i)-rnwfampten(k,i))/dt_dyn + enddo + enddo + + case default + end select mp3_tend_select + + case default + end select mp2_tend_select case default - - end select microp_select_init + end select mp_tend_select end subroutine microphysics_to_MPAS diff --git a/src/core_atmosphere/physics/mpas_atmphys_lsm_noahinit.F b/src/core_atmosphere/physics/mpas_atmphys_lsm_noahinit.F index f5ea32f31..b4d7c38ab 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_lsm_noahinit.F +++ b/src/core_atmosphere/physics/mpas_atmphys_lsm_noahinit.F @@ -152,16 +152,6 @@ subroutine lsminit(dminfo,mesh,configs,diag_physics,sfc_input) !initializes soil liquid water content SH2O: do iCell = 1, nCells - - !---srf - !do ns = 1, nSoilLevels - ! if (smois(ns,iCell) < 0.99) then - ! smois(ns,iCell) = 0.7* smois(ns,iCell) - ! soil_moisture_adjustment = .true. - ! endif - !enddo - !---srf - bx = bb(isltyp(iCell)) smcmax = maxsmc(isltyp(iCell)) psisat = satpsi(isltyp(iCell)) diff --git a/src/core_atmosphere/physics/mpas_atmphys_lsm_noahmpfinalize.F b/src/core_atmosphere/physics/mpas_atmphys_lsm_noahmpfinalize.F new file mode 100644 index 000000000..5e6f999b4 --- /dev/null +++ b/src/core_atmosphere/physics/mpas_atmphys_lsm_noahmpfinalize.F @@ -0,0 +1,40 @@ +! Copyright (c) 2013, Los Alamos National Security, LLC (LANS) +! and the University Corporation for Atmospheric Research (UCAR). +! +! Unless noted otherwise source code is licensed under the BSD license. +! Additional copyright and license information can be found in the LICENSE file +! distributed with this code, or at http://mpas-dev.github.com/license.html +! +!================================================================================================================= + module mpas_atmphys_lsm_noahmpfinalize + use mpas_log,only: mpas_log_write + + use mpas_atmphys_vars,only: mpas_noahmp + use NoahmpIOVarFinalizeMod,only: NoahmpIOVarFinalizeDefault + + + private + public:: sf_noahmp_deallocate + + + contains + +!================================================================================================================= + subroutine sf_noahmp_deallocate( ) +!================================================================================================================= +!----------------------------------------------------------------------------------------------------------------- +!call mpas_log_write(' ') +!call mpas_log_write('--- enter subroutine sf_noahmp_deallocate:') + + +!--- deallocate Noahmp arrays: + call NoahmpIOVarFinalizeDefault(mpas_noahmp) + + +!call mpas_log_write('--- end subroutine sf_noahmp_deallocate:') + + end subroutine sf_noahmp_deallocate + +!================================================================================================================= + end module mpas_atmphys_lsm_noahmpfinalize +!================================================================================================================= diff --git a/src/core_atmosphere/physics/mpas_atmphys_lsm_noahmpinit.F b/src/core_atmosphere/physics/mpas_atmphys_lsm_noahmpinit.F new file mode 100644 index 000000000..19ad287d0 --- /dev/null +++ b/src/core_atmosphere/physics/mpas_atmphys_lsm_noahmpinit.F @@ -0,0 +1,547 @@ +! Copyright (c) 2013, Los Alamos National Security, LLC (LANS) +! and the University Corporation for Atmospheric Research (UCAR). +! +! Unless noted otherwise source code is licensed under the BSD license. +! Additional copyright and license information can be found in the LICENSE file +! distributed with this code, or at http://mpas-dev.github.com/license.html +! +!================================================================================================================= + module mpas_atmphys_lsm_noahmpinit + use mpas_log + use mpas_pool_routines + use mpas_timekeeping,only : mpas_get_timeInterval, mpas_get_clock_timestep + + use mpas_atmphys_constants,only: grav => gravity, t0 => svpt0 + use mpas_atmphys_utilities,only: physics_error_fatal + use mpas_atmphys_vars,only : mpas_noahmp + + use NoahmpInitMainMod,only : NoahmpInitMain + use NoahmpIOVarInitMod,only: NoahmpIOVarInitDefault + use NoahmpIOVarType + use NoahmpReadNamelistMod + use NoahmpReadTableMod,only: NoahmpReadTable + + + private + public:: init_lsm_noahmp + + + contains + + +!================================================================================================================= + subroutine init_lsm_noahmp(configs,mesh,clock,diag_physics,diag_physics_noahmp,output_noahmp,sfc_input) +!================================================================================================================= + +!--- input arguments: + type(mpas_pool_type),intent(in):: configs + type(mpas_pool_type),intent(in):: mesh + type(mpas_clock_type),intent(in):: clock + +!--- inout arguments: + type(mpas_pool_type),intent(inout):: diag_physics + type(mpas_pool_type),intent(inout):: diag_physics_noahmp + type(mpas_pool_type),intent(inout):: output_noahmp + type(mpas_pool_type),intent(inout):: sfc_input + +!--- local variables and arrays: + character(len=StrKIND),pointer:: mminlu + + integer:: ns + +!----------------------------------------------------------------------------------------------------------------- +!call mpas_log_write(' ') +!call mpas_log_write('--- enter subroutine init_lsm_noahmp:') + + +!--- initialize dimensions: + call noahmp_read_dimensions(mesh) + + +!--- initialize namelist options: + call noahmp_read_namelist(configs) + + +!--- allocate Noahmp arrays: +!call mpas_log_write(' ') +!call mpas_log_write('--- enter subroutine NoahmpIOVarInitDefault:') + call NoahmpIOVarInitDefault(mpas_noahmp) +!call mpas_log_write('--- end subroutine NoahmpIOVarInitDefault:') + + +!--- read NoahmpTable.TBL: + call mpas_pool_get_array(sfc_input,'mminlu',mminlu) + mpas_noahmp%llanduse = mminlu + +!call mpas_log_write(' ') +!call mpas_log_write('--- enter subroutine NoahmpReadTable:') + call NoahmpReadTable(mpas_noahmp) +!call mpas_log_write('--- isbarren_table = $i',intArgs=(/mpas_noahmp%isbarren_table/)) +!call mpas_log_write('--- isice_table = $i',intArgs=(/mpas_noahmp%isice_table/) ) +!call mpas_log_write('--- iswater_table = $i',intArgs=(/mpas_noahmp%iswater_table/) ) +!call mpas_log_write('--- isurban_table = $i',intArgs=(/mpas_noahmp%isurban_table/) ) +!call mpas_log_write('--- urbtype_beg = $i',intArgs=(/mpas_noahmp%urbtype_beg/) ) +!call mpas_log_write('--- slcats_table = $i',intArgs=(/mpas_noahmp%slcats_table/) ) +!call mpas_log_write(' ') +!do ns = 1,mpas_noahmp%slcats_table +! call mpas_log_write('--- BEXP,SMCMAX,PSISAT: $i $r $r $r',intArgs=(/ns/),realArgs= & +! (/mpas_noahmp%bexp_table(ns),mpas_noahmp%smcmax_table(ns),mpas_noahmp%psisat_table(ns)/)) +!enddo +!call mpas_log_write('--- end subroutine NoahmpReadTable:') + + +!--- initialize noahmp: + call noahmp_init(configs,mesh,clock,diag_physics,diag_physics_noahmp,output_noahmp,sfc_input) + + +!call mpas_log_write('--- end subroutine init_lsm_noahmp:') +!call mpas_log_write(' ') + + end subroutine init_lsm_noahmp + +!================================================================================================================= + subroutine noahmp_read_dimensions(mesh) +!================================================================================================================= + +!--- input arguments: + type(mpas_pool_type),intent(in):: mesh + +!--- local variables and pointers: + integer,pointer:: nCellsSolve,nVertLevels + integer,pointer:: nSoilLevels,nSnowLevels + +!----------------------------------------------------------------------------------------------------------------- +!call mpas_log_write('--- enter subroutine noahmp_read_dimensions:') + + + call mpas_pool_get_dimension(mesh,'nCellsSolve',nCellsSolve) + call mpas_pool_get_dimension(mesh,'nVertLevels',nVertLevels) + call mpas_pool_get_dimension(mesh,'nSoilLevels',nSoilLevels) + call mpas_pool_get_dimension(mesh,'nSnowLevels',nSnowLevels) + + mpas_noahmp%its = 1 + mpas_noahmp%ite = nCellsSolve + mpas_noahmp%kts = 1 + mpas_noahmp%kte = nVertLevels + + mpas_noahmp%nsoil = nSoilLevels + mpas_noahmp%nsnow = nSnowLevels + +!call mpas_log_write(' its = $i ite = $i', intArgs=(/mpas_noahmp%its,mpas_noahmp%ite/)) +!call mpas_log_write(' kts = $i kte = $i', intArgs=(/mpas_noahmp%kts,mpas_noahmp%kte/)) +!call mpas_log_write(' ') +!call mpas_log_write(' nSoilLevels = $i',intArgs=(/mpas_noahmp%nsoil/)) +!call mpas_log_write(' nSnowLevels = $i',intArgs=(/mpas_noahmp%nsnow/)) + + +!call mpas_log_write('--- end subroutine noahmp_read_dimensions:') + + end subroutine noahmp_read_dimensions + +!================================================================================================================= + subroutine noahmp_read_namelist(configs) +!================================================================================================================= + +!--- input arguments: + type(mpas_pool_type),intent(in):: configs + + +!--- local variables and pointers: + integer,pointer:: iopt_dveg , iopt_crs , iopt_btr , iopt_runsrf , iopt_runsub , iopt_sfc , iopt_frz , & + iopt_inf , iopt_rad , iopt_alb , iopt_snf , iopt_tksno , iopt_tbot , iopt_stc , & + iopt_gla , iopt_rsf , iopt_soil , iopt_pedo , iopt_crop , iopt_irr , iopt_irrm , & + iopt_infdv , iopt_tdrn + +!----------------------------------------------------------------------------------------------------------------- +!call mpas_log_write(' ') +!call mpas_log_write('--- enter subroutine noahmp_read_namelist:') + + call mpas_pool_get_config(configs,'config_noahmp_iopt_dveg' ,iopt_dveg ) + call mpas_pool_get_config(configs,'config_noahmp_iopt_crs' ,iopt_crs ) + call mpas_pool_get_config(configs,'config_noahmp_iopt_btr' ,iopt_btr ) + call mpas_pool_get_config(configs,'config_noahmp_iopt_runsrf',iopt_runsrf) + call mpas_pool_get_config(configs,'config_noahmp_iopt_runsub',iopt_runsub) + call mpas_pool_get_config(configs,'config_noahmp_iopt_sfc' ,iopt_sfc ) + call mpas_pool_get_config(configs,'config_noahmp_iopt_frz' ,iopt_frz ) + call mpas_pool_get_config(configs,'config_noahmp_iopt_inf' ,iopt_inf ) + call mpas_pool_get_config(configs,'config_noahmp_iopt_rad' ,iopt_rad ) + call mpas_pool_get_config(configs,'config_noahmp_iopt_alb' ,iopt_alb ) + call mpas_pool_get_config(configs,'config_noahmp_iopt_snf' ,iopt_snf ) + call mpas_pool_get_config(configs,'config_noahmp_iopt_tksno' ,iopt_tksno ) + call mpas_pool_get_config(configs,'config_noahmp_iopt_tbot' ,iopt_tbot ) + call mpas_pool_get_config(configs,'config_noahmp_iopt_stc' ,iopt_stc ) + call mpas_pool_get_config(configs,'config_noahmp_iopt_gla' ,iopt_gla ) + call mpas_pool_get_config(configs,'config_noahmp_iopt_rsf' ,iopt_rsf ) + call mpas_pool_get_config(configs,'config_noahmp_iopt_soil' ,iopt_soil ) + call mpas_pool_get_config(configs,'config_noahmp_iopt_pedo' ,iopt_pedo ) + call mpas_pool_get_config(configs,'config_noahmp_iopt_crop' ,iopt_crop ) + call mpas_pool_get_config(configs,'config_noahmp_iopt_irr' ,iopt_irr ) + call mpas_pool_get_config(configs,'config_noahmp_iopt_irrm' ,iopt_irrm ) + call mpas_pool_get_config(configs,'config_noahmp_iopt_infdv' ,iopt_infdv ) + call mpas_pool_get_config(configs,'config_noahmp_iopt_tdrn' ,iopt_tdrn ) + + mpas_noahmp%iopt_dveg = iopt_dveg + mpas_noahmp%iopt_crs = iopt_crs + mpas_noahmp%iopt_btr = iopt_btr + mpas_noahmp%iopt_runsrf = iopt_runsrf + mpas_noahmp%iopt_runsub = iopt_runsub + mpas_noahmp%iopt_sfc = iopt_sfc + mpas_noahmp%iopt_frz = iopt_frz + mpas_noahmp%iopt_inf = iopt_inf + mpas_noahmp%iopt_rad = iopt_rad + mpas_noahmp%iopt_alb = iopt_alb + mpas_noahmp%iopt_snf = iopt_snf + mpas_noahmp%iopt_tksno = iopt_tksno + mpas_noahmp%iopt_tbot = iopt_tbot + mpas_noahmp%iopt_stc = iopt_stc + mpas_noahmp%iopt_gla = iopt_gla + mpas_noahmp%iopt_rsf = iopt_rsf + mpas_noahmp%iopt_soil = iopt_soil + mpas_noahmp%iopt_pedo = iopt_pedo + mpas_noahmp%iopt_crop = iopt_crop + mpas_noahmp%iopt_irr = iopt_irr + mpas_noahmp%iopt_irrm = iopt_irrm + mpas_noahmp%iopt_infdv = iopt_infdv + mpas_noahmp%iopt_tdrn = iopt_tdrn + +!--- check options that are not available in MPAS: + if(iopt_soil == 4) call physics_error_fatal("NOAHmp: iopt_soil = 4 is not an available option") + if(iopt_crop > 0 ) call physics_error_fatal("NOAHmp: crop model is not an available option. set iopt_crop = 0") + if(iopt_irr > 0 ) call physics_error_fatal("NOAHmp: irrigation is not an available option. set iopt_irr = 0" ) + if(iopt_irrm > 0 ) call physics_error_fatal("NOAHmp: irrigation is not an available option. set iopt_irrm = 0") + if(iopt_tdrn > 0 ) call physics_error_fatal("NOAHmp: drainage is not an available option. set iopt_tdrn = 0" ) + +!call mpas_log_write('--- end subroutine noahmp_read_namelist:') + + end subroutine noahmp_read_namelist + +!================================================================================================================= + subroutine noahmp_init(configs,mesh,clock,diag_physics,diag_physics_noahmp,output_noahmp,sfc_input) +!================================================================================================================= + +!--- input arguments: + type(mpas_pool_type),intent(in):: configs + type(mpas_pool_type),intent(in):: mesh + type(mpas_clock_type),intent(in):: clock + +!--- inout arguments: + type(mpas_pool_type),intent(inout):: diag_physics + type(mpas_pool_type),intent(inout):: diag_physics_noahmp + type(mpas_pool_type),intent(inout):: output_noahmp + type(mpas_pool_type),intent(inout):: sfc_input + +!local pointers: + logical,pointer:: urban_physics + + integer,pointer:: nsoilcomps + integer,dimension(:),pointer:: isltyp,ivgtyp + integer,dimension(:),pointer:: isnowxy + integer,dimension(:),pointer:: irnumsi,irnummi,irnumfi + + real(kind=RKIND):: dt + + real(kind=RKIND),dimension(:),pointer:: soilcl1,soilcl2,soilcl3,soilcl4 + real(kind=RKIND),dimension(:,:),pointer:: soilcomp + + real(kind=RKIND),dimension(:),pointer:: areaCell,latCell,lonCell + real(kind=RKIND),dimension(:),pointer:: canwat,lai,skintemp,snow,snowc,snowh,tmn,xice,xland + real(kind=RKIND),dimension(:),pointer:: alboldxy,canicexy,canliqxy,chxy,cmxy,eahxy,fastcpxy,fwetxy,gddxy, & + grainxy,lfmassxy,qrainxy,qsnowxy,rtmassxy,sneqvoxy,stblcpxy,stmassxy, & + tahxy,tgxy,tvxy,xsaixy,waxy,woodxy,wslakexy,wtxy,zwtxy + real(kind=RKIND),dimension(:),pointer:: irwatsi,ireloss,irrsplh,irwatmi,irmivol,irwatfi,irfivol + real(kind=RKIND),dimension(:),pointer:: qtdrain,t2mbxy,t2mvxy,t2mxy + + real(kind=RKIND),dimension(:,:),pointer:: dzs,sh2o,smois,tslb + real(kind=RKIND),dimension(:,:),pointer:: snicexy,snliqxy,tsnoxy,zsnsoxy + +!local variables and pointers: + logical,pointer:: do_restart + logical,parameter:: fndsnowh = .true. + + integer:: i,its,ite,ns,nsoil,nsnow,nzsnow + + real(kind=RKIND),parameter:: hlice = 3.335E5 + real(kind=RKIND):: bexp,fk,smcmax,psisat + +!----------------------------------------------------------------------------------------------------------------- +!call mpas_log_write(' ') +!call mpas_log_write('--- enter subroutine noahmp_init:') + + +!--- initialization of local dimensions: + its = mpas_noahmp%its + ite = mpas_noahmp%ite + nsoil = mpas_noahmp%nsoil + nsnow = mpas_noahmp%nsnow + nzsnow = nsnow + nsoil + + +!--- initialization of Noah-MP run parameters: + call mpas_pool_get_config(configs,'config_do_restart',do_restart) + call mpas_pool_get_config(configs,'config_urban_physics',urban_physics) + call mpas_get_timeInterval(mpas_get_clock_timestep(clock, ierr), dt=dt) + + mpas_noahmp%restart_flag = do_restart + mpas_noahmp%sf_urban_physics = 0 + if(urban_physics) mpas_noahmp%sf_urban_physics = 1 + + mpas_noahmp%fndsnowh = fndsnowh + mpas_noahmp%dtbl = dt + + +!--- initialization of Noah-MP mesh variables: + call mpas_pool_get_dimension(mesh,'nSoilComps',nsoilcomps) + + call mpas_pool_get_array(mesh,'areaCell',areaCell) + call mpas_pool_get_array(mesh,'latCell' ,latCell ) + call mpas_pool_get_array(mesh,'lonCell' ,lonCell ) + call mpas_pool_get_array(mesh,'soilcomp',soilcomp) + call mpas_pool_get_array(mesh,'soilcl1' ,soilcl1 ) + call mpas_pool_get_array(mesh,'soilcl2' ,soilcl2 ) + call mpas_pool_get_array(mesh,'soilcl3' ,soilcl3 ) + call mpas_pool_get_array(mesh,'soilcl4' ,soilcl4 ) + + do i = its,ite + mpas_noahmp%areaxy(i) = areaCell(i) + mpas_noahmp%xlat(i) = latCell(i) + mpas_noahmp%xlong(i) = lonCell(i) + enddo + if(mpas_noahmp%iopt_soil > 1) then + do i = its,ite + mpas_noahmp%soilcl1(i) = soilcl1(i) + mpas_noahmp%soilcl2(i) = soilcl2(i) + mpas_noahmp%soilcl3(i) = soilcl3(i) + mpas_noahmp%soilcl4(i) = soilcl4(i) + do ns = 1,nsoilcomps + mpas_noahmp%soilcomp(i,ns) = soilcomp(ns,i) + enddo + enddo + endif + + +!--- initialization of time-invariant surface variables needed in subroutine NoahmpInitMain: + call mpas_pool_get_array(sfc_input,'dzs' ,dzs ) + call mpas_pool_get_array(sfc_input,'isltyp',isltyp) + call mpas_pool_get_array(sfc_input,'ivgtyp',ivgtyp) + + do i = its, ite + mpas_noahmp%isltyp(i) = isltyp(i) + mpas_noahmp%ivgtyp(i) = ivgtyp(i) + enddo + do ns = 1, nsoil + mpas_noahmp%dzs(ns) = dzs(ns,its) + enddo + + + if(mpas_noahmp%restart_flag) return + +!--- initialization of time-varying variables needed in subroutine NoahmpInitMain: + call mpas_pool_get_array(sfc_input,'skintemp',skintemp) + 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,'xice' ,xice ) + call mpas_pool_get_array(sfc_input,'xland' ,xland ) + call mpas_pool_get_array(sfc_input,'sh2o' ,sh2o ) + 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,'canwat',canwat) + call mpas_pool_get_array(diag_physics,'lai',lai) + + call mpas_pool_get_array(diag_physics_noahmp,'alboldxy',alboldxy) + call mpas_pool_get_array(diag_physics_noahmp,'canicexy',canicexy) + call mpas_pool_get_array(diag_physics_noahmp,'canliqxy',canliqxy) + call mpas_pool_get_array(diag_physics_noahmp,'chxy' ,chxy ) + call mpas_pool_get_array(diag_physics_noahmp,'cmxy' ,cmxy ) + call mpas_pool_get_array(diag_physics_noahmp,'eahxy' ,eahxy ) + call mpas_pool_get_array(diag_physics_noahmp,'fastcpxy',fastcpxy) + call mpas_pool_get_array(diag_physics_noahmp,'fwetxy' ,fwetxy ) + call mpas_pool_get_array(diag_physics_noahmp,'gddxy' ,gddxy ) + call mpas_pool_get_array(diag_physics_noahmp,'grainxy' ,grainxy ) + call mpas_pool_get_array(diag_physics_noahmp,'lfmassxy',lfmassxy) + call mpas_pool_get_array(diag_physics_noahmp,'qrainxy' ,qrainxy ) + call mpas_pool_get_array(diag_physics_noahmp,'qsnowxy' ,qsnowxy ) + call mpas_pool_get_array(diag_physics_noahmp,'rtmassxy',rtmassxy) + call mpas_pool_get_array(diag_physics_noahmp,'sneqvoxy',sneqvoxy) + call mpas_pool_get_array(diag_physics_noahmp,'stblcpxy',stblcpxy) + call mpas_pool_get_array(diag_physics_noahmp,'stmassxy',stmassxy) + call mpas_pool_get_array(diag_physics_noahmp,'tahxy' ,tahxy ) + call mpas_pool_get_array(diag_physics_noahmp,'tgxy' ,tgxy ) + call mpas_pool_get_array(diag_physics_noahmp,'tvxy' ,tvxy ) + call mpas_pool_get_array(diag_physics_noahmp,'waxy' ,waxy ) + call mpas_pool_get_array(diag_physics_noahmp,'woodxy' ,woodxy ) + call mpas_pool_get_array(diag_physics_noahmp,'wslakexy',wslakexy) + call mpas_pool_get_array(diag_physics_noahmp,'wtxy' ,wtxy ) + call mpas_pool_get_array(diag_physics_noahmp,'xsaixy' ,xsaixy ) + call mpas_pool_get_array(diag_physics_noahmp,'zwtxy' ,zwtxy ) + + call mpas_pool_get_array(diag_physics_noahmp,'irnumsi' ,irnumsi ) + call mpas_pool_get_array(diag_physics_noahmp,'irwatsi' ,irwatsi ) + call mpas_pool_get_array(diag_physics_noahmp,'ireloss' ,ireloss ) + call mpas_pool_get_array(diag_physics_noahmp,'irrsplh' ,irrsplh ) + call mpas_pool_get_array(diag_physics_noahmp,'irnummi' ,irnummi ) + call mpas_pool_get_array(diag_physics_noahmp,'irwatmi' ,irwatmi ) + call mpas_pool_get_array(diag_physics_noahmp,'irmivol' ,irmivol ) + call mpas_pool_get_array(diag_physics_noahmp,'irnumfi' ,irnumfi ) + call mpas_pool_get_array(diag_physics_noahmp,'irwatfi' ,irwatfi ) + call mpas_pool_get_array(diag_physics_noahmp,'irfivol', irfivol ) + + call mpas_pool_get_array(diag_physics_noahmp,'isnowxy' ,isnowxy ) + call mpas_pool_get_array(diag_physics_noahmp,'snicexy' ,snicexy ) + call mpas_pool_get_array(diag_physics_noahmp,'snliqxy' ,snliqxy ) + call mpas_pool_get_array(diag_physics_noahmp,'tsnoxy' ,tsnoxy ) + call mpas_pool_get_array(diag_physics_noahmp,'zsnsoxy' ,zsnsoxy ) + + call mpas_pool_get_array(output_noahmp,'t2mbxy',t2mbxy ) + call mpas_pool_get_array(output_noahmp,'t2mvxy',t2mvxy ) + call mpas_pool_get_array(output_noahmp,'t2mxy' ,t2mxy ) + call mpas_pool_get_array(output_noahmp,'qtdrain',qtdrain) + +!--- initialization of the soil liquid water content: + do i = its,ite + if(ivgtyp(i) == mpas_noahmp%isice_table .and. xice(i) .le. 0._RKIND) then + !initialization over landice grid cells (frozen at init time): + do ns = 1,nsoil + smois(ns,i) = 1._RKIND + sh2o(ns,i) = 0._RKIND + tslb(ns,i) = min(tslb(ns,i),263.15) ! set landice temperature at -10C. + enddo + else + !initialization over all non-landice grid cells: + bexp = mpas_noahmp%bexp_table(isltyp(i)) + smcmax = mpas_noahmp%smcmax_table(isltyp(i)) + psisat = mpas_noahmp%psisat_table(isltyp(i)) + + do ns = 1,nsoil + if(smois(ns,i) > smcmax) smois(ns,i) = smcmax + enddo + if(bexp.gt.0. .and. smcmax.gt.0. .and. psisat.gt.0.) then + do ns = 1,nsoil + if(tslb(ns,i) .lt. 273.149) then ! initial soil ice. + fk = ( ((hlice/(grav*(-psisat)))*((tslb(ns,i)-t0)/tslb(ns,i)))**(-1/bexp) )*smcmax + fk = max(fk,0.02) + sh2o(ns,i) = min(fk,smois(ns,i)) + else + sh2o(ns,i) = smois(ns,i) + endif + enddo + else + do ns = 1,nsoil + sh2o(ns,i) = smois(ns,i) + enddo + endif + endif + enddo + + + do i = its,ite + mpas_noahmp%tmn(i) = tmn(i) + mpas_noahmp%tsk(i) = skintemp(i) + mpas_noahmp%xice(i) = xice(i) + mpas_noahmp%xland(i) = xland(i) + mpas_noahmp%snow(i) = snow(i) + mpas_noahmp%snowh(i) = snowh(i) + + do ns = 1,nsoil + mpas_noahmp%sh2o(i,ns) = sh2o(ns,i) + mpas_noahmp%smois(i,ns) = smois(ns,i) + mpas_noahmp%tslb(i,ns) = tslb(ns,i) + enddo + enddo + + + call NoahmpInitMain(mpas_noahmp) + + +!--- update of all time-varying Noah-MP variables: + do i = its,ite + isnowxy(i) = mpas_noahmp%isnowxy(i) + snow(i) = mpas_noahmp%snow(i) ! in mm (check unit in noahmp driver). + snowh(i) = mpas_noahmp%snowh(i) ! in m (check unit in noahmp driver). + snowc(i) = 0._RKIND + if(snow(i) .gt. 0._RKIND) snowc(i) = 1. + + do ns = 1,nsoil + sh2o(ns,i) = mpas_noahmp%sh2o(i,ns) + smois(ns,i) = mpas_noahmp%smois(i,ns) + tslb(ns,i) = mpas_noahmp%tslb(i,ns) + enddo + enddo + + do ns = 1,nsnow + n = ns - nsnow + do i = its,ite + tsnoxy(ns,i) = mpas_noahmp%tsnoxy(i,n) + snicexy(ns,i) = mpas_noahmp%snicexy(i,n) + snliqxy(ns,i) = mpas_noahmp%snliqxy(i,n) + zsnsoxy(ns,i) = mpas_noahmp%zsnsoxy(i,n) + enddo + enddo + do ns = nsnow+1,nzsnow + n = ns - nsnow + do i = its,ite + zsnsoxy(ns,i) = mpas_noahmp%zsnsoxy(i,n) + enddo + enddo + + do i = its,ite + canwat(i) = mpas_noahmp%canwat(i) + lai(i) = mpas_noahmp%lai(i) + + isnowxy(i) = mpas_noahmp%isnowxy(i) + alboldxy(i) = mpas_noahmp%alboldxy(i) + canicexy(i) = mpas_noahmp%canicexy(i) + canliqxy(i) = mpas_noahmp%canliqxy(i) + chxy(i) = mpas_noahmp%chxy(i) + cmxy(i) = mpas_noahmp%cmxy(i) + eahxy(i) = mpas_noahmp%eahxy(i) + fastcpxy(i) = mpas_noahmp%fastcpxy(i) + fwetxy(i) = mpas_noahmp%fwetxy(i) + gddxy(i) = mpas_noahmp%gddxy(i) + grainxy(i) = mpas_noahmp%grainxy(i) + lfmassxy(i) = mpas_noahmp%lfmassxy(i) + qrainxy(i) = mpas_noahmp%qrainxy(i) + qsnowxy(i) = mpas_noahmp%qsnowxy(i) + rtmassxy(i) = mpas_noahmp%rtmassxy(i) + sneqvoxy(i) = mpas_noahmp%sneqvoxy(i) + stblcpxy(i) = mpas_noahmp%stblcpxy(i) + stmassxy(i) = mpas_noahmp%stmassxy(i) + tahxy(i) = mpas_noahmp%tahxy(i) + tgxy(i) = mpas_noahmp%tgxy(i) + tvxy(i) = mpas_noahmp%tvxy(i) + waxy(i) = mpas_noahmp%waxy(i) + woodxy(i) = mpas_noahmp%woodxy(i) + wslakexy(i) = mpas_noahmp%wslakexy(i) + wtxy(i) = mpas_noahmp%wtxy(i) + xsaixy(i) = mpas_noahmp%xsaixy(i) + zwtxy(i) = mpas_noahmp%zwtxy(i) + + qtdrain(i) = mpas_noahmp%qtdrain(i) + t2mbxy(i) = mpas_noahmp%t2mbxy(i) + t2mvxy(i) = mpas_noahmp%t2mvxy(i) + t2mxy(i) = mpas_noahmp%t2mxy(i) + enddo + + do i = its, ite + irnumsi(i) = mpas_noahmp%irnumsi(i) + irwatsi(i) = mpas_noahmp%irwatsi(i) + ireloss(i) = mpas_noahmp%ireloss(i) + irrsplh(i) = mpas_noahmp%irrsplh(i) + irnummi(i) = mpas_noahmp%irnummi(i) + irwatmi(i) = mpas_noahmp%irwatmi(i) + irmivol(i) = mpas_noahmp%irmivol(i) + irnumfi(i) = mpas_noahmp%irnumfi(i) + irwatfi(i) = mpas_noahmp%irwatfi(i) + irfivol(i) = mpas_noahmp%irfivol(i) + enddo + + +!call mpas_log_write('--- end subroutine noahmp_init:') + + end subroutine noahmp_init + +!================================================================================================================= + end module mpas_atmphys_lsm_noahmpinit +!================================================================================================================= diff --git a/src/core_atmosphere/physics/mpas_atmphys_manager.F b/src/core_atmosphere/physics/mpas_atmphys_manager.F index 1056896f8..205714872 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_manager.F +++ b/src/core_atmosphere/physics/mpas_atmphys_manager.F @@ -23,6 +23,8 @@ module mpas_atmphys_manager public:: physics_timetracker,physics_run_init integer, public:: year !Current year. + integer, public:: month !Current month. + integer, public:: day !Current day of the month. integer, public:: julday !Initial Julian day. real(kind=RKIND), public:: curr_julday !Current Julian day (= 0.0 at 0Z on January 1st). real(kind=RKIND), public:: gmt !Greenwich mean time hour of model start (hr) @@ -183,12 +185,12 @@ subroutine physics_timetracker(domain,dt,clock,itimestep,xtime_s) !call mpas_log_write('--- enter subroutine physics_timetracker: itimestep = $i', intArgs=(/itimestep/)) call mpas_pool_get_config(domain%blocklist%configs,'config_convection_scheme',config_convection_scheme) - call mpas_pool_get_config(domain%blocklist%configs,'config_radt_lw_scheme' ,config_radt_lw_scheme ) - call mpas_pool_get_config(domain%blocklist%configs,'config_radt_sw_scheme' ,config_radt_sw_scheme ) + call mpas_pool_get_config(domain%blocklist%configs,'config_radt_lw_scheme' ,config_radt_lw_scheme ) + call mpas_pool_get_config(domain%blocklist%configs,'config_radt_sw_scheme' ,config_radt_sw_scheme ) - call mpas_pool_get_config(domain%blocklist%configs,'config_conv_interval' ,config_conv_interval ) - call mpas_pool_get_config(domain%blocklist%configs,'config_radtlw_interval' ,config_radtlw_interval ) - call mpas_pool_get_config(domain%blocklist%configs,'config_radtsw_interval' ,config_radtsw_interval ) + call mpas_pool_get_config(domain%blocklist%configs,'config_conv_interval' ,config_conv_interval ) + call mpas_pool_get_config(domain%blocklist%configs,'config_radtlw_interval',config_radtlw_interval) + call mpas_pool_get_config(domain%blocklist%configs,'config_radtsw_interval',config_radtsw_interval) call mpas_pool_get_config(domain%blocklist%configs,'config_frac_seaice' ,config_frac_seaice ) call mpas_pool_get_config(domain%blocklist%configs,'config_o3climatology' ,config_o3climatology ) @@ -200,7 +202,7 @@ subroutine physics_timetracker(domain,dt,clock,itimestep,xtime_s) !update the current julian day and current year: currTime = mpas_get_clock_time(clock,MPAS_NOW,ierr) - call mpas_get_time(curr_time=currTime,dateTimeString=timeStamp,YYYY=yr,H=h,M=m, & + call mpas_get_time(curr_time=currTime,dateTimeString=timeStamp,YYYY=yr,MM=month,DD=day,H=h,M=m, & S=s,S_n=s_n,S_d=s_d,DoY=DoY,ierr=ierr) utc_h = real(h) + real(m) / 60.0 + real(s + s_n / s_d) / 3600.0 @@ -209,13 +211,13 @@ subroutine physics_timetracker(domain,dt,clock,itimestep,xtime_s) julday = DoY curr_julday = real(julday-1) + utc_h / 24.0 LeapYear = isLeapYear(year) -! call mpas_log_write(' YEAR =$i', intArgs=(/year/)) -! call mpas_log_write(' JULDAY =$i', intArgs=(/julday/)) -! call mpas_log_write(' GMT =$r', realArgs=(/gmt/)) -! call mpas_log_write(' UTC_H =$r', realArgs=(/utc_h/)) -! call mpas_log_write(' CURR_JULDAY =$r', realArgs=(/curr_julday/)) -! call mpas_log_write(' LEAP_YEAR =$l', logicArgs=(/LeapYear/)) -! call mpas_log_write(' TIME STAMP ='//trim(timeStamp)) +!call mpas_log_write(' YEAR = $i', intArgs=(/year/)) +!call mpas_log_write(' JULDAY = $i', intArgs=(/julday/)) +!call mpas_log_write(' GMT = $r', realArgs=(/gmt/)) +!call mpas_log_write(' UTC_H = $r', realArgs=(/utc_h/)) +!call mpas_log_write(' CURR_JULDAY = $r', realArgs=(/curr_julday/)) +!call mpas_log_write(' LEAP_YEAR = $l', logicArgs=(/LeapYear/)) +!call mpas_log_write(' TIME STAMP = '//trim(timeStamp)) block => domain % blocklist do while(associated(block)) @@ -266,7 +268,7 @@ subroutine physics_timetracker(domain,dt,clock,itimestep,xtime_s) elseif(config_radtlw_interval == "none") then l_radtlw = .true. endif - call mpas_log_write('--- time to run the LW radiation scheme L_RADLW =$l',logicArgs=(/l_radtlw/)) + call mpas_log_write('--- time to run the LW radiation scheme L_RADLW = $l',logicArgs=(/l_radtlw/)) endif if(trim(config_radt_sw_scheme) /= "off") then @@ -280,7 +282,7 @@ subroutine physics_timetracker(domain,dt,clock,itimestep,xtime_s) elseif(config_radtsw_interval == "none") then l_radtsw = .true. endif - call mpas_log_write('--- time to run the SW radiation scheme L_RADSW =$l',logicArgs=(/l_radtsw/)) + call mpas_log_write('--- time to run the SW radiation scheme L_RADSW = $l',logicArgs=(/l_radtsw/)) endif !check to see if it is time to run the parameterization of convection: @@ -295,7 +297,7 @@ subroutine physics_timetracker(domain,dt,clock,itimestep,xtime_s) elseif(config_conv_interval == "none") then l_conv = .true. endif - call mpas_log_write('--- time to run the convection scheme L_CONV =$l',logicArgs=(/l_conv/)) + call mpas_log_write('--- time to run the convection scheme L_CONV = $l',logicArgs=(/l_conv/)) endif !check to see if it is time to update ozone to the current julian day in the RRTMG radiation codes: @@ -334,7 +336,7 @@ subroutine physics_timetracker(domain,dt,clock,itimestep,xtime_s) call mpas_reset_clock_alarm(clock,camlwAlarmID,camlwTimeStep,ierr=ierr) l_camlw = .true. endif - call mpas_log_write('--- time to write local CAM arrays to MPAS arrays L_CAMLW =$l',logicArgs=(/l_camlw/)) + call mpas_log_write('--- time to write local CAM arrays to MPAS arrays L_CAMLW = $l',logicArgs=(/l_camlw/)) endif !check to see if it is time to apply limit to the accumulated rain due to cloud microphysics @@ -345,7 +347,7 @@ subroutine physics_timetracker(domain,dt,clock,itimestep,xtime_s) call mpas_reset_clock_alarm(clock,acrainAlarmID,acrainTimeStep,ierr=ierr) l_acrain = .true. endif - call mpas_log_write('--- time to apply limit to accumulated rainc and rainnc L_ACRAIN =$l',logicArgs=(/l_acrain/)) + call mpas_log_write('--- time to apply limit to accumulated rainc and rainnc L_ACRAIN = $l',logicArgs=(/l_acrain/)) endif !check to see if it is time to apply limit to the accumulated radiation diagnostics due to @@ -356,7 +358,7 @@ subroutine physics_timetracker(domain,dt,clock,itimestep,xtime_s) call mpas_reset_clock_alarm(clock,acradtAlarmID,acradtTimeStep,ierr=ierr) l_acradt = .true. endif - call mpas_log_write('--- time to apply limit to accumulated radiation diags. L_ACRADT =$l',logicArgs=(/l_acradt/)) + call mpas_log_write('--- time to apply limit to accumulated radiation diags. L_ACRADT = $l',logicArgs=(/l_acradt/)) endif !check to see if it is time to calculate additional physics diagnostics: @@ -368,7 +370,7 @@ subroutine physics_timetracker(domain,dt,clock,itimestep,xtime_s) if (mpas_is_alarm_ringing(clock,diagAlarmID,interval=dtInterval,ierr=ierr)) then l_diags = .true. end if - call mpas_log_write('--- time to calculate additional physics_diagnostics =$l',logicArgs=(/l_diags/)) + call mpas_log_write('--- time to calculate additional physics_diagnostics = $l',logicArgs=(/l_diags/)) end subroutine physics_timetracker @@ -384,18 +386,18 @@ subroutine physics_run_init(configs,mesh,state,clock,stream_manager) type (MPAS_streamManager_type), intent(inout) :: stream_manager !local pointers: - character(len=StrKIND),pointer:: config_convection_scheme, & - config_lsm_scheme, & - config_microp_scheme, & - config_radt_lw_scheme, & + character(len=StrKIND),pointer:: config_convection_scheme, & + config_lsm_scheme, & + config_microp_scheme, & + config_radt_lw_scheme, & config_radt_sw_scheme - character(len=StrKIND),pointer:: config_conv_interval, & - config_pbl_interval, & - config_radtlw_interval, & - config_radtsw_interval, & - config_bucket_update, & - config_camrad_abs_update, & + character(len=StrKIND),pointer:: config_conv_interval, & + config_pbl_interval, & + config_radtlw_interval, & + config_radtsw_interval, & + config_bucket_update, & + config_camrad_abs_update, & config_greeness_update logical,pointer:: config_sst_update @@ -408,7 +410,7 @@ subroutine physics_run_init(configs,mesh,state,clock,stream_manager) integer,pointer:: nAerosols,nAerLevels,nOznLevels integer,pointer:: nCellsSolve,nSoilLevels,nVertLevels - real(kind=RKIND),pointer:: config_dt + real(kind=RKIND):: dt !local variables: type(MPAS_Time_Type):: startTime,alarmStartTime @@ -437,7 +439,7 @@ subroutine physics_run_init(configs,mesh,state,clock,stream_manager) call mpas_pool_get_config(configs,'config_frac_seaice' ,config_frac_seaice ) call mpas_pool_get_config(configs,'config_microp_re' ,config_microp_re ) - call mpas_pool_get_config(configs,'config_dt',config_dt) + call mpas_get_timeInterval(mpas_get_clock_timestep(clock, ierr), dt=dt) call mpas_pool_get_dimension(mesh,'cam_dim1' ,cam_dim1 ) @@ -445,7 +447,6 @@ subroutine physics_run_init(configs,mesh,state,clock,stream_manager) call mpas_pool_get_dimension(mesh,'nAerLevels' ,nAerLevels ) call mpas_pool_get_dimension(mesh,'nOznLevels' ,nOznLevels ) call mpas_pool_get_dimension(mesh,'nCellsSolve',nCellsSolve) - call mpas_pool_get_dimension(mesh,'nCellsSolve',nCellsSolve) call mpas_pool_get_dimension(mesh,'nSoilLevels',nSoilLevels) call mpas_pool_get_dimension(mesh,'nVertLevels',nVertLevels) @@ -481,7 +482,7 @@ subroutine physics_run_init(configs,mesh,state,clock,stream_manager) call physics_error_fatal('subroutine physics_run_init: error defining dt_radtlw') elseif(trim(config_radtlw_interval) == "none") then - dt_radtlw = config_dt + dt_radtlw = dt else call physics_error_fatal('subroutine physics_run_init: dt_radtlw is not defined') @@ -500,7 +501,7 @@ subroutine physics_run_init(configs,mesh,state,clock,stream_manager) call physics_error_fatal('subroutine physics_run_init: error defining radtswAlarmID') elseif(trim(config_radtsw_interval) == "none") then - dt_radtsw = config_dt + dt_radtsw = dt else call physics_error_fatal('subroutine physics_run_init: dt_radtsw is not defined') @@ -519,7 +520,7 @@ subroutine physics_run_init(configs,mesh,state,clock,stream_manager) call physics_error_fatal('subroutine physics_run_init: error defining dt_cu') elseif(trim(config_conv_interval) == "none") then - dt_cu = config_dt + dt_cu = dt else call physics_error_fatal('subroutine physics_run_init: dt_cu is not defined') @@ -538,7 +539,7 @@ subroutine physics_run_init(configs,mesh,state,clock,stream_manager) call physics_error_fatal('subroutine physics_run_init: error defining dt_pbl') elseif(trim(config_pbl_interval) == "none") then - dt_pbl = config_dt + dt_pbl = dt else call physics_error_fatal('subroutine physics_run_init: dt_pbl is not defined') @@ -577,7 +578,7 @@ subroutine physics_run_init(configs,mesh,state,clock,stream_manager) !set alarm to write the "CAM" local arrays absnst_p, absnxt_p, and emstot_p to the MPAS arrays !for writing to the restart file at the bottom of the time-step: if(trim(config_radt_lw_scheme) .eq. "cam_lw" ) then - call mpas_set_timeInterval(camlwTimeStep,dt=config_dt,ierr=ierr) + call mpas_set_timeInterval(camlwTimeStep,dt=dt,ierr=ierr) call MPAS_stream_mgr_get_property(stream_manager, 'restart', MPAS_STREAM_PROPERTY_RECORD_INTV, stream_interval, & direction=MPAS_STREAM_OUTPUT, ierr=ierr) if(trim(stream_interval) /= 'none') then @@ -592,7 +593,7 @@ subroutine physics_run_init(configs,mesh,state,clock,stream_manager) !set alarm to check if the accumulated rain due to cloud microphysics and convection is !greater than its maximum allowed value: if(config_bucket_update /= "none") then - call mpas_set_timeInterval(acrainTimeStep,dt=config_dt,ierr=ierr) + call mpas_set_timeInterval(acrainTimeStep,dt=dt,ierr=ierr) call mpas_set_timeInterval(alarmTimeStep,timeString=config_bucket_update,ierr=ierr) alarmStartTime = startTime + alarmTimeStep call mpas_add_clock_alarm(clock,acrainAlarmID,alarmStartTime,alarmTimeStep,ierr=ierr) @@ -603,7 +604,7 @@ subroutine physics_run_init(configs,mesh,state,clock,stream_manager) !set alarm to check if the accumulated radiation diagnostics due to long- and short-wave radiation !is greater than its maximum allowed value: if(config_bucket_update /= "none") then - call mpas_set_timeInterval(acradtTimeStep,dt=config_dt,ierr=ierr) + call mpas_set_timeInterval(acradtTimeStep,dt=dt,ierr=ierr) call mpas_set_timeInterval(alarmTimeStep,timeString=config_bucket_update,ierr=ierr) alarmStartTime = startTime + alarmTimeStep call mpas_add_clock_alarm(clock,acradtAlarmID,alarmStartTime,alarmTimeStep,ierr=ierr) @@ -642,10 +643,11 @@ subroutine physics_run_init(configs,mesh,state,clock,stream_manager) end if endif - call mpas_log_write(' DT_RADTLW =$r', realArgs=(/dt_radtlw/)) - call mpas_log_write(' DT_RADTSW =$r', realArgs=(/dt_radtsw/)) - call mpas_log_write(' DT_CU =$r', realArgs=(/dt_cu/)) - call mpas_log_write(' DT_PBL =$r', realArgs=(/dt_pbl/)) + call mpas_log_write(' ') + call mpas_log_write('DT_RADTLW = $r',realArgs=(/dt_radtlw/)) + call mpas_log_write('DT_RADTSW = $r',realArgs=(/dt_radtsw/)) + call mpas_log_write('DT_CU = $r',realArgs=(/dt_cu/)) + call mpas_log_write('DT_PBL = $r',realArgs=(/dt_pbl/)) !initialization of physics dimensions to mimic a rectangular grid: ims=1 ; ime = nCellsSolve @@ -660,15 +662,16 @@ subroutine physics_run_init(configs,mesh,state,clock,stream_manager) jts=jms ; jte = jme kts=kms ; kte = kme-1 - call mpas_log_write(' IMS =$i IME =$i', intArgs=(/ims,ime/)) - call mpas_log_write(' JMS =$i JME =$i', intArgs=(/jms,jme/)) - call mpas_log_write(' KMS =$i KME =$i', intArgs=(/kms,kme/)) - call mpas_log_write(' IDS =$i IDE =$i', intArgs=(/ids,ide/)) - call mpas_log_write(' JDS =$i JDE =$i', intArgs=(/jds,jde/)) - call mpas_log_write(' KDS =$i KDE =$i', intArgs=(/kds,kde/)) - call mpas_log_write(' ITS =$i ITE =$i', intArgs=(/its,ite/)) - call mpas_log_write(' JTS =$i JTE =$i', intArgs=(/jts,jte/)) - call mpas_log_write(' KTS =$i KTE =$i', intArgs=(/kts,kte/)) + call mpas_log_write(' ') + call mpas_log_write('IMS = $i IME = $i',intArgs=(/ims,ime/)) + call mpas_log_write('JMS = $i JME = $i',intArgs=(/jms,jme/)) + call mpas_log_write('KMS = $i KME = $i',intArgs=(/kms,kme/)) + call mpas_log_write('IDS = $i IDE = $i',intArgs=(/ids,ide/)) + call mpas_log_write('JDS = $i JDE = $i',intArgs=(/jds,jde/)) + call mpas_log_write('KDS = $i KDE = $i',intArgs=(/kds,kde/)) + call mpas_log_write('ITS = $i ITE = $i',intArgs=(/its,ite/)) + call mpas_log_write('JTS = $i JTE = $i',intArgs=(/jts,jte/)) + call mpas_log_write('KTS = $i KTE = $i',intArgs=(/kts,kte/)) !initialization local physics variables: num_months = nMonths @@ -678,16 +681,18 @@ subroutine physics_run_init(configs,mesh,state,clock,stream_manager) !initialization of local physics time-steps: !... dynamics: - dt_dyn = config_dt + dt_dyn = dt !... cloud microphysics: dt_microp = dt_dyn n_microp = 1 - if(trim(config_microp_scheme)=='mp_thompson') then + if(trim(config_microp_scheme)=='mp_thompson' .or. & + trim(config_microp_scheme)=='mp_thompson_aerosols') then dt_microp = 90._RKIND n_microp = max(nint(dt_dyn/dt_microp),1) dt_microp = dt_dyn / n_microp if(dt_dyn <= dt_microp) dt_microp = dt_dyn endif + call mpas_log_write(' ') call mpas_log_write('--- specifics on cloud microphysics option microp_scheme = '//trim(config_microp_scheme)) call mpas_log_write('--- dt_microp = $r', realArgs=(/dt_microp/)) call mpas_log_write('--- n_microp = $i', intArgs=(/n_microp/)) @@ -743,7 +748,8 @@ subroutine physics_run_init(configs,mesh,state,clock,stream_manager) has_reqi = 0 has_reqs = 0 if(config_microp_re) then - if(trim(config_microp_scheme)=='mp_thompson' .or. & + if(trim(config_microp_scheme)=='mp_thompson' .or. & + trim(config_microp_scheme)=='mp_thompson_aerosols' .or. & trim(config_microp_scheme)=='mp_wsm6') then if(trim(config_radt_lw_scheme)=='rrtmg_lw' .and. trim(config_radt_sw_scheme)=='rrtmg_sw') then has_reqc = 1 @@ -755,6 +761,7 @@ subroutine physics_run_init(configs,mesh,state,clock,stream_manager) call mpas_log_write('--- has_reqc = $i', intArgs=(/has_reqc/)) call mpas_log_write('--- has_reqi = $i', intArgs=(/has_reqi/)) call mpas_log_write('--- has_reqs = $i', intArgs=(/has_reqs/)) + call mpas_log_write(' ') end subroutine physics_run_init diff --git a/src/core_atmosphere/physics/mpas_atmphys_packages.F b/src/core_atmosphere/physics/mpas_atmphys_packages.F index e6b1640e4..0705d67e5 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_packages.F +++ b/src/core_atmosphere/physics/mpas_atmphys_packages.F @@ -36,9 +36,11 @@ function atmphys_setup_packages(configs,packages,iocontext) result(ierr) character(len=StrKIND),pointer:: config_microp_scheme character(len=StrKIND),pointer:: config_convection_scheme character(len=StrKIND),pointer:: config_pbl_scheme - logical,pointer:: mp_kessler_in,mp_thompson_in,mp_wsm6_in + character(len=StrKIND),pointer:: config_lsm_scheme + logical,pointer:: mp_kessler_in,mp_thompson_in,mp_thompson_aers_in,mp_wsm6_in logical,pointer:: cu_grell_freitas_in,cu_kain_fritsch_in,cu_ntiedtke_in,cu_gf_monan_in logical,pointer:: bl_mynn_in,bl_ysu_in + logical,pointer:: sf_noahmp_in integer :: ierr @@ -61,11 +63,15 @@ function atmphys_setup_packages(configs,packages,iocontext) result(ierr) nullify(mp_thompson_in) call mpas_pool_get_package(packages,'mp_thompson_inActive',mp_thompson_in) + nullify(mp_thompson_aers_in) + call mpas_pool_get_package(packages,'mp_thompson_aers_inActive',mp_thompson_aers_in) + nullify(mp_wsm6_in) call mpas_pool_get_package(packages,'mp_wsm6_inActive',mp_wsm6_in) - if(.not.associated(mp_kessler_in) .or. & - .not.associated(mp_thompson_in) .or. & + if(.not.associated(mp_kessler_in ) .or. & + .not.associated(mp_thompson_in ) .or. & + .not.associated(mp_thompson_aers_in) .or. & .not.associated(mp_wsm6_in)) then call mpas_log_write('====================================================================================',messageType=MPAS_LOG_ERR) call mpas_log_write('* Error while setting up packages for cloud microphysics options in atmosphere core.',messageType=MPAS_LOG_ERR) @@ -74,20 +80,24 @@ function atmphys_setup_packages(configs,packages,iocontext) result(ierr) return endif - mp_kessler_in = .false. - mp_thompson_in = .false. - mp_wsm6_in = .false. + mp_kessler_in = .false. + mp_thompson_in = .false. + mp_thompson_aers_in = .false. + mp_wsm6_in = .false. if(config_microp_scheme == 'mp_kessler') then mp_kessler_in = .true. elseif(config_microp_scheme == 'mp_thompson') then mp_thompson_in = .true. + elseif(config_microp_scheme == 'mp_thompson_aerosols') then + mp_thompson_aers_in = .true. elseif(config_microp_scheme == 'mp_wsm6') then mp_wsm6_in = .true. endif call mpas_log_write(' mp_kessler_in = $l', logicArgs=(/mp_kessler_in/)) call mpas_log_write(' mp_thompson_in = $l', logicArgs=(/mp_thompson_in/)) + call mpas_log_write(' mp_thompson_aers_in = $l', logicArgs=(/mp_thompson_aers_in/)) call mpas_log_write(' mp_wsm6_in = $l', logicArgs=(/mp_wsm6_in/)) !--- initialization of all packages for parameterizations of convection: @@ -96,6 +106,7 @@ function atmphys_setup_packages(configs,packages,iocontext) result(ierr) nullify(cu_grell_freitas_in) call mpas_pool_get_package(packages,'cu_grell_freitas_inActive',cu_grell_freitas_in) + nullify(cu_gf_monan_in) call mpas_pool_get_package(packages,'cu_gf_monan_inActive',cu_gf_monan_in) @@ -169,6 +180,29 @@ function atmphys_setup_packages(configs,packages,iocontext) result(ierr) call mpas_log_write(' bl_ysu_in = $l', logicArgs=(/bl_ysu_in/)) call mpas_log_write('') +!--- initialization of all packages for parameterizations of land surface processes: + + call mpas_pool_get_config(configs,'config_lsm_scheme',config_lsm_scheme) + + nullify(sf_noahmp_in) + call mpas_pool_get_package(packages,'sf_noahmp_inActive',sf_noahmp_in) + + if(.not.associated(sf_noahmp_in)) then + call mpas_log_write('====================================================================================',messageType=MPAS_LOG_ERR) + call mpas_log_write('* Error while setting up packages for land surface options in atmosphere core.' , messageType=MPAS_LOG_ERR) + call mpas_log_write('====================================================================================',messageType=MPAS_LOG_ERR) + ierr = 1 + return + endif + + if(config_lsm_scheme=='sf_noahmp') then + sf_noahmp_in = .true. + endif + + call mpas_log_write(' sf_noahmp_in = $l', logicArgs=(/sf_noahmp_in/)) + call mpas_log_write('') + + end function atmphys_setup_packages !================================================================================================================= diff --git a/src/core_atmosphere/physics/mpas_atmphys_sfc_diagnostics.F b/src/core_atmosphere/physics/mpas_atmphys_sfc_diagnostics.F new file mode 100644 index 000000000..6e3a84c39 --- /dev/null +++ b/src/core_atmosphere/physics/mpas_atmphys_sfc_diagnostics.F @@ -0,0 +1,128 @@ +! Copyright (c) 2024 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_atmphys_sfc_diagnostics + use mpas_kind_types,only: RKIND,StrKIND + use mpas_derived_types,only: mpas_pool_type + use mpas_log,only: mpas_log_write + use mpas_pool_routines,only: mpas_pool_get_config,mpas_pool_get_dimension,mpas_pool_get_array + + use mpas_atmphys_constants,only: cp,P0,R_d,rcp + use mpas_atmphys_vars,only: xice_threshold + + + implicit none + private + public:: atmphys_sfc_diagnostics + + + contains + + +!================================================================================================================= + subroutine atmphys_sfc_diagnostics(configs,mesh,diag,diag_physics,sfc_input,output_noahmp,its,ite) +!================================================================================================================= + +!input arguments: + type(mpas_pool_type),intent(in):: configs + type(mpas_pool_type),intent(in):: mesh + type(mpas_pool_type),intent(in):: diag + type(mpas_pool_type),intent(in):: output_noahmp + type(mpas_pool_type),intent(in):: sfc_input + integer,intent(in):: its,ite + +!inout arguments: + type(mpas_pool_type),intent(inout):: diag_physics + +!local variables and pointers: + character(len=StrKIND),pointer:: lsm_scheme + + integer,pointer:: nCellsSolve + integer:: i + + real(kind=RKIND),dimension(:),pointer:: psfc + real(kind=RKIND),dimension(:),pointer:: tsk,xice,xland + real(kind=RKIND),dimension(:),pointer:: hfx,qfx,qsfc,chs2,cqs2 + real(kind=RKIND),dimension(:),pointer:: q2mxy,t2mxy + real(kind=RKIND),dimension(:),pointer:: q2,t2m,th2m + + real(kind=RKIND):: rho + +!----------------------------------------------------------------------------------------------------------------- +!call mpas_log_write(' ') +!call mpas_log_write('--- enter subroutine atmphys_sfc_diagnostics:') + + call mpas_pool_get_config(configs,'config_lsm_scheme',lsm_scheme) + + call mpas_pool_get_dimension(mesh,'nCellsSolve',nCellsSolve) + + call mpas_pool_get_array(diag,'surface_pressure',psfc) + + call mpas_pool_get_array(diag_physics,'chs2',chs2) + call mpas_pool_get_array(diag_physics,'cqs2',cqs2) + call mpas_pool_get_array(diag_physics,'hfx' ,hfx ) + call mpas_pool_get_array(diag_physics,'qfx' ,qfx ) + call mpas_pool_get_array(diag_physics,'qsfc',qsfc) + call mpas_pool_get_array(diag_physics,'q2' ,q2 ) + call mpas_pool_get_array(diag_physics,'t2m' ,t2m ) + call mpas_pool_get_array(diag_physics,'th2m',th2m) + + call mpas_pool_get_array(sfc_input,'skintemp',tsk ) + call mpas_pool_get_array(sfc_input,'xice' ,xice ) + call mpas_pool_get_array(sfc_input,'xland' ,xland) + + sf_select: select case(trim(lsm_scheme)) + case("sf_noah") + do i = 1,nCellsSolve + rho = psfc(i)/(R_d*tsk(i)) + if(cqs2(i) .lt. 1.e-5) then + q2(i) = qsfc(i) + else + q2(i) = qsfc(i) - qfx(i)/(rho*cqs2(i)) + endif + if(chs2(i) .lt. 1.e-5) then + t2m(i) = tsk(i) + else + t2m(i) = tsk(i) - hfx(i)/(rho*cp*chs2(i)) + endif + th2m(i) = t2m(i)*(P0/psfc(i))**rcp + enddo + + case("sf_noahmp") + call mpas_pool_get_array(output_noahmp,'q2mxy',q2mxy) + call mpas_pool_get_array(output_noahmp,'t2mxy',t2mxy) + do i = 1,nCellsSolve + rho = psfc(i)/(R_d*tsk(i)) + if((xland(i)-1.5 .gt. 0._RKIND) .or. (xland(i)-1.5.le.0._RKIND .and. xice(i).ge.xice_threshold)) then + if(cqs2(i) .lt. 1.e-5) then + q2(i) = qsfc(i) + else + q2(i) = qsfc(i) - qfx(i)/(rho*cqs2(i)) + endif + if(chs2(i) .lt. 1.e-5) then + t2m(i) = tsk(i) + else + t2m(i) = tsk(i) - hfx(i)/(rho*cp*chs2(i)) + endif + else + q2(i) = q2mxy(i) + t2m(i) = t2mxy(i) + endif + th2m(i) = t2m(i)*(P0/psfc(i))**rcp + enddo + + case default + end select sf_select + +!call mpas_log_write('--- end subroutine atmphys_sfc_diagnostics:') + + end subroutine atmphys_sfc_diagnostics + +!================================================================================================================= + end module mpas_atmphys_sfc_diagnostics +!================================================================================================================= + diff --git a/src/core_atmosphere/physics/mpas_atmphys_todynamics.F b/src/core_atmosphere/physics/mpas_atmphys_todynamics.F index 6ae17e730..2c4748599 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_todynamics.F +++ b/src/core_atmosphere/physics/mpas_atmphys_todynamics.F @@ -10,6 +10,7 @@ module mpas_atmphys_todynamics use mpas_kind_types use mpas_pool_routines use mpas_dmpar + use mpas_atm_dimensions use mpas_atmphys_constants, only: R_d,R_v,degrad @@ -21,37 +22,29 @@ module mpas_atmphys_todynamics !Interface between the physics parameterizations and the non-hydrostatic dynamical core. !Laura D. Fowler (send comments to laura@ucar.edu). !2013-05-01. -! -! + + ! subroutines in mpas_atmphys_todynamics: ! --------------------------------------- -! physics_get_tend: add and mass-weigh tendencies before being added to dynamics tendencies. -! tend_toEdges : interpolate wind-tendencies from centers to edges of grid-cells. +! physics_get_tend : intermediate subroutine between the dynamical core and calculation of the total +! physics tendencies. +! physics_get_tend_work: add and mass-weigh physics tendencies before being added to dynamics tendencies. +! tend_toEdges : interpolate wind-tendencies from centers to edges of grid-cells. ! ! add-ons and modifications to sourcecode: ! ---------------------------------------- -! * added calculation of the advective tendency of the potential temperature due to horizontal -! and vertical advection, and horizontal mixing (diffusion). -! Laura D. Fowler (birch.mmm.ucar.edu) / 2013-11-19. -! * throughout the sourcecode, replaced all "var_struct" defined arrays by local pointers. -! Laura D. Fowler (laura@ucar.edu) / 2014-04-22. -! * modified sourcecode to use pools. -! Laura D. Fowler (laura@ucar.edu) / 2014-05-15. -! * renamed config_conv_deep_scheme to config_convection_scheme. -! Laura D. Fowler (laura@ucar.edu) / 2014-09-18. -! * renamed "tiedtke" with "cu_tiedtke". -! Laura D. Fowler (laura@ucar.edu) / 2016-03-22. -! * modified the sourcecode to accomodate the packages "cu_kain_fritsch_in" and "cu_ntiedtke_in". -! Laura D. Fowler (laura@ucar.edu) / 2016-03-24. -! * added the option bl_mynn for the calculation of the tendency for the cloud ice number concentration. -! Laura D. Fowler (laura@ucar.edu) / 2016-04-11. -! * in subroutine physics_get_tend_work, added the option cu_ntiedtke in the calculation of rucuten_Edge. -! Laura D. Fowler (laura@ucar.edu) / 2016-10-28. - - ! - ! Abstract interface for routine used to communicate halos of fields - ! in a named group - ! +! * cleaned-up subroutines physics_get_tend and physics_get_tend_work. +! Laura D. Fowler (laura@ucar.edu) / 2018-01-23. +! * removed the option bl_mynn_wrf390. +! Laura D. Fowler (laura@ucar.edu) / 2018-01-24. +! * added tendencies of cloud liquid water number concentration, and water-friendly and ice-friendly aerosol +! number concentrations due to PBL processes. +! Laura D. Fowler (laura@ucar.edu) / 2024-05-16. + +! +! Abstract interface for routine used to communicate halos of fields +! in a named group +! abstract interface subroutine halo_exchange_routine(domain, halo_group, ierr) @@ -69,205 +62,234 @@ end subroutine halo_exchange_routine !================================================================================================================= - subroutine physics_get_tend( block, mesh, state, diag, diag_physics, tend, tend_physics, configs, rk_step, dynamics_substep, & - tend_ru_physics, tend_rtheta_physics, tend_rho_physics, exchange_halo_group ) + subroutine physics_get_tend(block,mesh,state,diag,tend,tend_physics,configs,rk_step,dynamics_substep, & + tend_ru_physics,tend_rtheta_physics,tend_rho_physics,exchange_halo_group) !================================================================================================================= - - use mpas_atm_dimensions !input variables: type(block_type),intent(in),target:: block type(mpas_pool_type),intent(in):: mesh type(mpas_pool_type),intent(in):: state type(mpas_pool_type),intent(in):: configs - integer, intent(in):: rk_step - integer, intent(in):: dynamics_substep - procedure (halo_exchange_routine) :: exchange_halo_group + integer,intent(in):: rk_step + integer,intent(in):: dynamics_substep + procedure(halo_exchange_routine):: exchange_halo_group !inout variables: type(mpas_pool_type),intent(inout):: diag - type(mpas_pool_type),intent(inout):: diag_physics + type(mpas_pool_type),intent(inout):: tend type(mpas_pool_type),intent(inout):: tend_physics - real(kind=RKIND),dimension(:,:) :: tend_ru_physics, tend_rtheta_physics, tend_rho_physics + real(kind=RKIND),intent(inout),dimension(:,:):: tend_ru_physics,tend_rtheta_physics,tend_rho_physics !local variables: - character(len=StrKIND), pointer :: config_pbl_scheme, config_convection_scheme, & - config_radt_lw_scheme, config_radt_sw_scheme + character(len=StrKIND),pointer:: pbl_scheme, & + convection_scheme, & + microp_scheme, & + radt_lw_scheme, & + radt_sw_scheme integer:: i,iCell,k,n - integer,pointer:: index_qv, index_qc, index_qr, index_qi, index_qs, index_qg - integer,pointer:: index_ni + integer,pointer:: index_qv,index_qc,index_qr,index_qi,index_qs + integer,pointer:: index_nc,index_ni,index_nifa,index_nwfa +!-srf integer,pointer:: index_cnvcf, index_buoyx +!-srf integer,pointer:: nCells,nCellsSolve,nEdges,nEdgesSolve real(kind=RKIND),dimension(:,:),pointer:: mass ! time level 2 rho_zz real(kind=RKIND),dimension(:,:),pointer:: mass_edge ! diag rho_edge real(kind=RKIND),dimension(:,:),pointer:: theta_m ! time level 1 real(kind=RKIND),dimension(:,:,:),pointer:: scalars + real(kind=RKIND),dimension(:,:),pointer:: rthblten,rqvblten,rqcblten, & rqiblten,rqsblten,rublten,rvblten - real(kind=RKIND),dimension(:,:),pointer:: rniblten + real(kind=RKIND),dimension(:,:),pointer:: rncblten,rniblten,rnifablten,rnwfablten real(kind=RKIND),dimension(:,:),pointer:: rthcuten,rqvcuten,rqccuten, & rqrcuten,rqicuten,rqscuten, & rucuten,rvcuten real(kind=RKIND),dimension(:,:),pointer:: rthratenlw,rthratensw - + +!-srf real(kind=RKIND),dimension(:,:),pointer:: rcnvcfcuten,rbuoyxcuten +!-srf + real(kind=RKIND),dimension(:,:),pointer:: tend_u_phys !nick - real(kind=RKIND),dimension(:,:),pointer :: tend_theta,tend_theta_euler,tend_u + real(kind=RKIND),dimension(:,:,:),pointer:: tend_scalars - real(kind=RKIND):: coeff - real(kind=RKIND):: tem + + real(kind=RKIND),dimension(:,:),pointer:: rublten_Edge,rucuten_Edge - real(kind=RKIND),dimension(:,:),allocatable:: theta,tend_th + real(kind=RKIND),dimension(:,:),allocatable:: tend_th !================================================================================================================= - call mpas_pool_get_dimension(mesh, 'nCells', nCells) - call mpas_pool_get_dimension(mesh, 'nCellsSolve', nCellsSolve) - call mpas_pool_get_dimension(mesh, 'nEdges', nEdges) - call mpas_pool_get_dimension(mesh, 'nEdgesSolve', nEdgesSolve) - - call mpas_pool_get_config(configs, 'config_pbl_scheme', config_pbl_scheme) - call mpas_pool_get_config(configs, 'config_convection_scheme', config_convection_scheme) - call mpas_pool_get_config(configs, 'config_radt_lw_scheme', config_radt_lw_scheme) - call mpas_pool_get_config(configs, 'config_radt_sw_scheme', config_radt_sw_scheme) - - call mpas_pool_get_array(state, 'theta_m', theta_m, 1) - call mpas_pool_get_array(state, 'scalars', scalars, 1) - call mpas_pool_get_array(state, 'rho_zz', mass, 2) - call mpas_pool_get_array(diag , 'rho_edge', mass_edge) - - call mpas_pool_get_array(diag , 'tend_u_phys', tend_u_phys) !nick - - 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_ni', index_ni) + call mpas_pool_get_dimension(mesh,'nCells',nCells) + call mpas_pool_get_dimension(mesh,'nEdges',nEdges) + call mpas_pool_get_dimension(mesh,'nCellsSolve',nCellsSolve) + call mpas_pool_get_dimension(mesh,'nEdgesSolve',nEdgesSolve) + + call mpas_pool_get_config(configs,'config_convection_scheme',convection_scheme) + call mpas_pool_get_config(configs,'config_microp_scheme' ,microp_scheme ) + call mpas_pool_get_config(configs,'config_pbl_scheme' ,pbl_scheme ) + call mpas_pool_get_config(configs,'config_radt_lw_scheme' ,radt_lw_scheme ) + call mpas_pool_get_config(configs,'config_radt_sw_scheme' ,radt_sw_scheme ) + + call mpas_pool_get_array(state,'theta_m' ,theta_m,1) + call mpas_pool_get_array(state,'scalars' ,scalars,1) + call mpas_pool_get_array(state,'rho_zz' ,mass,2 ) + call mpas_pool_get_array(diag ,'rho_edge',mass_edge) + call mpas_pool_get_array(diag ,'tend_u_phys',tend_u_phys) + + 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_nc',index_nc) + call mpas_pool_get_dimension(state,'index_ni',index_ni) +!-srf call mpas_pool_get_dimension(state, 'index_cnvcf', index_cnvcf) call mpas_pool_get_dimension(state, 'index_buoyx', index_buoyx) - call mpas_pool_get_array(tend_physics, 'rublten', rublten) - call mpas_pool_get_array(tend_physics, 'rvblten', rvblten) - call mpas_pool_get_array(tend_physics, 'rublten_Edge', rublten_Edge) - call mpas_pool_get_array(tend_physics, 'rthblten', rthblten) - call mpas_pool_get_array(tend_physics, 'rqvblten', rqvblten) - call mpas_pool_get_array(tend_physics, 'rqcblten', rqcblten) - call mpas_pool_get_array(tend_physics, 'rqiblten', rqiblten) - call mpas_pool_get_array(tend_physics, 'rqsblten', rqsblten) - call mpas_pool_get_array(tend_physics, 'rniblten', rniblten) - - call mpas_pool_get_array(tend_physics, 'rucuten', rucuten) - call mpas_pool_get_array(tend_physics, 'rvcuten', rvcuten) - call mpas_pool_get_array(tend_physics, 'rucuten_Edge', rucuten_Edge) - call mpas_pool_get_array(tend_physics, 'rthcuten', rthcuten) - call mpas_pool_get_array(tend_physics, 'rqvcuten', rqvcuten) - call mpas_pool_get_array(tend_physics, 'rqccuten', rqccuten) - call mpas_pool_get_array(tend_physics, 'rqrcuten', rqrcuten) - call mpas_pool_get_array(tend_physics, 'rqicuten', rqicuten) - call mpas_pool_get_array(tend_physics, 'rqscuten', rqscuten) - - call mpas_pool_get_array(tend_physics, 'rthratenlw', rthratenlw) - call mpas_pool_get_array(tend_physics, 'rthratensw', rthratensw) - +!-srf + call mpas_pool_get_dimension(state,'index_nifa',index_nifa) + call mpas_pool_get_dimension(state,'index_nwfa',index_nwfa) + + call mpas_pool_get_array(tend_physics,'rublten',rublten) + call mpas_pool_get_array(tend_physics,'rvblten',rvblten) + call mpas_pool_get_array(tend_physics,'rthblten',rthblten) + call mpas_pool_get_array(tend_physics,'rqvblten',rqvblten) + call mpas_pool_get_array(tend_physics,'rqcblten',rqcblten) + call mpas_pool_get_array(tend_physics,'rqiblten',rqiblten) + call mpas_pool_get_array(tend_physics,'rqsblten',rqsblten) + call mpas_pool_get_array(tend_physics,'rncblten',rncblten) + call mpas_pool_get_array(tend_physics,'rniblten',rniblten) + call mpas_pool_get_array(tend_physics,'rnifablten',rnifablten) + call mpas_pool_get_array(tend_physics,'rnwfablten',rnwfablten) + call mpas_pool_get_array(tend_physics,'rublten_Edge',rublten_Edge) + + call mpas_pool_get_array(tend_physics,'rucuten',rucuten) + call mpas_pool_get_array(tend_physics,'rvcuten',rvcuten) + call mpas_pool_get_array(tend_physics,'rthcuten',rthcuten) + call mpas_pool_get_array(tend_physics,'rqvcuten',rqvcuten) + call mpas_pool_get_array(tend_physics,'rqccuten',rqccuten) + call mpas_pool_get_array(tend_physics,'rqrcuten',rqrcuten) + call mpas_pool_get_array(tend_physics,'rqicuten',rqicuten) + call mpas_pool_get_array(tend_physics,'rqscuten',rqscuten) + call mpas_pool_get_array(tend_physics,'rucuten_Edge',rucuten_Edge) + + call mpas_pool_get_array(tend_physics,'rthratenlw',rthratenlw) + call mpas_pool_get_array(tend_physics,'rthratensw',rthratensw) + +!-srf call mpas_pool_get_array(tend_physics, 'rcnvcfcuten', rcnvcfcuten) call mpas_pool_get_array(tend_physics, 'rbuoyxcuten', rbuoyxcuten) +!-srf + + + - call mpas_pool_get_array(tend,'u' , tend_u ) - call mpas_pool_get_array(tend,'theta_m' , tend_theta ) - call mpas_pool_get_array(tend,'theta_euler' ,tend_theta_euler) - call mpas_pool_get_array(tend,'scalars_tend',tend_scalars ) + call mpas_pool_get_array(tend,'scalars_tend',tend_scalars) !initialize the tendency for the potential temperature and all scalars due to PBL, convection, !and longwave and shortwave radiation: -! allocate(theta(nVertLevels,nCellsSolve) ) + allocate(tend_th(nVertLevels,nCellsSolve)) tend_th = 0._RKIND - tend_scalars(:,:,:) = 0._RKIND + tend_scalars(:,:,:) = 0._RKIND - tend_ru_physics(:,:) = 0._RKIND + tend_ru_physics(:,:) = 0._RKIND tend_rtheta_physics(:,:) = 0._RKIND - tend_rho_physics(:,:) = 0._RKIND ! NB: rho tendency is not currently supplied by physics, but this - ! field may be later filled with IAU or other tendencies - - ! - ! In case some variables are not allocated due to their associated packages, - ! we need to make their pointers associated here to avoid triggering run-time - ! checks when calling physics_get_tend_work - ! - if (.not. associated(rublten)) allocate(rublten(0,0) ) - if (.not. associated(rvblten)) allocate(rvblten(0,0) ) - if (.not. associated(rthblten)) allocate(rthblten(0,0)) - if (.not. associated(rqvblten)) allocate(rqvblten(0,0)) - if (.not. associated(rqcblten)) allocate(rqcblten(0,0)) - if (.not. associated(rqiblten)) allocate(rqiblten(0,0)) - if (.not. associated(rqsblten)) allocate(rqsblten(0,0)) - if (.not. associated(rniblten)) allocate(rniblten(0,0)) - if (.not. associated(rucuten)) allocate(rucuten(0,0) ) - if (.not. associated(rvcuten)) allocate(rvcuten(0,0) ) - if (.not. associated(rthcuten)) allocate(rthcuten(0,0)) - if (.not. associated(rqvcuten)) allocate(rqvcuten(0,0)) - if (.not. associated(rqccuten)) allocate(rqccuten(0,0)) - if (.not. associated(rqicuten)) allocate(rqicuten(0,0)) - if (.not. associated(rqrcuten)) allocate(rqrcuten(0,0)) - if (.not. associated(rqscuten)) allocate(rqscuten(0,0)) + tend_rho_physics(:,:) = 0._RKIND + + +! +! in case some variables are not allocated due to their associated packages. +! we need to make their pointers associated here to avoid triggering run-time. +! checks when calling physics_get_tend_work: +! + if(.not. associated(rucuten) ) allocate(rucuten(0,0) ) + if(.not. associated(rvcuten) ) allocate(rvcuten(0,0) ) + if(.not. associated(rthcuten)) allocate(rthcuten(0,0)) + if(.not. associated(rqvcuten)) allocate(rqvcuten(0,0)) + if(.not. associated(rqccuten)) allocate(rqccuten(0,0)) + if(.not. associated(rqicuten)) allocate(rqicuten(0,0)) + if(.not. associated(rqrcuten)) allocate(rqrcuten(0,0)) + if(.not. associated(rqscuten)) allocate(rqscuten(0,0)) + + if(.not. associated(rublten) ) allocate(rublten(0,0) ) + if(.not. associated(rvblten) ) allocate(rvblten(0,0) ) + if(.not. associated(rthblten)) allocate(rthblten(0,0)) + if(.not. associated(rqvblten)) allocate(rqvblten(0,0)) + if(.not. associated(rqcblten)) allocate(rqcblten(0,0)) + if(.not. associated(rqiblten)) allocate(rqiblten(0,0)) + if(.not. associated(rqsblten)) allocate(rqsblten(0,0)) + if(.not. associated(rncblten)) allocate(rncblten(0,0)) + if(.not. associated(rniblten)) allocate(rniblten(0,0)) + if(.not. associated(rnifablten)) allocate(rnifablten(0,0)) + if(.not. associated(rnwfablten)) allocate(rnwfablten(0,0)) !-srf if (.not. associated(rbuoyxcuten)) allocate(rbuoyxcuten(0,0)) if (.not. associated(rcnvcfcuten)) allocate(rcnvcfcuten(0,0)) !-srf - call physics_get_tend_work(block, mesh, nCells, nEdges, nCellsSolve, nEdgesSolve, & - rk_step, dynamics_substep, & - config_pbl_scheme, config_convection_scheme, config_radt_lw_scheme, config_radt_sw_scheme, & - index_qv, index_qc, index_qr, index_qi, index_qs, index_ni, & - rublten, rvblten, mass_edge, rublten_Edge, & - tend_ru_physics, & - rucuten, rvcuten, rucuten_Edge, & - tend_th, tend_scalars, mass, rthblten, rqvblten, rqcblten, rqiblten, rqsblten, rniblten, & - rthcuten, rqvcuten, rqccuten, rqrcuten, rqicuten, rqscuten, & - rthratenlw, rthratensw, & - tend_u_phys, & - theta_m, scalars, & - tend_rtheta_physics, & - tend_theta_euler, & - exchange_halo_group, & - index_cnvcf,index_buoyx,rbuoyxcuten,rcnvcfcuten) - - ! - ! Clean up any pointers that were allocated with zero size before the call to - ! physics_get_tend_work - ! - if (size(rublten) == 0) deallocate(rublten ) - if (size(rvblten) == 0) deallocate(rvblten ) - if (size(rthblten) == 0) deallocate(rthblten) - if (size(rqvblten) == 0) deallocate(rqvblten) - if (size(rqcblten) == 0) deallocate(rqcblten) - if (size(rqiblten) == 0) deallocate(rqiblten) - if (size(rqsblten) == 0) deallocate(rqsblten) - if (size(rniblten) == 0) deallocate(rniblten) - if (size(rucuten) == 0) deallocate(rucuten ) - if (size(rvcuten) == 0) deallocate(rvcuten ) - if (size(rthcuten) == 0) deallocate(rthcuten) - if (size(rqvcuten) == 0) deallocate(rqvcuten) - if (size(rqccuten) == 0) deallocate(rqccuten) - if (size(rqicuten) == 0) deallocate(rqicuten) - if (size(rqrcuten) == 0) deallocate(rqrcuten) - if (size(rqscuten) == 0) deallocate(rqscuten) + call physics_get_tend_work( & + block,mesh,nCells,nEdges,nCellsSolve,nEdgesSolve,rk_step,dynamics_substep, & + pbl_scheme,convection_scheme,microp_scheme,radt_lw_scheme,radt_sw_scheme, & + index_qv,index_qc,index_qr,index_qi,index_qs, & + index_nc,index_ni,index_nifa,index_nwfa, & + mass,mass_edge,theta_m,scalars, & + rublten,rvblten,rthblten,rqvblten,rqcblten,rqiblten,rqsblten, & + rncblten,rniblten,rnifablten,rnwfablten, & + rucuten,rvcuten,rthcuten,rqvcuten,rqccuten,rqrcuten,rqicuten,rqscuten, & + rthratenlw,rthratensw,rublten_Edge,rucuten_Edge, & + tend_th,tend_rtheta_physics,tend_scalars,tend_ru_physics,tend_u_phys, & + exchange_halo_group, & + + +!-srf + index_cnvcf,index_buoyx,rbuoyxcuten,rcnvcfcuten) +!-srf + + +! +! Clean up any pointers that were allocated with zero size before the call to +! physics_get_tend_work: +! + if(size(rucuten) == 0 ) deallocate(rucuten ) + if(size(rvcuten) == 0 ) deallocate(rvcuten ) + if(size(rthcuten) == 0) deallocate(rthcuten) + if(size(rqvcuten) == 0) deallocate(rqvcuten) + if(size(rqccuten) == 0) deallocate(rqccuten) + if(size(rqicuten) == 0) deallocate(rqicuten) + if(size(rqrcuten) == 0) deallocate(rqrcuten) + if(size(rqscuten) == 0) deallocate(rqscuten) + + if(size(rublten) == 0 ) deallocate(rublten ) + if(size(rvblten) == 0 ) deallocate(rvblten ) + if(size(rthblten) == 0) deallocate(rthblten) + if(size(rqvblten) == 0) deallocate(rqvblten) + if(size(rqcblten) == 0) deallocate(rqcblten) + if(size(rqiblten) == 0) deallocate(rqiblten) + if(size(rqsblten) == 0) deallocate(rqsblten) + if(size(rncblten) == 0) deallocate(rncblten) + if(size(rniblten) == 0) deallocate(rniblten) + + if(size(rnifablten) == 0) deallocate(rnifablten) + if(size(rnwfablten) == 0) deallocate(rnwfablten) !-srf if (size(rbuoyxcuten) == 0) deallocate(rbuoyxcuten) if (size(rcnvcfcuten) == 0) deallocate(rcnvcfcuten) !-srf -! deallocate(theta) + deallocate(tend_th) ! if(rk_step .eq. 3) then @@ -287,151 +309,185 @@ subroutine physics_get_tend( block, mesh, state, diag, diag_physics, tend, tend_ end subroutine physics_get_tend - !================================================================================================== - subroutine physics_get_tend_work(block, mesh, nCells, nEdges, nCellsSolve, nEdgesSolve, & - rk_step, dynamics_substep, & - config_pbl_scheme, config_convection_scheme, config_radt_lw_scheme, config_radt_sw_scheme, & - index_qv, index_qc, index_qr, index_qi, index_qs, index_ni, & - rublten, rvblten, mass_edge, rublten_Edge, tend_u, & - rucuten, rvcuten, rucuten_Edge, & - tend_th, tend_scalars, mass, rthblten, rqvblten, rqcblten, rqiblten, rqsblten, rniblten, & - rthcuten, rqvcuten, rqccuten, rqrcuten, rqicuten, rqscuten, & - rthratenlw, rthratensw, & - tend_u_phys, & - theta_m, scalars, tend_theta, tend_theta_euler, & - exchange_halo_group, & - index_cnvcf,index_buoyx,rbuoyxcuten,rcnvcfcuten) -!================================================================================================== - - use mpas_atm_dimensions - - implicit none - - type(block_type), intent(in) :: block - type(mpas_pool_type), intent(in) :: mesh - integer, intent(in) :: nCells, nEdges, nCellsSolve, nEdgesSolve - integer, intent(in) :: rk_step, dynamics_substep - character(len=StrKIND), intent(in) :: config_pbl_scheme - character(len=StrKIND), intent(in) :: config_convection_scheme - character(len=StrKIND), intent(in) :: config_radt_lw_scheme - character(len=StrKIND), intent(in) :: config_radt_sw_scheme - integer, intent(in) :: index_qv, index_qc, index_qr, index_qi, index_qs, index_ni +!================================================================================================================= + subroutine physics_get_tend_work( & + block,mesh,nCells,nEdges,nCellsSolve,nEdgesSolve,rk_step,dynamics_substep, & + pbl_scheme,convection_scheme,microp_scheme,radt_lw_scheme,radt_sw_scheme, & + index_qv,index_qc,index_qr,index_qi,index_qs, & + index_nc,index_ni,index_nifa,index_nwfa, & + mass,mass_edge,theta_m,scalars, & + rublten,rvblten,rthblten,rqvblten,rqcblten,rqiblten,rqsblten, & + rncblten,rniblten,rnifablten,rnwfablten, & + rucuten,rvcuten,rthcuten,rqvcuten,rqccuten,rqrcuten,rqicuten,rqscuten, & + rthratenlw,rthratensw,rublten_Edge,rucuten_Edge, & + tend_th,tend_theta,tend_scalars,tend_u,tend_u_phys, & + exchange_halo_group, & +!-srf + index_cnvcf,index_buoyx,rbuoyxcuten,rcnvcfcuten) +!-srf + +!================================================================================================================= + +!input arguments: + + procedure(halo_exchange_routine):: exchange_halo_group + + + + type(block_type),intent(in) :: block + type(mpas_pool_type),intent(in):: mesh + + character(len=StrKIND),intent(in):: convection_scheme + character(len=StrKIND),intent(in):: microp_scheme + character(len=StrKIND),intent(in):: pbl_scheme + character(len=StrKIND),intent(in):: radt_lw_scheme + character(len=StrKIND),intent(in):: radt_sw_scheme + + integer,intent(in):: nCells,nEdges,nCellsSolve,nEdgesSolve + integer,intent(in):: rk_step,dynamics_substep + integer,intent(in):: index_qv,index_qc,index_qr,index_qi,index_qs + integer,intent(in):: index_nc,index_ni,index_nifa,index_nwfa +!-srf integer, intent(in) :: index_cnvcf,index_buoyx - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(in) :: rublten - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(in) :: rvblten - real (kind=RKIND), dimension(nVertLevels,nEdges+1), intent(in) :: mass_edge - real (kind=RKIND), dimension(nVertLevels,nEdges+1), intent(inout) :: rublten_Edge - real (kind=RKIND), dimension(nVertLevels,nEdges+1), intent(inout) :: tend_u - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(in) :: rucuten - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(in) :: rvcuten - real (kind=RKIND), dimension(nVertLevels,nEdges+1), intent(inout) :: rucuten_Edge - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(inout) :: tend_th - real (kind=RKIND), dimension(num_scalars,nVertLevels,nCells+1), intent(inout) :: tend_scalars - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(in) :: mass - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(in) :: rthblten - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(in) :: rqvblten - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(in) :: rqcblten - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(in) :: rqiblten - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(in) :: rqsblten - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(in) :: rniblten - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(in) :: rthcuten - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(in) :: rqvcuten - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(in) :: rqccuten - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(in) :: rqrcuten - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(in) :: rqicuten - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(in) :: rqscuten - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(in) :: rthratenlw - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(in) :: rthratensw - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(in) :: rbuoyxcuten - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(in) :: rcnvcfcuten - real (kind=RKIND), dimension(nVertLevels,nEdges+1), intent(inout) :: tend_u_phys - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(in) :: theta_m - real (kind=RKIND), dimension(num_scalars,nVertLevels,nCells+1), intent(in) :: scalars - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(inout) :: tend_theta - real (kind=RKIND), dimension(nVertLevels,nCells+1), intent(in) :: tend_theta_euler - procedure (halo_exchange_routine) :: exchange_halo_group - - integer :: i, k , mynum - real (kind=RKIND) :: coeff - - !add coupled tendencies due to PBL processes: - if (config_pbl_scheme .ne. 'off') then - if (rk_step == 1 .and. dynamics_substep == 1) then - call exchange_halo_group(block % domain, 'physics:blten') - call tend_toEdges(block,mesh,rublten,rvblten,rublten_Edge) +!-srf + + real(kind=RKIND),intent(in),dimension(nVertLevels,nCells+1):: mass + real(kind=RKIND),intent(in),dimension(nVertLevels,nEdges+1):: mass_edge + real(kind=RKIND),intent(in),dimension(nVertLevels,nCells+1):: theta_m + real(kind=RKIND),intent(in),dimension(num_scalars,nVertLevels,nCells+1):: scalars + + real(kind=RKIND),intent(in),dimension(nVertLevels,nCells+1):: rublten + real(kind=RKIND),intent(in),dimension(nVertLevels,nCells+1):: rvblten + real(kind=RKIND),intent(in),dimension(nVertLevels,nCells+1):: rthblten + real(kind=RKIND),intent(in),dimension(nVertLevels,nCells+1):: rqvblten + real(kind=RKIND),intent(in),dimension(nVertLevels,nCells+1):: rqcblten + real(kind=RKIND),intent(in),dimension(nVertLevels,nCells+1):: rqiblten + real(kind=RKIND),intent(in),dimension(nVertLevels,nCells+1):: rqsblten + real(kind=RKIND),intent(in),dimension(nVertLevels,nCells+1):: rncblten + real(kind=RKIND),intent(in),dimension(nVertLevels,nCells+1):: rniblten + real(kind=RKIND),intent(in),dimension(nVertLevels,nCells+1):: rnifablten + real(kind=RKIND),intent(in),dimension(nVertLevels,nCells+1):: rnwfablten + + real(kind=RKIND),intent(in),dimension(nVertLevels,nCells+1):: rucuten + real(kind=RKIND),intent(in),dimension(nVertLevels,nCells+1):: rvcuten + real(kind=RKIND),intent(in),dimension(nVertLevels,nCells+1):: rthcuten + real(kind=RKIND),intent(in),dimension(nVertLevels,nCells+1):: rqvcuten + real(kind=RKIND),intent(in),dimension(nVertLevels,nCells+1):: rqccuten + real(kind=RKIND),intent(in),dimension(nVertLevels,nCells+1):: rqrcuten + real(kind=RKIND),intent(in),dimension(nVertLevels,nCells+1):: rqicuten + real(kind=RKIND),intent(in),dimension(nVertLevels,nCells+1):: rqscuten + + real(kind=RKIND),intent(in),dimension(nVertLevels,nCells+1):: rthratenlw + real(kind=RKIND),intent(in),dimension(nVertLevels,nCells+1):: rthratensw +!-srf + real(kind=RKIND),intent(in),dimension(nVertLevels,nCells+1):: rbuoyxcuten + real(kind=RKIND),intent(in),dimension(nVertLevels,nCells+1):: rcnvcfcuten +!-srf + +!inout arguments: + real(kind=RKIND),intent(inout),dimension(nVertLevels,nEdges+1):: rublten_Edge + real(kind=RKIND),intent(inout),dimension(nVertLevels,nEdges+1):: rucuten_Edge + real(kind=RKIND),intent(inout),dimension(nVertLevels,nEdges+1):: tend_u + real(kind=RKIND),intent(inout),dimension(nVertLevels,nEdges+1):: tend_u_phys + + real(kind=RKIND),intent(inout),dimension(nVertLevels,nCells+1):: tend_th + real(kind=RKIND),intent(inout),dimension(nVertLevels,nCells+1):: tend_theta + real(kind=RKIND),intent(inout),dimension(num_scalars,nVertLevels,nCells+1):: tend_scalars + +!local variables: + integer:: i,k + real(kind=RKIND):: coeff + +!----------------------------------------------------------------------------------------------------------------- + +!add coupled tendencies due to PBL processes: + if(pbl_scheme .ne. 'off') then + if(rk_step == 1 .and. dynamics_substep == 1) then + call exchange_halo_group(block%domain,'physics:blten') + call tend_toEdges(block,mesh,rublten,rvblten,rublten_Edge) !MGD for PV budget? should a similar line be in the cumulus section below? - tend_u_phys(1:nVertLevels,1:nEdges) = rublten_Edge(1:nVertLevels,1:nEdges) - end if + tend_u_phys(1:nVertLevels,1:nEdges) = rublten_Edge(1:nVertLevels,1:nEdges) + end if - do i = 1, nEdgesSolve - do k = 1, nVertLevels - tend_u(k,i)=tend_u(k,i)+rublten_Edge(k,i)*mass_edge(k,i) - enddo - enddo + do i = 1, nEdgesSolve + do k = 1, nVertLevels + tend_u(k,i)=tend_u(k,i)+rublten_Edge(k,i)*mass_edge(k,i) + enddo + enddo - do i = 1, nCellsSolve - do k = 1, nVertLevels - tend_th(k,i) = tend_th(k,i) + rthblten(k,i)*mass(k,i) - tend_scalars(index_qv,k,i) = tend_scalars(index_qv,k,i) + rqvblten(k,i)*mass(k,i) - tend_scalars(index_qc,k,i) = tend_scalars(index_qc,k,i) + rqcblten(k,i)*mass(k,i) - tend_scalars(index_qi,k,i) = tend_scalars(index_qi,k,i) + rqiblten(k,i)*mass(k,i) - enddo - enddo + do i = 1, nCellsSolve + do k = 1, nVertLevels + tend_th(k,i) = tend_th(k,i) + rthblten(k,i)*mass(k,i) + tend_scalars(index_qv,k,i) = tend_scalars(index_qv,k,i) + rqvblten(k,i)*mass(k,i) + tend_scalars(index_qc,k,i) = tend_scalars(index_qc,k,i) + rqcblten(k,i)*mass(k,i) + tend_scalars(index_qi,k,i) = tend_scalars(index_qi,k,i) + rqiblten(k,i)*mass(k,i) + enddo + enddo + + pbl_select: select case(trim(pbl_scheme)) - pbl_select: select case (trim(config_pbl_scheme)) + case('bl_mynn') - case("bl_mynn") + do i = 1, nCellsSolve + do k = 1, nVertLevels + tend_scalars(index_qs,k,i) = tend_scalars(index_qs,k,i) + rqsblten(k,i)*mass(k,i) + tend_scalars(index_ni,k,i) = tend_scalars(index_ni,k,i) + rniblten(k,i)*mass(k,i) + enddo + enddo + if(trim(microp_scheme) == 'mp_thompson_aerosols') then do i = 1, nCellsSolve do k = 1, nVertLevels - tend_scalars(index_qs,k,i) = tend_scalars(index_qs,k,i) + rqsblten(k,i)*mass(k,i) - tend_scalars(index_ni,k,i) = tend_scalars(index_ni,k,i) + rniblten(k,i)*mass(k,i) + tend_scalars(index_nc,k,i) = tend_scalars(index_nc,k,i) + rncblten(k,i)*mass(k,i) + tend_scalars(index_nifa,k,i) = tend_scalars(index_nifa,k,i) + rnifablten(k,i)*mass(k,i) + tend_scalars(index_nwfa,k,i) = tend_scalars(index_nwfa,k,i) + rnwfablten(k,i)*mass(k,i) enddo enddo - - case default - - end select pbl_select - endif + endif - !add coupled tendencies due to convection: - if (config_convection_scheme .ne. 'off') then + case default + end select pbl_select + endif - do i = 1, nCellsSolve - do k = 1, nVertLevels - tend_th(k,i) = tend_th(k,i) + rthcuten(k,i)*mass(k,i) - tend_scalars(index_qv,k,i) = tend_scalars(index_qv,k,i) + rqvcuten(k,i)*mass(k,i) - tend_scalars(index_qc,k,i) = tend_scalars(index_qc,k,i) + rqccuten(k,i)*mass(k,i) - tend_scalars(index_qi,k,i) = tend_scalars(index_qi,k,i) + rqicuten(k,i)*mass(k,i) - enddo - enddo - convection_select: select case(config_convection_scheme) +!add coupled tendencies due to convection: + if(convection_scheme .ne. 'off') then - case('cu_kain_fritsch') - do i = 1, nCellsSolve - do k = 1, nVertLevels - tend_scalars(index_qr,k,i) = tend_scalars(index_qr,k,i) + rqrcuten(k,i)*mass(k,i) - tend_scalars(index_qs,k,i) = tend_scalars(index_qs,k,i) + rqscuten(k,i)*mass(k,i) - enddo - enddo - - case('cu_tiedtke','cu_ntiedtke') - if (rk_step == 1 .and. dynamics_substep == 1) then - call exchange_halo_group(block % domain, 'physics:cuten') - call tend_toEdges(block,mesh,rucuten,rvcuten,rucuten_Edge) - - tend_u_phys(1:nVertLevels,1:nEdges) = tend_u_phys(1:nVertLevels,1:nEdges) & - + rucuten_Edge(1:nVertLevels,1:nEdges) - end if - do i = 1, nEdgesSolve - do k = 1, nVertLevels - tend_u(k,i)=tend_u(k,i)+rucuten_Edge(k,i)*mass_edge(k,i) - enddo - enddo + do i = 1, nCellsSolve + do k = 1, nVertLevels + tend_th(k,i) = tend_th(k,i) + rthcuten(k,i)*mass(k,i) + tend_scalars(index_qv,k,i) = tend_scalars(index_qv,k,i) + rqvcuten(k,i)*mass(k,i) + tend_scalars(index_qc,k,i) = tend_scalars(index_qc,k,i) + rqccuten(k,i)*mass(k,i) + tend_scalars(index_qi,k,i) = tend_scalars(index_qi,k,i) + rqicuten(k,i)*mass(k,i) + enddo + enddo - case('cu_gf_monan') + cu_select: select case(trim(convection_scheme)) + + case('cu_kain_fritsch') + do i = 1, nCellsSolve + do k = 1, nVertLevels + tend_scalars(index_qr,k,i) = tend_scalars(index_qr,k,i) + rqrcuten(k,i)*mass(k,i) + tend_scalars(index_qs,k,i) = tend_scalars(index_qs,k,i) + rqscuten(k,i)*mass(k,i) + enddo + enddo + + case('cu_tiedtke','cu_ntiedtke') + if(rk_step == 1 .and. dynamics_substep == 1) then + call exchange_halo_group(block%domain,'physics:cuten') + call tend_toEdges(block,mesh,rucuten,rvcuten,rucuten_Edge) + + tend_u_phys(1:nVertLevels,1:nEdges) = tend_u_phys(1:nVertLevels,1:nEdges) & + + rucuten_Edge(1:nVertLevels,1:nEdges) + endif + do i = 1, nEdgesSolve + do k = 1, nVertLevels + tend_u(k,i)=tend_u(k,i)+rucuten_Edge(k,i)*mass_edge(k,i) + enddo + enddo + + case('cu_gf_monan') if (rk_step == 1 .and. dynamics_substep == 1) then call exchange_halo_group(block % domain, 'physics:cuten') call tend_toEdges(block,mesh,rucuten,rvcuten,rucuten_Edge) @@ -454,37 +510,41 @@ subroutine physics_get_tend_work(block, mesh, nCells, nEdges, nCellsSolve, nEdge ! enddo !srf--------------------------------------------------------------------------------------------------------- - case default - end select convection_select - endif - - !add coupled tendencies due to longwave radiation: - if (config_radt_lw_scheme .ne. 'off') then - do i = 1, nCellsSolve - do k = 1, nVertLevels - tend_th(k,i) = tend_th(k,i) + rthratenlw(k,i)*mass(k,i) - enddo - enddo - endif - - !add coupled tendencies due to shortwave radiation: - if (config_radt_sw_scheme .ne. 'off') then - do i = 1, nCellsSolve - do k = 1, nVertLevels - tend_th(k,i) = tend_th(k,i) + rthratensw(k,i)*mass(k,i) - enddo - enddo - endif - - !if non-hydrostatic core, convert the tendency for the potential temperature to a - !tendency for the modified potential temperature: + case default + end select cu_select + endif + + +!add coupled tendencies due to longwave radiation: + if(radt_lw_scheme .ne. 'off') then do i = 1, nCellsSolve do k = 1, nVertLevels - coeff = (1. + R_v/R_d * scalars(index_qv,k,i)) - tend_th(k,i) = coeff * tend_th(k,i) + R_v/R_d * theta_m(k,i) * tend_scalars(index_qv,k,i) / coeff - tend_theta(k,i) = tend_theta(k,i) + tend_th(k,i) + tend_th(k,i) = tend_th(k,i) + rthratenlw(k,i)*mass(k,i) enddo enddo + endif + + +!add coupled tendencies due to shortwave radiation: + if(radt_sw_scheme .ne. 'off') then + do i = 1, nCellsSolve + do k = 1, nVertLevels + tend_th(k,i) = tend_th(k,i) + rthratensw(k,i)*mass(k,i) + enddo + enddo + endif + + +!convert the tendency for the potential temperature to tendency for the modified potential temperature: + + do i = 1, nCellsSolve + do k = 1, nVertLevels + coeff = (1. + R_v/R_d * scalars(index_qv,k,i)) + tend_th(k,i) = coeff * tend_th(k,i) + R_v/R_d * theta_m(k,i) * tend_scalars(index_qv,k,i) / coeff + tend_theta(k,i) = tend_theta(k,i) + tend_th(k,i) + enddo + enddo + end subroutine physics_get_tend_work @@ -508,20 +568,19 @@ subroutine tend_toEdges(block,mesh,Ux_tend,Uy_tend,U_tend) integer,pointer:: nCells,nCellsSolve,nEdges integer,dimension(:,:),pointer:: cellsOnEdge - real(kind=RKIND), dimension(:,:), pointer :: east, north, edgeNormalVectors - + real(kind=RKIND),dimension(:,:),pointer:: east,north,edgeNormalVectors !----------------------------------------------------------------------------------------------------------------- - call mpas_pool_get_dimension(mesh, 'nCells', nCells) - call mpas_pool_get_dimension(mesh, 'nCellsSolve', nCellsSolve) - call mpas_pool_get_dimension(mesh, 'nEdges', nEdges) + call mpas_pool_get_dimension(mesh,'nCells',nCells) + call mpas_pool_get_dimension(mesh,'nCellsSolve',nCellsSolve) + call mpas_pool_get_dimension(mesh,'nEdges',nEdges) - call mpas_pool_get_array(mesh, 'east', east) - call mpas_pool_get_array(mesh, 'north', north) - call mpas_pool_get_array(mesh, 'edgeNormalVectors', edgeNormalVectors) + call mpas_pool_get_array(mesh,'east',east) + call mpas_pool_get_array(mesh,'north',north) + call mpas_pool_get_array(mesh,'edgeNormalVectors',edgeNormalVectors) - call mpas_pool_get_array(mesh, 'cellsOnEdge', cellsOnEdge) + call mpas_pool_get_array(mesh,'cellsOnEdge',cellsOnEdge) do iEdge = 1, nEdges cell1 = cellsOnEdge(1,iEdge) @@ -530,14 +589,14 @@ subroutine tend_toEdges(block,mesh,Ux_tend,Uy_tend,U_tend) U_tend(:,iEdge) = Ux_tend(:,cell1) * 0.5 * (edgeNormalVectors(1,iEdge) * east(1,cell1) & + edgeNormalVectors(2,iEdge) * east(2,cell1) & + edgeNormalVectors(3,iEdge) * east(3,cell1)) & - + Uy_tend(:,cell1) * 0.5 * (edgeNormalVectors(1,iEdge) * north(1,cell1) & - + edgeNormalVectors(2,iEdge) * north(2,cell1) & - + edgeNormalVectors(3,iEdge) * north(3,cell1)) & + + Uy_tend(:,cell1) * 0.5 * (edgeNormalVectors(1,iEdge) * north(1,cell1) & + + edgeNormalVectors(2,iEdge) * north(2,cell1) & + + edgeNormalVectors(3,iEdge) * north(3,cell1)) & + Ux_tend(:,cell2) * 0.5 * (edgeNormalVectors(1,iEdge) * east(1,cell2) & + edgeNormalVectors(2,iEdge) * east(2,cell2) & + edgeNormalVectors(3,iEdge) * east(3,cell2)) & - + Uy_tend(:,cell2) * 0.5 * (edgeNormalVectors(1,iEdge) * north(1,cell2) & - + edgeNormalVectors(2,iEdge) * north(2,cell2) & + + Uy_tend(:,cell2) * 0.5 * (edgeNormalVectors(1,iEdge) * north(1,cell2) & + + edgeNormalVectors(2,iEdge) * north(2,cell2) & + edgeNormalVectors(3,iEdge) * north(3,cell2)) end do diff --git a/src/core_atmosphere/physics/mpas_atmphys_vars.F b/src/core_atmosphere/physics/mpas_atmphys_vars.F index 744992d62..3b997ccc8 100644 --- a/src/core_atmosphere/physics/mpas_atmphys_vars.F +++ b/src/core_atmosphere/physics/mpas_atmphys_vars.F @@ -8,6 +8,8 @@ !================================================================================================================= module mpas_atmphys_vars use mpas_kind_types + + use NoahmpIOVarType implicit none public @@ -204,6 +206,7 @@ module mpas_atmphys_vars qg_p !graupel mixing ratio [kg/kg] real(kind=RKIND),dimension(:,:,:),allocatable:: & + nc_p, &!cloud water droplet number concentration [#/kg] ni_p, &!cloud ice crystal number concentration [#/kg] nr_p !rain drop number concentration [#/kg] @@ -247,7 +250,7 @@ module mpas_atmphys_vars f_qc, &!parameter set to true to include the cloud water mixing ratio. f_qr, &!parameter set to true to include the rain mixing ratio. f_qi, &!parameter set to true to include the cloud ice mixing ratio. - f_qs, &!parameter set to true to include the snow minxg ratio. + f_qs, &!parameter set to true to include the snow mixing ratio. f_qg, &!parameter set to true to include the graupel mixing ratio. f_qoz !parameter set to true to include the ozone mixing ratio. @@ -277,9 +280,6 @@ module mpas_atmphys_vars has_reqi, &! has_reqs - real(kind=RKIND),dimension(:,:),allocatable:: & - ntc_p, &! - muc_p ! real(kind=RKIND),dimension(:,:,:),allocatable:: & rainprod_p, &! evapprod_p, &! @@ -288,6 +288,17 @@ module mpas_atmphys_vars resnow_p, &! refl10cm_p ! +!... for Thompson cloud microphysics parameterization, including aerosol-aware option: + real(kind=RKIND),dimension(:,:),allocatable:: & + ntc_p, &! + muc_p, &! + nifa2d_p, &!surface emission of "ice-friendly" aerosols [#/kg-1/s] + nwfa2d_p !surface emission of "water-friendly" aerosols [#/kg-1/s] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + nifa_p, &!"ice-friendly" number concentration [#/kg] + nwfa_p !"water-friendly" number concentration [#/kg] + !================================================================================================================= !... variables and arrays related to parameterization of convection: !================================================================================================================= @@ -487,7 +498,10 @@ module mpas_atmphys_vars real(kind=RKIND),dimension(:,:,:),allocatable:: & rqsblten_p, &!tendency of snow mixing ratio due to PBL processes. - rniblten_p !tendency of cloud ice number concentration due to PBL processes. + rncblten_p, &!tendency of cloud liquid water number concentration due to PBL processes. + rniblten_p, &!tendency of cloud ice number concentration due to PBL processes. + rnifablten_p, &!tendency of ice-friendly aerosol number concentration due to PBL processes. + rnwfablten_p !tendency of water-friendly aerosol number concentration due to PBL processes. real(kind=RKIND),dimension(:,:,:),allocatable:: & pattern_spp_pbl !stochastic forcing for the MYMM PBL and surface layer schemes. @@ -523,6 +537,65 @@ module mpas_atmphys_vars dtaux3d_p, &!gravity wave drag over orography u-stress [m s-1] dtauy3d_p !gravity wave drag over orography u-stress [m s-1] +!... variables for UGWP orographic gravity wave drag: + + real(kind=RKIND),dimension(:,:),allocatable:: & + var2dls_p, &!orographic variance (meso-scale orographic variation) [m] + conls_p, &!orographic convexity (meso-scale orographic variation) [-] + oa1ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] + oa2ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] + oa3ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] + oa4ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] + ol1ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] + ol2ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] + ol3ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] + ol4ls_p, &!orographic direction asymmetry function (meso-scale orographic variation) [-] + var2dss_p, &!orographic variance (small-scale orographic variation) [m] + conss_p, &!orographic convexity (small-scale orographic variation) [-] + oa1ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] + oa2ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] + oa3ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] + oa4ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] + ol1ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] + ol2ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] + ol3ss_p, &!orographic direction asymmetry function (small-scale orographic variation) [-] + ol4ss_p !orographic direction asymmetry function (small-scale orographic variation) [-] + + real(kind=RKIND),dimension(:,:),allocatable:: & + dusfc_ls_p, &!vertically-integrated mesoscale orog gravity wave drag u-stress [Pa] + dvsfc_ls_p, &!vertically-integrated mesoscale orog gravity wave drag v-stress [Pa] + dusfc_bl_p, &!vertically-integrated orog blocking drag u-stress [Pa] + dvsfc_bl_p, &!vertically-integrated orog blocking drag v-stress [Pa] + dusfc_ss_p, &!vertically-integrated small-scale orog gravity wave drag u-stres [Pa] + dvsfc_ss_p, &!vertically-integrated small-scale orog gravity wave drag v-stres [Pa] + dusfc_fd_p, &!vertically-integrated turb orog form drag u-stress [Pa] + dvsfc_fd_p !vertically-integrated turb orog form drag v-stress [Pa] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + dtaux3d_ls_p, &!mesoscale orog gravity wave drag u-tendency [m s-2] + dtauy3d_ls_p, &!mesoscale orog gravity wave drag v-tendency [m s-2] + dtaux3d_bl_p, &!orog blocking drag u-tendency u-tendency [m s-2] + dtauy3d_bl_p, &!orog blocking drag u-tendency v-tendency [m s-2] + dtaux3d_ss_p, &!small-scale orog gravity wave drag u-tendency [m s-2] + dtauy3d_ss_p, &!small-scale orog gravity wave drag v-tendency [m s-2] + dtaux3d_fd_p, &!turb orog form drag u-tendency [m s-2] + dtauy3d_fd_p !turb orog form drag u-tendency [m s-2] + +!... variables for UGWP non-stationary gravity wave (NGW) drag: + + integer,dimension(:,:),allocatable:: & + jindx1_tau_p, &!lower latitude index of NGW momentum flux for interpolation [-] + jindx2_tau_p !upper latitude index of NGW momentum flux for interpolation [-] + + real(kind=RKIND),dimension(:,:),allocatable:: & + ddy_j1tau_p, &!latitude interpolation weight complement for NGW momentum flux [-] + ddy_j2tau_p !latitude interpolation weight for NGW momentum flux [-] + + real(kind=RKIND),dimension(:,:,:),allocatable:: & + dudt_ngw_p, &!u-momentum tendency due to non-stationary gravity wave drag [m s-2] + dvdt_ngw_p, &!v-momentum tendency due to non-stationary gravity wave drag [m s-2] + dtdt_ngw_p !temperature tendency due to non-stationary gravity wave drag [K s-1] + !================================================================================================================= !... variables and arrays related to parameterization of surface layer: !================================================================================================================= @@ -636,6 +709,35 @@ module mpas_atmphys_vars snowsi_p, &!snow depth over seaice [m] icedepth_p !seaice thickness [m] +!================================================================================================================= +!... variables and arrays related to the calculation of the optical properties of aerosols: to date, the only kind +! of aerosols included in MPAS are the "water-friendly" and "ice-friendly" aerosols used in the Thompson cloud +! cloud microphysics scheme. +!================================================================================================================= + + integer,parameter:: taer_aod550_opt = 2!input option for nwfa, nifa optical depth at 500 nm. + integer,parameter:: taer_angexp_opt = 3!input option for nwfa, nifa aerosol Angstrom exponent. + integer,parameter:: taer_ssa_opt = 3!input option for nwfa, nifa aerosol single-scattering albedo. + integer,parameter:: taer_asy_opt = 3!input option for nwfa, nifa aerosol asymmetry factor. + + integer:: aer_opt !=[0,3] : 0 for no aerosols, 3 for "water-" and "ice-friendly" aerosols. + integer,dimension(:,:),allocatable:: & + taer_type_p !=[1,2,3]: 1 for rural, 2 is urban and 3 is maritime in WRF. In MPAS, + !aer_type is initialized as a function of landmask (=1 over land; =2 over + !oceans. + + real(kind=RKIND),parameter:: aer_aod550_val = 0.12 + real(kind=RKIND),parameter:: aer_angexp_val = 1.3 + real(kind=RKIND),parameter:: aer_ssa_val = 0.85 + real(kind=RKIND),parameter:: aer_asy_val = 0.9 + + real(kind=RKIND),dimension(:,:),allocatable :: taod5502d_p!total aerosol optical depth at 550 nm [-] + real(kind=RKIND),dimension(:,:,:),allocatable:: taod5503d_p!aerosol optical depth at 550 nm [-] + + real(kind=RKIND),dimension(:,:,:,:),allocatable:: tauaer_p !aerosol optical depth in RRTMG SW [-] + real(kind=RKIND),dimension(:,:,:,:),allocatable:: ssaaer_p !aerosol single scatterin albedo in RRTMG SW [-] + real(kind=RKIND),dimension(:,:,:,:),allocatable:: asyaer_p !aerosol asymmetry factor in RRTMG SW [-] + !================================================================================================================= !... variables and arrays related to parameterization of short-wave radiation: !================================================================================================================= @@ -762,6 +864,7 @@ module mpas_atmphys_vars qirad_p, &!cloud ice mixing ratio local to cloudiness and radiation [kg/kg] qsrad_p, &!snow mixing ratio local to cloudiness and radiation [kg/kg] zgrid_p + !================================================================================================================= !.. variables and arrays related to land-surface parameterization: !================================================================================================================= @@ -849,6 +952,12 @@ module mpas_atmphys_vars frc_urb_p, &!urban fraction [-] ust_urb_p !urban u* in similarity theory [m/s] +!================================================================================================================= +!.. variables and arrays related to the Noahmp land-surface parameterization: +!================================================================================================================= + + type(NoahmpIO_type):: mpas_noahmp + !================================================================================================================= !.. variables and arrays related to surface characteristics: !================================================================================================================= diff --git a/src/core_atmosphere/physics/physics_mmm/LICENSE b/src/core_atmosphere/physics/physics_mmm/LICENSE new file mode 100644 index 000000000..5a2529d79 --- /dev/null +++ b/src/core_atmosphere/physics/physics_mmm/LICENSE @@ -0,0 +1,29 @@ +BSD 3-Clause License + +Copyright (c) 2022, National Center for Atmospheric Research +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +3. Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/src/core_atmosphere/physics/physics_mmm/Makefile b/src/core_atmosphere/physics/physics_mmm/Makefile.mpas similarity index 71% rename from src/core_atmosphere/physics/physics_mmm/Makefile rename to src/core_atmosphere/physics/physics_mmm/Makefile.mpas index 80448dbc0..12c645f3a 100644 --- a/src/core_atmosphere/physics/physics_mmm/Makefile +++ b/src/core_atmosphere/physics/physics_mmm/Makefile.mpas @@ -1,4 +1,6 @@ -.SUFFIXES: .F .o +.SUFFIXES: .F90 .o + +.PHONY: physics_mmm physics_mmm_lib all: dummy physics_mmm @@ -21,6 +23,8 @@ OBJS = \ module_sprayHFs.o physics_mmm: $(OBJS) + +physics_mmm_lib: ar -ru ./../libphys.a $(OBJS) # DEPENDENCIES: @@ -47,10 +51,14 @@ clean: @# This removes them during the clean process $(RM) *.i -.F.o: +# Cancel the built-in implicit rule for Modula-2 files (.mod) to avoid having +# make try to create .o files from Fortran .mod files +%.o : %.mod + +.F90.o: ifeq "$(GEN_F90)" "true" $(CPP) $(CPPFLAGS) $(COREDEF) $(CPPINCLUDES) $< > $*.f90 $(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES) -I.. -I../../../framework -I../../../external/esmf_time_f90 else - $(FC) $(CPPFLAGS) $(COREDEF) $(FFLAGS) -c $*.F $(CPPINCLUDES) $(FCINCLUDES) -I.. -I../../../framework -I../../../external/esmf_time_f90 + $(FC) $(CPPFLAGS) $(COREDEF) $(FFLAGS) -c $*.F90 $(CPPINCLUDES) $(FCINCLUDES) -I.. -I../../../framework -I../../../external/esmf_time_f90 endif diff --git a/src/core_atmosphere/physics/physics_mmm/README.md b/src/core_atmosphere/physics/physics_mmm/README.md new file mode 100644 index 000000000..fc9874511 --- /dev/null +++ b/src/core_atmosphere/physics/physics_mmm/README.md @@ -0,0 +1,2 @@ +# MMM-physics +This repository contains physics parameterizations shared by MPAS, WRF, and CM1. Modules follow CCPP coding standards. diff --git a/src/core_atmosphere/physics/physics_mmm/bl_gwdo.F b/src/core_atmosphere/physics/physics_mmm/bl_gwdo.F90 similarity index 91% rename from src/core_atmosphere/physics/physics_mmm/bl_gwdo.F rename to src/core_atmosphere/physics/physics_mmm/bl_gwdo.F90 index dfb337091..b31463453 100644 --- a/src/core_atmosphere/physics/physics_mmm/bl_gwdo.F +++ b/src/core_atmosphere/physics/physics_mmm/bl_gwdo.F90 @@ -1,17 +1,57 @@ -module bl_gwdo -use ccpp_kinds,only: kind_phys -!=============================================================================== - IMPLICIT NONE - PRIVATE - PUBLIC :: bl_gwdo_run - PUBLIC :: bl_gwdo_init - PUBLIC :: bl_gwdo_final - PUBLIC :: bl_gwdo_timestep_init - PUBLIC :: bl_gwdo_timestep_final +!================================================================================================================= + module bl_gwdo + use ccpp_kind_types,only: kind_phys -contains -!------------------------------------------------------------------------------- -!------------------------------------------------------------------------------- + implicit none + private + public:: bl_gwdo_run, & + bl_gwdo_init, & + bl_gwdo_finalize + + + contains + + +!================================================================================================================= +!>\section arg_table_bl_gwdo_init +!!\html\include bl_gwdo_init.html +!! + subroutine bl_gwdo_init(errmsg,errflg) +!================================================================================================================= + +!--- output arguments: + character(len=*),intent(out):: errmsg + integer,intent(out):: errflg + +!----------------------------------------------------------------------------------------------------------------- + + errmsg = 'bl_gwdo_init OK' + errflg = 0 + + end subroutine bl_gwdo_init + +!================================================================================================================= +!>\section arg_table_bl_gwdo_finalize +!!\html\include bl_gwdo_finalize.html +!! + subroutine bl_gwdo_finalize(errmsg,errflg) +!================================================================================================================= + +!--- output arguments: + character(len=*),intent(out):: errmsg + integer,intent(out):: errflg + +!----------------------------------------------------------------------------------------------------------------- + + errmsg = 'bl_gwdo_finalize OK' + errflg = 0 + + end subroutine bl_gwdo_finalize + +!================================================================================================================= +!>\section arg_table_bl_gwdo_run +!!\html\include bl_gwdo_run.html +!! subroutine bl_gwdo_run(sina, cosa, & rublten,rvblten, & dtaux3d,dtauy3d, & @@ -75,25 +115,24 @@ subroutine bl_gwdo_run(sina, cosa, & ! dusfc, dvsfc - gw stress ! !------------------------------------------------------------------------------- - use ccpp_kinds, only: kind_phys implicit none ! integer, parameter :: kts = 1 integer , intent(in ) :: its, ite, kte, kme real(kind=kind_phys) , intent(in ) :: g_, pi_, rd_, rv_, fv_,& cp_, deltim - real(kind=kind_phys), dimension(its:ite) , intent(in ) :: dxmeter - real(kind=kind_phys), dimension(its:ite,kts:kte) , intent(inout) :: rublten, rvblten - real(kind=kind_phys), dimension(its:ite,kts:kte) , intent( out) :: dtaux3d, dtauy3d - real(kind=kind_phys), dimension(its:ite) , intent( out) :: dusfcg, dvsfcg - real(kind=kind_phys), dimension(its:ite) , intent(in ) :: sina, cosa - real(kind=kind_phys), dimension(its:ite,kts:kte) , intent(in ) :: uproj, vproj - real(kind=kind_phys), dimension(its:ite,kts:kte) , intent(in ) :: t1, q1, prslk, zl -! - real(kind=kind_phys), dimension(its:ite,kts:kte) , intent(in ) :: prsl - real(kind=kind_phys), dimension(its:ite,kts:kme) , intent(in ) :: prsi -! - real(kind=kind_phys), dimension(its:ite) , intent(in ) :: var, oc1, & + real(kind=kind_phys), dimension(its:) , intent(in ) :: dxmeter + real(kind=kind_phys), dimension(its:,:) , intent(inout) :: rublten, rvblten + real(kind=kind_phys), dimension(its:,:) , intent( out) :: dtaux3d, dtauy3d + real(kind=kind_phys), dimension(its:) , intent( out) :: dusfcg, dvsfcg + real(kind=kind_phys), dimension(its:) , intent(in ) :: sina, cosa + real(kind=kind_phys), dimension(its:,:) , intent(in ) :: uproj, vproj + real(kind=kind_phys), dimension(its:,:) , intent(in ) :: t1, q1, prslk, zl +! + real(kind=kind_phys), dimension(its:,:) , intent(in ) :: prsl + real(kind=kind_phys), dimension(its:,:) , intent(in ) :: prsi +! + real(kind=kind_phys), dimension(its:) , intent(in ) :: var, oc1, & oa2d1, oa2d2, oa2d3, oa2d4, & ol2d1, ol2d2, ol2d3, ol2d4 character(len=*) , intent( out) :: errmsg @@ -603,57 +642,8 @@ subroutine bl_gwdo_run(sina, cosa, & return end subroutine bl_gwdo_run -!------------------------------------------------------------------------------- - subroutine bl_gwdo_init (errmsg, errflg) - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - ! This routine currently does nothing - - errmsg = '' - errflg = 0 - - end subroutine bl_gwdo_init - -!------------------------------------------------------------------------------- - subroutine bl_gwdo_final (errmsg, errflg) +!================================================================================================================= + end module bl_gwdo +!================================================================================================================= - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! This routine currently does nothing - - errmsg = '' - errflg = 0 - - end subroutine bl_gwdo_final - -!------------------------------------------------------------------------------- - subroutine bl_gwdo_timestep_init (errmsg, errflg) - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! This routine currently does nothing - - errmsg = '' - errflg = 0 - - end subroutine bl_gwdo_timestep_init - -!------------------------------------------------------------------------------- - subroutine bl_gwdo_timestep_final (errmsg, errflg) - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! This routine currently does nothing - - errmsg = '' - errflg = 0 - - end subroutine bl_gwdo_timestep_final - -!------------------------------------------------------------------------------- -end module bl_gwdo diff --git a/src/core_atmosphere/physics/physics_mmm/bl_mynn.F b/src/core_atmosphere/physics/physics_mmm/bl_mynn.F90 similarity index 97% rename from src/core_atmosphere/physics/physics_mmm/bl_mynn.F rename to src/core_atmosphere/physics/physics_mmm/bl_mynn.F90 index b41b2c538..783b996ff 100644 --- a/src/core_atmosphere/physics/physics_mmm/bl_mynn.F +++ b/src/core_atmosphere/physics/physics_mmm/bl_mynn.F90 @@ -1,6 +1,6 @@ !================================================================================================================= module bl_mynn - use mpas_kind_types,only: kind_phys => RKIND + use ccpp_kind_types,only: kind_phys use bl_mynn_common,only: & cp , cpv , cliq , cice , ep_1 , ep_2 , ep_3 , grav , karman , p1000mb , & @@ -201,7 +201,7 @@ subroutine bl_mynn_run & real(kind=kind_phys),intent(in):: & delt - real(kind=kind_phys),intent(in),dimension(its:ite):: & + real(kind=kind_phys),intent(in),dimension(its:):: & dx, &! xland, &! ps, &! @@ -217,7 +217,7 @@ subroutine bl_mynn_run & voce, &! znt ! - real(kind=kind_phys),intent(in),dimension(its:ite,kts:kte):: & + real(kind=kind_phys),intent(in),dimension(its:,:):: & dz, &! u, &! v, &! @@ -228,7 +228,7 @@ subroutine bl_mynn_run & rho, &! rthraten ! - real(kind=kind_phys),intent(in),dimension(its:ite,kts:kte):: & + real(kind=kind_phys),intent(in),dimension(its:,:):: & sqv, &! sqc, &! sqi, &! @@ -240,26 +240,26 @@ subroutine bl_mynn_run & qnbca, &! qozone ! - real(kind=kind_phys),intent(in),dimension(its:ite,kts:kte):: & + real(kind=kind_phys),intent(in),dimension(its:,:):: & pattern_spp_pbl - real(kind=kind_phys),intent(in),dimension(its:ite,kts:kme):: & + real(kind=kind_phys),intent(in),dimension(its:,:):: & w ! !inout arguments: - integer,intent(inout),dimension(its:ite):: & + integer,intent(inout),dimension(its:):: & kpbl, &! ktop_plume ! - real(kind=kind_phys),intent(inout),dimension(its:ite):: & + real(kind=kind_phys),intent(inout),dimension(its:):: & pblh - real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte):: & + real(kind=kind_phys),intent(inout),dimension(its:,:):: & cldfra_bl, &! qc_bl, &! qi_bl ! - real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte):: & + real(kind=kind_phys),intent(inout),dimension(its:,:):: & el_pbl, &! qke, &! qke_adv, &! @@ -269,7 +269,7 @@ subroutine bl_mynn_run & sh, &! sm ! - real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte):: & + real(kind=kind_phys),intent(inout),dimension(its:,:):: & rublten, &! rvblten, &! rthblten, &! @@ -284,7 +284,7 @@ subroutine bl_mynn_run & rqnbcablten, &! rqozblten ! - real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte):: & + real(kind=kind_phys),intent(inout),dimension(its:,:):: & edmf_a, &! edmf_w, &! edmf_qt, &! @@ -296,7 +296,7 @@ subroutine bl_mynn_run & det_thl, &! det_sqv ! - real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte),optional:: & + real(kind=kind_phys),intent(inout),dimension(its:,:),optional:: & edmf_a_dd, &! edmf_w_dd, &! edmf_qt_dd, &! @@ -312,16 +312,16 @@ subroutine bl_mynn_run & integer,intent(out):: & errflg ! output error flag (-). - real(kind=kind_phys),intent(out),dimension(its:ite):: & + real(kind=kind_phys),intent(out),dimension(:):: & maxwidth, &! maxmf, &! ztop_plume - real(kind=kind_phys),intent(out),dimension(its:ite,kts:kte):: & + real(kind=kind_phys),intent(out),dimension(its:,:):: & exch_h, &! exch_m ! - real(kind=kind_phys),intent(out),dimension(its:ite,kts:kte),optional:: & + real(kind=kind_phys),intent(out),dimension(its:,:),optional:: & dqke, &! qwt, &! qshear, &! diff --git a/src/core_atmosphere/physics/physics_mmm/bl_mynn_subroutines.F b/src/core_atmosphere/physics/physics_mmm/bl_mynn_subroutines.F90 similarity index 99% rename from src/core_atmosphere/physics/physics_mmm/bl_mynn_subroutines.F rename to src/core_atmosphere/physics/physics_mmm/bl_mynn_subroutines.F90 index 324c36851..180e7cf6c 100644 --- a/src/core_atmosphere/physics/physics_mmm/bl_mynn_subroutines.F +++ b/src/core_atmosphere/physics/physics_mmm/bl_mynn_subroutines.F90 @@ -1,6 +1,6 @@ !================================================================================================================= module bl_mynn_common - use mpas_kind_types,only: kind_phys => RKIND + use ccpp_kind_types,only: kind_phys implicit none save @@ -323,7 +323,7 @@ end module bl_mynn_common ! Many of these changes are now documented in references listed above. !==================================================================== MODULE bl_mynn_subroutines - use mpas_kind_types,only: kind_phys => RKIND,kind_phys8 => R8KIND + use ccpp_kind_types,only: kind_phys,kind_phys8 use bl_mynn_common,only: & b1 , b2 , cice , cliq , cp , & cpv , ep_2 , ep_3 , grav , gtr , & diff --git a/src/core_atmosphere/physics/physics_mmm/bl_ysu.F b/src/core_atmosphere/physics/physics_mmm/bl_ysu.F90 similarity index 94% rename from src/core_atmosphere/physics/physics_mmm/bl_ysu.F rename to src/core_atmosphere/physics/physics_mmm/bl_ysu.F90 index 601c232cb..1eb049684 100644 --- a/src/core_atmosphere/physics/physics_mmm/bl_ysu.F +++ b/src/core_atmosphere/physics/physics_mmm/bl_ysu.F90 @@ -1,27 +1,64 @@ #define NEED_B4B_DURING_CCPP_TESTING 1 !================================================================================================================= module bl_ysu - use ccpp_kinds,only: kind_phys + use ccpp_kind_types,only: kind_phys implicit none private - public:: bl_ysu_run , & - bl_ysu_init , & - bl_ysu_final , & - bl_ysu_timestep_init, & - bl_ysu_timestep_final + public:: bl_ysu_run, & + bl_ysu_init, & + bl_ysu_finalize contains !================================================================================================================= +!>\section arg_table_bl_ysu_init +!!\html\include bl_ysu_init.html +!! + subroutine bl_ysu_init(errmsg,errflg) +!================================================================================================================= + +!--- output arguments: + character(len=*),intent(out):: errmsg + integer,intent(out):: errflg + +!----------------------------------------------------------------------------------------------------------------- + + errmsg = 'bl_ysu_init OK' + errflg = 0 + + end subroutine bl_ysu_init + +!================================================================================================================= +!>\section arg_table_bl_ysu_finalize +!!\html\include bl_ysu_finalize.html +!! + subroutine bl_ysu_finalize(errmsg,errflg) +!================================================================================================================= + +!--- output arguments: + character(len=*),intent(out):: errmsg + integer,intent(out):: errflg + +!----------------------------------------------------------------------------------------------------------------- + + errmsg = 'bl_ysu_finalize OK' + errflg = 0 + + end subroutine bl_ysu_finalize + +!================================================================================================================= +!>\section arg_table_bl_ysu_run +!!\html\include bl_ysu_run.html +!! subroutine bl_ysu_run(ux,vx,tx,qvx,qcx,qix,nmix,qmix,p2d,p2di,pi2d, & f_qc,f_qi, & utnp,vtnp,ttnp,qvtnp,qctnp,qitnp,qmixtnp, & cp,g,rovcp,rd,rovg,ep1,ep2,karman,xlv,rv, & dz8w2d,psfcpa, & - znt,ust,hpbl,psim,psih, & + znt,ust,hpbl,dusfc,dvsfc,dtsfc,dqsfc,psim,psih, & xland,hfx,qfx,wspd,br, & dt,kpbl1d, & exch_hx,exch_mx, & @@ -119,7 +156,7 @@ subroutine bl_ysu_run(ux,vx,tx,qvx,qcx,qix,nmix,qmix,p2d,p2di,pi2d, & ! integer, intent(in ) :: its,ite,kte,kme - integer, intent(in) :: ysu_topdown_pblmix + logical, intent(in) :: ysu_topdown_pblmix ! integer, intent(in) :: nmix ! @@ -129,20 +166,20 @@ subroutine bl_ysu_run(ux,vx,tx,qvx,qcx,qix,nmix,qmix,p2d,p2di,pi2d, & ! logical, intent(in ) :: f_qc, f_qi ! - real(kind=kind_phys), dimension( its:ite, kts:kte ) , & + real(kind=kind_phys), dimension( its:,: ) , & intent(in) :: dz8w2d, & pi2d ! - real(kind=kind_phys), dimension( its:ite, kts:kte ) , & + real(kind=kind_phys), dimension( its:,: ) , & intent(in ) :: tx, & qvx, & qcx, & qix ! - real(kind=kind_phys), dimension( its:ite, kts:kte, nmix ) , & + real(kind=kind_phys), dimension( its:,:,: ) , & intent(in ) :: qmix ! - real(kind=kind_phys), dimension( its:ite, kts:kte ) , & + real(kind=kind_phys), dimension( its:,: ) , & intent(out ) :: utnp, & vtnp, & ttnp, & @@ -150,46 +187,52 @@ subroutine bl_ysu_run(ux,vx,tx,qvx,qcx,qix,nmix,qmix,p2d,p2di,pi2d, & qctnp, & qitnp ! - real(kind=kind_phys), dimension( its:ite, kts:kte, nmix ) , & + real(kind=kind_phys), dimension( its:,:,: ) , & intent(out ) :: qmixtnp ! - real(kind=kind_phys), dimension( its:ite, kms:kme ) , & + real(kind=kind_phys), dimension( its:,: ) , & intent(in ) :: p2di ! - real(kind=kind_phys), dimension( its:ite, kts:kte ) , & + real(kind=kind_phys), dimension( its:,: ) , & intent(in ) :: p2d ! - real(kind=kind_phys), dimension( its:ite ) , & + real(kind=kind_phys), dimension( its: ) , & intent(out ) :: hpbl ! - real(kind=kind_phys), dimension( its:ite ) , & + real(kind=kind_phys), dimension( its: ) , & + intent(out ), optional :: dusfc, & + dvsfc, & + dtsfc, & + dqsfc +! + real(kind=kind_phys), dimension( its: ) , & intent(in ) :: ust, & znt - real(kind=kind_phys), dimension( its:ite ) , & + real(kind=kind_phys), dimension( its: ) , & intent(in ) :: xland, & hfx, & qfx ! - real(kind=kind_phys), dimension( its:ite ), intent(in ) :: wspd - real(kind=kind_phys), dimension( its:ite ), intent(in ) :: br + real(kind=kind_phys), dimension( its: ), intent(in ) :: wspd + real(kind=kind_phys), dimension( its: ), intent(in ) :: br ! - real(kind=kind_phys), dimension( its:ite ), intent(in ) :: psim, & + real(kind=kind_phys), dimension( its: ), intent(in ) :: psim, & psih ! - real(kind=kind_phys), dimension( its:ite ), intent(in ) :: psfcpa - integer, dimension( its:ite ), intent(out ) :: kpbl1d + real(kind=kind_phys), dimension( its: ), intent(in ) :: psfcpa + integer, dimension( its: ), intent(out ) :: kpbl1d ! - real(kind=kind_phys), dimension( its:ite, kts:kte ) , & + real(kind=kind_phys), dimension( its:,: ) , & intent(in ) :: ux, & vx, & rthraten - real(kind=kind_phys), dimension( its:ite ) , & + real(kind=kind_phys), dimension( its: ) , & optional , & intent(in ) :: ctopo, & ctopo2 ! logical, intent(in ) :: flag_bep - real(kind=kind_phys), dimension( its:ite, kts:kte ) , & + real(kind=kind_phys), dimension( its:,: ) , & optional , & intent(in ) :: a_u, & a_v, & @@ -205,7 +248,7 @@ subroutine bl_ysu_run(ux,vx,tx,qvx,qcx,qix,nmix,qmix,p2d,p2di,pi2d, & vlk, & dlu, & dlg - real(kind=kind_phys), dimension( its:ite ) , & + real(kind=kind_phys), dimension( its: ) , & optional , & intent(in ) :: frcurb ! @@ -235,8 +278,6 @@ subroutine bl_ysu_run(ux,vx,tx,qvx,qcx,qix,nmix,qmix,p2d,p2di,pi2d, & hgamt,hgamq, & brdn,brup, & phim,phih, & - dusfc,dvsfc, & - dtsfc,dqsfc, & prpbl, & wspd1,thermalli ! @@ -551,10 +592,10 @@ subroutine bl_ysu_run(ux,vx,tx,qvx,qcx,qix,nmix,qmix,p2d,p2di,pi2d, & enddo ! do i = its,ite - dusfc(i) = 0. - dvsfc(i) = 0. - dtsfc(i) = 0. - dqsfc(i) = 0. + if(present(dusfc)) dusfc(i) = 0. + if(present(dvsfc)) dvsfc(i) = 0. + if(present(dtsfc)) dtsfc(i) = 0. + if(present(dqsfc)) dqsfc(i) = 0. enddo ! do i = its,ite @@ -689,7 +730,7 @@ subroutine bl_ysu_run(ux,vx,tx,qvx,qcx,qix,nmix,qmix,p2d,p2di,pi2d, & ! ! enhance pbl by theta-li ! - if (ysu_topdown_pblmix.eq.1)then + if (ysu_topdown_pblmix)then do i = its,ite kpblold(i) = kpbl(i) definebrup=.false. @@ -796,7 +837,7 @@ subroutine bl_ysu_run(ux,vx,tx,qvx,qcx,qix,nmix,qmix,p2d,p2di,pi2d, & bfxpbl(i) = -0.15*thvx(i,1)/g*wm3/hpbl(i) dthvx(i) = max(thvx(i,k+1)-thvx(i,k),tmin) we(i) = max(bfxpbl(i)/dthvx(i),-sqrt(wm2(i))) - if((qcxl(i,k)+qixl(i,k)).gt.0.01e-3.and.ysu_topdown_pblmix.eq.1)then + if((qcxl(i,k)+qixl(i,k)).gt.0.01e-3.and.ysu_topdown_pblmix)then if ( kpbl(i) .ge. 2) then cloudflg(i)=.true. templ=thlix(i,k)*(p2di(i,k+1)/100000)**rovcp @@ -1061,11 +1102,11 @@ subroutine bl_ysu_run(ux,vx,tx,qvx,qcx,qix,nmix,qmix,p2d,p2di,pi2d, & #if (NEED_B4B_DURING_CCPP_TESTING == 1) ttend = (f1(i,k)-thx(i,k)+300.)*rdt*pi2d(i,k) ttnp(i,k) = ttend - dtsfc(i) = dtsfc(i)+ttend*cont*del(i,k)/pi2d(i,k) + if(present(dtsfc)) dtsfc(i) = dtsfc(i)+ttend*cont*del(i,k)/pi2d(i,k) #elif (NEED_B4B_DURING_CCPP_TESTING != 1) ttend = (f1(i,k)-thx(i,k)+300.)*rdt ttnp(i,k) = ttend - dtsfc(i) = dtsfc(i)+ttend*cont*del(i,k) + if(present(dtsfc)) dtsfc(i) = dtsfc(i)+ttend*cont*del(i,k) #endif enddo enddo @@ -1138,7 +1179,7 @@ subroutine bl_ysu_run(ux,vx,tx,qvx,qcx,qix,nmix,qmix,p2d,p2di,pi2d, & do k = kte,kts,-1 qtend = (f1(i,k)-qvx(i,k))*rdt qvtnp(i,k) = qtend - dqsfc(i) = dqsfc(i)+qtend*conq*del(i,k) + if(present(dqsfc)) dqsfc(i) = dqsfc(i)+qtend*conq*del(i,k) enddo enddo @@ -1353,8 +1394,8 @@ subroutine bl_ysu_run(ux,vx,tx,qvx,qcx,qix,nmix,qmix,p2d,p2di,pi2d, & vtend = (f2(i,k)-vx(i,k))*rdt utnp(i,k) = utend vtnp(i,k) = vtend - dusfc(i) = dusfc(i) + utend*conwrc*del(i,k) - dvsfc(i) = dvsfc(i) + vtend*conwrc*del(i,k) + if(present(dusfc)) dusfc(i) = dusfc(i) + utend*conwrc*del(i,k) + if(present(dvsfc)) dvsfc(i) = dvsfc(i) + vtend*conwrc*del(i,k) enddo enddo ! @@ -1379,59 +1420,6 @@ subroutine bl_ysu_run(ux,vx,tx,qvx,qcx,qix,nmix,qmix,p2d,p2di,pi2d, & end subroutine bl_ysu_run !================================================================================================================= - subroutine bl_ysu_init (errmsg, errflg) - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! This routine currently does nothing - - errmsg = '' - errflg = 0 - - end subroutine bl_ysu_init - -!================================================================================================================= - subroutine bl_ysu_final (errmsg, errflg) - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! This routine currently does nothing - - errmsg = '' - errflg = 0 - - end subroutine bl_ysu_final - -!================================================================================================================= - subroutine bl_ysu_timestep_init (errmsg, errflg) - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! This routine currently does nothing - - errmsg = '' - errflg = 0 - - end subroutine bl_ysu_timestep_init - -!================================================================================================================= - subroutine bl_ysu_timestep_final (errmsg, errflg) - - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! This routine currently does nothing - - errmsg = '' - errflg = 0 - - end subroutine bl_ysu_timestep_final -!------------------------------------------------------------------------------- -! -!------------------------------------------------------------------------------- subroutine tridi2n(cl,cm,cm1,cu,r1,r2,au,f1,f2,its,ite,kts,kte,nt) !------------------------------------------------------------------------------- implicit none diff --git a/src/core_atmosphere/physics/physics_mmm/cu_ntiedtke.F b/src/core_atmosphere/physics/physics_mmm/cu_ntiedtke.F90 similarity index 95% rename from src/core_atmosphere/physics/physics_mmm/cu_ntiedtke.F rename to src/core_atmosphere/physics/physics_mmm/cu_ntiedtke.F90 index 041bb6745..e1d266d06 100644 --- a/src/core_atmosphere/physics/physics_mmm/cu_ntiedtke.F +++ b/src/core_atmosphere/physics/physics_mmm/cu_ntiedtke.F90 @@ -1,6 +1,6 @@ !================================================================================================================= module cu_ntiedtke_common - use ccpp_kinds,only: kind_phys + use ccpp_kind_types,only: kind_phys implicit none @@ -60,23 +60,24 @@ end module cu_ntiedtke_common !================================================================================================================= module cu_ntiedtke - use ccpp_kinds,only: kind_phys + use ccpp_kind_types,only: kind_phys use cu_ntiedtke_common implicit none private - public:: cu_ntiedtke_run, & - cu_ntiedtke_init, & - cu_ntiedtke_final, & - cu_ntiedtke_timestep_init, & - cu_ntiedtke_timestep_final + public:: cu_ntiedtke_run, & + cu_ntiedtke_init, & + cu_ntiedtke_finalize contains !================================================================================================================= +!>\section arg_table_cu_ntiedtke_init +!!\html\include cu_ntiedtke_init.html +!! subroutine cu_ntiedtke_init(con_cp,con_rd,con_rv,con_xlv,con_xls,con_xlf,con_grav,errmsg,errflg) !================================================================================================================= @@ -122,7 +123,10 @@ subroutine cu_ntiedtke_init(con_cp,con_rd,con_rv,con_xlv,con_xls,con_xlf,con_gra end subroutine cu_ntiedtke_init !================================================================================================================= - subroutine cu_ntiedtke_final(errmsg,errflg) +!>\section arg_table_cu_ntiedtke_finalize +!!\html\include cu_ntiedtke_finalize.html +!! + subroutine cu_ntiedtke_finalize(errmsg,errflg) !================================================================================================================= !--- output arguments: @@ -131,191 +135,15 @@ subroutine cu_ntiedtke_final(errmsg,errflg) !----------------------------------------------------------------------------------------------------------------- - errmsg = 'cu_ntiedtke_final OK' + errmsg = 'cu_ntiedtke_finalize OK' errflg = 0 - end subroutine cu_ntiedtke_final - -!================================================================================================================= - subroutine cu_ntiedtke_timestep_init(its,ite,kts,kte,im,kx,kx1,itimestep,stepcu,dt,grav,xland,dz,pres,presi, & - t,rho,qv,qc,qi,u,v,w,qvften,thften,qvftenz,thftenz,slimsk,delt,prsl,ghtl,tf,qvf,qcf, & - qif,uf,vf,prsi,ghti,omg,errmsg,errflg) -!================================================================================================================= - -!--- input arguments: - integer,intent(in):: its,ite,kts,kte - integer,intent(in):: itimestep - integer,intent(in):: stepcu - - real(kind=kind_phys),intent(in):: dt,grav - real(kind=kind_phys),intent(in),dimension(its:ite):: xland - real(kind=kind_phys),intent(in),dimension(its:ite,kts:kte):: dz,pres,t,rho,qv,qc,qi,u,v - real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte):: qvften,thften - real(kind=kind_phys),intent(in),dimension(its:ite,kts:kte+1):: presi,w - -!--- inout arguments: - integer,intent(inout):: im,kx,kx1 - integer,intent(inout),dimension(its:ite):: slimsk - - real(kind=kind_phys),intent(inout):: delt - real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte):: tf,qvf,qcf,qif,uf,vf - real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte):: ghtl,omg,prsl - real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte):: qvftenz,thftenz - real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte+1):: ghti,prsi - -!--- output arguments: - character(len=*),intent(out):: errmsg - integer,intent(out):: errflg - -!--- local variables and arrays: - integer:: i,k,pp,zz - - real(kind=kind_phys),dimension(its:ite,kts:kte):: zl,dot - real(kind=kind_phys),dimension(its:ite,kts:kte+1):: zi - -!----------------------------------------------------------------------------------------------------------------- - - im = ite-its+1 - kx = kte-kts+1 - kx1 = kx+1 - - delt = dt*stepcu - - do i = its,ite - slimsk(i) = (abs(xland(i)-2.)) - enddo - - k = kts - do i = its,ite - zi(i,k) = 0. - enddo - do k = kts,kte - do i = its,ite - zi(i,k+1) = zi(i,k)+dz(i,k) - enddo - enddo - do k = kts,kte - do i = its,ite - zl(i,k) = 0.5*(zi(i,k)+zi(i,k+1)) - dot(i,k) = -0.5*grav*rho(i,k)*(w(i,k)+w(i,k+1)) - enddo - enddo - - pp = 0 - do k = kts,kte+1 - zz = kte + 1 - pp - do i = its,ite - ghti(i,zz) = zi(i,k) - prsi(i,zz) = presi(i,k) - enddo - pp = pp + 1 - enddo - pp = 0 - do k = kts,kte - zz = kte-pp - do i = its,ite - ghtl(i,zz) = zl(i,k) - omg(i,zz) = dot(i,k) - prsl(i,zz) = pres(i,k) - enddo - pp = pp + 1 - enddo - - pp = 0 - do k = kts,kte - zz = kte-pp - do i = its,ite - tf(i,zz) = t(i,k) - qvf(i,zz) = qv(i,k) - qcf(i,zz) = qc(i,k) - qif(i,zz) = qi(i,k) - uf(i,zz) = u(i,k) - vf(i,zz) = v(i,k) - enddo - pp = pp + 1 - enddo - - if(itimestep == 1) then - do k = kts,kte - do i = its,ite - qvftenz(i,k) = 0. - thftenz(i,k) = 0. - enddo - enddo - else - pp = 0 - do k = kts,kte - zz = kte-pp - do i = its,ite - qvftenz(i,zz) = qvften(i,k) - thftenz(i,zz) = thften(i,k) - enddo - pp = pp + 1 - enddo - endif - - errmsg = 'cu_ntiedtke_timestep_init OK' - errflg = 0 - - end subroutine cu_ntiedtke_timestep_init - -!================================================================================================================= - subroutine cu_ntiedtke_timestep_final(its,ite,kts,kte,stepcu,dt,exner,qv,qc,qi,t,u,v,qvf,qcf,qif,tf,uf,vf,rn, & - raincv,pratec,rthcuten,rqvcuten,rqccuten,rqicuten,rucuten,rvcuten,errmsg,errflg) -!================================================================================================================= - -!--- input arguments: - integer,intent(in):: its,ite,kts,kte - integer,intent(in):: stepcu - - real(kind=kind_phys),intent(in):: dt - real(kind=kind_phys),intent(in),dimension(its:ite):: rn - real(kind=kind_phys),intent(in),dimension(its:ite,kts:kte):: exner,qv,qc,qi,t,u,v,qvf,qcf,qif,tf,uf,vf - -!--- inout arguments: - real(kind=kind_phys),intent(inout),dimension(its:ite):: raincv,pratec - real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte):: rqvcuten,rqccuten,rqicuten - real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte):: rthcuten,rucuten,rvcuten - -!--- output arguments: - character(len=*),intent(out):: errmsg - integer,intent(out):: errflg - -!--- local variables and arrays: - integer:: i,k,pp,zz - - real(kind=kind_phys):: delt,rdelt - -!----------------------------------------------------------------------------------------------------------------- - - delt = dt*stepcu - rdelt = 1./delt - - do i = its,ite - raincv(i) = rn(i)/stepcu - pratec(i) = rn(i)/(stepcu*dt) - enddo - - pp = 0 - do k = kts,kte - zz = kte - pp - do i = its,ite - rthcuten(i,k) = (tf(i,zz)-t(i,k))/exner(i,k)*rdelt - rqvcuten(i,k) = (qvf(i,zz)-qv(i,k))*rdelt - rqccuten(i,k) = (qcf(i,zz)-qc(i,k))*rdelt - rqicuten(i,k) = (qif(i,zz)-qi(i,k))*rdelt - rucuten(i,k) = (uf(i,zz)-u(i,k))*rdelt - rvcuten(i,k) = (vf(i,zz)-v(i,k))*rdelt - enddo - pp = pp + 1 - enddo - - errmsg = 'cu_ntiedtke_timestep_final OK' - errflg = 0 - - end subroutine cu_ntiedtke_timestep_final + end subroutine cu_ntiedtke_finalize !================================================================================================================= +!>\section arg_table_cu_ntiedtke_run +!!\html\include cu_ntiedtke_run.html +!! ! level 1 subroutine 'cu_ntiedkte_run' subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqc,pqi,pqvf,ptf,poz,pzz,pomg, & & pap,paph,evap,hfx,zprecc,lndj,lq,km,km1,dt,dx,errmsg,errflg) @@ -359,18 +187,18 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqc,pqi,pqvf,ptf,poz,pzz,pomg, & !--- input arguments: integer,intent(in):: lq,km,km1 - integer,intent(in),dimension(lq):: lndj + integer,intent(in),dimension(:):: lndj real(kind=kind_phys),intent(in):: dt - real(kind=kind_phys),intent(in),dimension(lq):: dx - real(kind=kind_phys),intent(in),dimension(lq):: evap,hfx - real(kind=kind_phys),intent(in),dimension(lq,km):: pqvf,ptf - real(kind=kind_phys),intent(in),dimension(lq,km):: poz,pomg,pap - real(kind=kind_phys),intent(in),dimension(lq,km1):: pzz,paph + real(kind=kind_phys),intent(in),dimension(:):: dx + real(kind=kind_phys),intent(in),dimension(:):: evap,hfx + real(kind=kind_phys),intent(in),dimension(:,:):: pqvf,ptf + real(kind=kind_phys),intent(in),dimension(:,:):: poz,pomg,pap + real(kind=kind_phys),intent(in),dimension(:,:):: pzz,paph !--- inout arguments: - real(kind=kind_phys),intent(inout),dimension(lq):: zprecc - real(kind=kind_phys),intent(inout),dimension(lq,km):: pu,pv,pt,pqv,pqc,pqi + real(kind=kind_phys),intent(inout),dimension(:):: zprecc + real(kind=kind_phys),intent(inout),dimension(:,:):: pu,pv,pt,pqv,pqc,pqi !--- output arguments: character(len=*),intent(out):: errmsg diff --git a/src/core_atmosphere/physics/physics_mmm/module_libmassv.F b/src/core_atmosphere/physics/physics_mmm/module_libmassv.F90 similarity index 100% rename from src/core_atmosphere/physics/physics_mmm/module_libmassv.F rename to src/core_atmosphere/physics/physics_mmm/module_libmassv.F90 diff --git a/src/core_atmosphere/physics/physics_mmm/module_sprayHFs.F b/src/core_atmosphere/physics/physics_mmm/module_sprayHFs.F90 similarity index 100% rename from src/core_atmosphere/physics/physics_mmm/module_sprayHFs.F rename to src/core_atmosphere/physics/physics_mmm/module_sprayHFs.F90 diff --git a/src/core_atmosphere/physics/physics_mmm/mp_radar.F b/src/core_atmosphere/physics/physics_mmm/mp_radar.F90 similarity index 99% rename from src/core_atmosphere/physics/physics_mmm/mp_radar.F rename to src/core_atmosphere/physics/physics_mmm/mp_radar.F90 index 08199da7d..851e5d3f6 100644 --- a/src/core_atmosphere/physics/physics_mmm/mp_radar.F +++ b/src/core_atmosphere/physics/physics_mmm/mp_radar.F90 @@ -1,6 +1,6 @@ !================================================================================================================= module mp_radar - use ccpp_kinds,only: kind_phys + use ccpp_kind_types,only: kind_phys implicit none private diff --git a/src/core_atmosphere/physics/physics_mmm/mp_wsm6.F b/src/core_atmosphere/physics/physics_mmm/mp_wsm6.F90 similarity index 99% rename from src/core_atmosphere/physics/physics_mmm/mp_wsm6.F rename to src/core_atmosphere/physics/physics_mmm/mp_wsm6.F90 index ca345b3ba..ec2d1dca3 100644 --- a/src/core_atmosphere/physics/physics_mmm/mp_wsm6.F +++ b/src/core_atmosphere/physics/physics_mmm/mp_wsm6.F90 @@ -1,15 +1,15 @@ !================================================================================================================= module mp_wsm6 - use ccpp_kinds,only: kind_phys + use ccpp_kind_types,only: kind_phys use module_libmassv,only: vrec,vsqrt use mp_radar implicit none private - public:: mp_wsm6_run, & - mp_wsm6_init, & - mp_wsm6_final, & + public:: mp_wsm6_run, & + mp_wsm6_init, & + mp_wsm6_finalize, & refl10cm_wsm6 real(kind=kind_phys),parameter,private:: dtcldcr = 120. ! maximum time step for minor loops @@ -67,6 +67,9 @@ module mp_wsm6 !================================================================================================================= +!>\section arg_table_mp_wsm6_init +!!\html\include mp_wsm6_init.html +!! subroutine mp_wsm6_init(den0,denr,dens,cl,cpv,hail_opt,errmsg,errflg) !================================================================================================================= @@ -186,7 +189,10 @@ subroutine mp_wsm6_init(den0,denr,dens,cl,cpv,hail_opt,errmsg,errflg) end subroutine mp_wsm6_init !================================================================================================================= - subroutine mp_wsm6_final(errmsg,errflg) +!>\section arg_table_mp_wsm6_finalize +!!\html\include mp_wsm6_finalize.html +!! + subroutine mp_wsm6_finalize(errmsg,errflg) !================================================================================================================= !--- output arguments: @@ -195,12 +201,15 @@ subroutine mp_wsm6_final(errmsg,errflg) !----------------------------------------------------------------------------------------------------------------- - errmsg = 'mp_wsm6_final OK' + errmsg = 'mp_wsm6_finalize OK' errflg = 0 - end subroutine mp_wsm6_final + end subroutine mp_wsm6_finalize !================================================================================================================= +!>\section arg_table_mp_wsm6_run +!!\html\include mp_wsm6_run.html +!! subroutine mp_wsm6_run(t,q,qc,qi,qr,qs,qg,den,p,delz,delt, & g,cpd,cpv,rd,rv,t0c,ep1,ep2,qmin,xls, & xlv0,xlf0,den0,denr,cliq,cice,psat, & @@ -250,7 +259,7 @@ subroutine mp_wsm6_run(t,q,qc,qi,qr,qs,qg,den,p,delz,delt, & !input arguments: integer,intent(in):: its,ite,kts,kte - real(kind=kind_phys),intent(in),dimension(its:ite,kts:kte):: & + real(kind=kind_phys),intent(in),dimension(its:,:):: & den, & p, & delz @@ -275,30 +284,29 @@ subroutine mp_wsm6_run(t,q,qc,qi,qr,qs,qg,den,p,delz,delt, & denr !inout arguments: - real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte):: & + real(kind=kind_phys),intent(inout),dimension(its:,:):: & t -real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte):: & + real(kind=kind_phys),intent(inout),dimension(its:,:):: & q, & qc, & qi, & qr, & qs, & qg -real(kind=kind_phys),intent(inout),dimension(its:ite):: & + real(kind=kind_phys),intent(inout),dimension(its:):: & rain, & rainncv, & sr -real(kind=kind_phys),intent(inout),dimension(its:ite),optional:: & + real(kind=kind_phys),intent(inout),dimension(its:),optional:: & snow, & snowncv -real(kind=kind_phys),intent(inout),dimension(its:ite),optional:: & + + real(kind=kind_phys),intent(inout),dimension(its:),optional:: & graupel, & graupelncv - - real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte), & - optional:: & + real(kind=kind_phys),intent(inout),dimension(its:,:),optional:: & rainprod2d, & evapprod2d diff --git a/src/core_atmosphere/physics/physics_mmm/mp_wsm6_effectRad.F b/src/core_atmosphere/physics/physics_mmm/mp_wsm6_effectRad.F90 similarity index 84% rename from src/core_atmosphere/physics/physics_mmm/mp_wsm6_effectRad.F rename to src/core_atmosphere/physics/physics_mmm/mp_wsm6_effectRad.F90 index d54cf74b6..217b4e0a1 100644 --- a/src/core_atmosphere/physics/physics_mmm/mp_wsm6_effectRad.F +++ b/src/core_atmosphere/physics/physics_mmm/mp_wsm6_effectRad.F90 @@ -1,6 +1,6 @@ !================================================================================================================= module mp_wsm6_effectrad - use ccpp_kinds,only: kind_phys + use ccpp_kind_types,only: kind_phys use mp_wsm6,only: alpha,n0s,n0smax,pidn0s,pidnc @@ -8,15 +8,18 @@ module mp_wsm6_effectrad implicit none private - public:: mp_wsm6_effectRad_run, & - mp_wsm6_effectrad_init, & - mp_wsm6_effectRad_final + public:: mp_wsm6_effectRad_run, & + mp_wsm6_effectrad_init, & + mp_wsm6_effectRad_finalize contains !================================================================================================================= +!>\section arg_table_mp_wsm6_effectRad_init +!!\html\include mp_wsm6_effectRad_init.html +!! subroutine mp_wsm6_effectRad_init(errmsg,errflg) !================================================================================================================= @@ -32,7 +35,10 @@ subroutine mp_wsm6_effectRad_init(errmsg,errflg) end subroutine mp_wsm6_effectRad_init !================================================================================================================= - subroutine mp_wsm6_effectRad_final(errmsg,errflg) +!>\section arg_table_mp_wsm6_effectRad_finalize +!!\html\include mp_wsm6_effectRad_finalize.html +!! + subroutine mp_wsm6_effectRad_finalize(errmsg,errflg) !================================================================================================================= !output arguments: @@ -41,12 +47,15 @@ subroutine mp_wsm6_effectRad_final(errmsg,errflg) !----------------------------------------------------------------------------------------------------------------- - errmsg = 'mp_wsm6_effectRad_final OK' + errmsg = 'mp_wsm6_effectRad_finalize OK' errflg = 0 - end subroutine mp_wsm6_effectRad_final + end subroutine mp_wsm6_effectRad_finalize !================================================================================================================= +!>\section arg_table_mp_wsm6_effectRad_run +!!\html\include mp_wsm6_effectRad_run.html +!! subroutine mp_wsm6_effectRad_run(do_microp_re,t,qc,qi,qs,rho,qmin,t0c,re_qc_bg,re_qi_bg,re_qs_bg, & re_qc_max,re_qi_max,re_qs_max,re_qc,re_qi,re_qs,its,ite,kts,kte, & errmsg,errflg) @@ -67,14 +76,14 @@ subroutine mp_wsm6_effectRad_run(do_microp_re,t,qc,qi,qs,rho,qmin,t0c,re_qc_bg,r real(kind=kind_phys),intent(in):: t0c real(kind=kind_phys),intent(in):: re_qc_bg,re_qi_bg,re_qs_bg real(kind=kind_phys),intent(in):: re_qc_max,re_qi_max,re_qs_max - real(kind=kind_phys),dimension(its:ite,kts:kte),intent(in):: t - real(kind=kind_phys),dimension(its:ite,kts:kte),intent(in):: qc - real(kind=kind_phys),dimension(its:ite,kts:kte),intent(in):: qi - real(kind=kind_phys),dimension(its:ite,kts:kte),intent(in):: qs - real(kind=kind_phys),dimension(its:ite,kts:kte),intent(in):: rho - real(kind=kind_phys),dimension(its:ite,kts:kte),intent(inout):: re_qc - real(kind=kind_phys),dimension(its:ite,kts:kte),intent(inout):: re_qi - real(kind=kind_phys),dimension(its:ite,kts:kte),intent(inout):: re_qs + real(kind=kind_phys),dimension(its:,:),intent(in):: t + real(kind=kind_phys),dimension(its:,:),intent(in):: qc + real(kind=kind_phys),dimension(its:,:),intent(in):: qi + real(kind=kind_phys),dimension(its:,:),intent(in):: qs + real(kind=kind_phys),dimension(its:,:),intent(in):: rho + real(kind=kind_phys),dimension(its:,:),intent(inout):: re_qc + real(kind=kind_phys),dimension(its:,:),intent(inout):: re_qi + real(kind=kind_phys),dimension(its:,:),intent(inout):: re_qs !...Output arguments: character(len=*),intent(out):: errmsg diff --git a/src/core_atmosphere/physics/physics_mmm/mynn_shared.F b/src/core_atmosphere/physics/physics_mmm/mynn_shared.F90 similarity index 99% rename from src/core_atmosphere/physics/physics_mmm/mynn_shared.F rename to src/core_atmosphere/physics/physics_mmm/mynn_shared.F90 index ee74077ba..d45da366b 100644 --- a/src/core_atmosphere/physics/physics_mmm/mynn_shared.F +++ b/src/core_atmosphere/physics/physics_mmm/mynn_shared.F90 @@ -1,6 +1,6 @@ !================================================================================================================= module mynn_shared - use mpas_kind_types,only: kind_phys => RKIND + use ccpp_kind_types,only: kind_phys implicit none private diff --git a/src/core_atmosphere/physics/physics_mmm/sf_mynn.F b/src/core_atmosphere/physics/physics_mmm/sf_mynn.F90 similarity index 99% rename from src/core_atmosphere/physics/physics_mmm/sf_mynn.F rename to src/core_atmosphere/physics/physics_mmm/sf_mynn.F90 index 9e14099eb..e36eca16a 100644 --- a/src/core_atmosphere/physics/physics_mmm/sf_mynn.F +++ b/src/core_atmosphere/physics/physics_mmm/sf_mynn.F90 @@ -59,7 +59,7 @@ module sf_mynn !NOTE: This code was primarily tested in combination with the RUC LSM. ! Performance with the Noah (or other) LSM is relatively unknown. !------------------------------------------------------------------- - use ccpp_kinds,only: kind_phys + use ccpp_kind_types,only: kind_phys use mynn_shared,only: esat_blend,qsat_blend,xl_blend implicit none @@ -142,7 +142,7 @@ subroutine sf_mynn_run( & iz0tlnd,its,ite,errmsg,errflg, & sgsgustcu,hfx_spr,lh_spr, & config_gf_gustf & - ) + ) implicit none !================================================================================================================= diff --git a/src/core_atmosphere/physics/physics_mmm/sf_sfclayrev.F b/src/core_atmosphere/physics/physics_mmm/sf_sfclayrev.F90 similarity index 92% rename from src/core_atmosphere/physics/physics_mmm/sf_sfclayrev.F rename to src/core_atmosphere/physics/physics_mmm/sf_sfclayrev.F90 index 6ca81441a..d05ff3e45 100644 --- a/src/core_atmosphere/physics/physics_mmm/sf_sfclayrev.F +++ b/src/core_atmosphere/physics/physics_mmm/sf_sfclayrev.F90 @@ -1,14 +1,12 @@ !================================================================================================================= module sf_sfclayrev - use ccpp_kinds,only: kind_phys + use ccpp_kind_types,only: kind_phys implicit none private - public:: sf_sfclayrev_run, & - sf_sfclayrev_init, & - sf_sfclayrev_final, & - sf_sfclayrev_timestep_init, & - sf_sfclayrev_timestep_final + public:: sf_sfclayrev_run, & + sf_sfclayrev_init, & + sf_sfclayrev_finalize real(kind=kind_phys),parameter:: vconvc= 1. @@ -22,58 +20,9 @@ module sf_sfclayrev !================================================================================================================= - subroutine sf_sfclayrev_timestep_init(dz2d,u2d,v2d,qv2d,p2d,t2d,dz1d,u1d,v1d,qv1d,p1d,t1d, & - its,ite,kts,kte,errmsg,errflg) -!================================================================================================================= - -!--- input arguments: - integer,intent(in):: its,ite,kts,kte - - real(kind=kind_phys),intent(in),dimension(its:ite,kts:kte):: & - dz2d,u2d,v2d,qv2d,p2d,t2d - -!--- output arguments: - character(len=*),intent(out):: errmsg - integer,intent(out):: errflg - - real(kind=kind_phys),intent(out),dimension(its:ite):: & - dz1d,u1d,v1d,qv1d,p1d,t1d - -!--- local variables: - integer:: i - -!----------------------------------------------------------------------------------------------------------------- - - do i = its,ite - dz1d(i) = dz2d(i,kts) - u1d(i) = u2d(i,kts) - v1d(i) = v2d(i,kts) - qv1d(i) = qv2d(i,kts) - p1d(i) = p2d(i,kts) - t1d(i) = t2d(i,kts) - enddo - - errmsg = 'sf_sfclayrev_timestep_init OK' - errflg = 0 - - end subroutine sf_sfclayrev_timestep_init - -!================================================================================================================= - subroutine sf_sfclayrev_timestep_final(errmsg,errflg) -!================================================================================================================= - -!--- output arguments: - character(len=*),intent(out):: errmsg - integer,intent(out):: errflg - -!----------------------------------------------------------------------------------------------------------------- - - errmsg = 'sf_sfclayrev_timestep_final OK' - errflg = 0 - - end subroutine sf_sfclayrev_timestep_final - -!================================================================================================================= +!>\section arg_table_sf_sfclayrev_init +!!\html\include sf_sfclayrev_init.html +!! subroutine sf_sfclayrev_init(errmsg,errflg) !================================================================================================================= @@ -105,7 +54,10 @@ subroutine sf_sfclayrev_init(errmsg,errflg) end subroutine sf_sfclayrev_init !================================================================================================================= - subroutine sf_sfclayrev_final(errmsg,errflg) +!>\section arg_table_sf_sfclayrev_finalize +!!\html\include sf_sfclayrev_finalize.html +!! + subroutine sf_sfclayrev_finalize(errmsg,errflg) !================================================================================================================= !--- output arguments: @@ -114,12 +66,15 @@ subroutine sf_sfclayrev_final(errmsg,errflg) !----------------------------------------------------------------------------------------------------------------- - errmsg = 'sf_sfclayrev_final OK' + errmsg = 'sf_sfclayrev_finalize OK' errflg = 0 - end subroutine sf_sfclayrev_final + end subroutine sf_sfclayrev_finalize !================================================================================================================= +!>\section arg_table_sf_sfclayrev_run +!!\html\include sf_sfclayrev_run.html +!! subroutine sf_sfclayrev_run(ux,vx,t1d,qv1d,p1d,dz8w1d, & cp,g,rovcp,r,xlv,psfcpa,chs,chs2,cqs2, & cpm,pblh,rmol,znt,ust,mavail,zol,mol, & @@ -128,8 +83,8 @@ subroutine sf_sfclayrev_run(ux,vx,t1d,qv1d,p1d,dz8w1d, & u10,v10,th2,t2,q2,flhc,flqc,qgh, & qsfc,lh,gz1oz0,wspd,br,isfflx,dx, & svp1,svp2,svp3,svpt0,ep1,ep2, & - karman,eomeg,stbolt,p1000mb, & - shalwater_z0,water_depth,shalwater_depth, & + karman,p1000mb,lakemask, & + shalwater_z0,water_depth, & isftcflx,iz0tlnd,scm_force_flux, & ustm,ck,cka,cd,cda, & its,ite,errmsg,errflg & @@ -137,28 +92,28 @@ subroutine sf_sfclayrev_run(ux,vx,t1d,qv1d,p1d,dz8w1d, & !================================================================================================================= !--- input arguments: - integer,intent(in):: its,ite + logical,intent(in):: isfflx + logical,intent(in):: shalwater_z0 + logical,intent(in),optional:: scm_force_flux - integer,intent(in):: isfflx - integer,intent(in):: shalwater_z0 + integer,intent(in):: its,ite integer,intent(in),optional:: isftcflx, iz0tlnd - integer,intent(in),optional:: scm_force_flux real(kind=kind_phys),intent(in):: svp1,svp2,svp3,svpt0 - real(kind=kind_phys),intent(in):: ep1,ep2,karman,eomeg,stbolt - real(kind=kind_phys),intent(in):: P1000mb + real(kind=kind_phys),intent(in):: ep1,ep2,karman + real(kind=kind_phys),intent(in):: p1000mb real(kind=kind_phys),intent(in):: cp,g,rovcp,r,xlv - real(kind=kind_phys),intent(in):: shalwater_depth - real(kind=kind_phys),intent(in),dimension(its:ite):: & + real(kind=kind_phys),intent(in),dimension(its:):: & mavail, & pblh, & psfcpa, & tsk, & xland, & + lakemask, & water_depth - real(kind=kind_phys),intent(in),dimension(its:ite):: & + real(kind=kind_phys),intent(in),dimension(its:):: & dx, & dz8w1d, & ux, & @@ -171,7 +126,7 @@ subroutine sf_sfclayrev_run(ux,vx,t1d,qv1d,p1d,dz8w1d, & character(len=*),intent(out):: errmsg integer,intent(out):: errflg - real(kind=kind_phys),intent(out),dimension(its:ite):: & + real(kind=kind_phys),intent(out),dimension(its:):: & lh, & u10, & v10, & @@ -179,14 +134,14 @@ subroutine sf_sfclayrev_run(ux,vx,t1d,qv1d,p1d,dz8w1d, & t2, & q2 - real(kind=kind_phys),intent(out),dimension(its:ite),optional:: & + real(kind=kind_phys),intent(out),dimension(its:),optional:: & ck, & cka, & cd, & cda !--- inout arguments: - real(kind=kind_phys),intent(inout),dimension(its:ite):: & + real(kind=kind_phys),intent(inout),dimension(its:):: & regime, & hfx, & qfx, & @@ -211,7 +166,7 @@ subroutine sf_sfclayrev_run(ux,vx,t1d,qv1d,p1d,dz8w1d, & flqc, & qgh - real(kind=kind_phys),intent(inout),dimension(its:ite),optional:: & + real(kind=kind_phys),intent(inout),dimension(its:),optional:: & ustm !--- local variables: @@ -219,6 +174,7 @@ subroutine sf_sfclayrev_run(ux,vx,t1d,qv1d,p1d,dz8w1d, & real(kind=kind_phys),parameter:: xka = 2.4e-5 real(kind=kind_phys),parameter:: prt = 1. + real(kind=kind_phys),parameter:: salinity_factor = 0.98 real(kind=kind_phys):: pl,thcon,tvcon,e1 real(kind=kind_phys):: zl,tskv,dthvdz,dthvm,vconv,rzol,rzol2,rzol10,zol2,zol10 @@ -320,9 +276,11 @@ subroutine sf_sfclayrev_run(ux,vx,t1d,qv1d,p1d,dz8w1d, & thvx(i)=thx(i)*tvcon scr4(i)=scr3(i)*tvcon 50 continue -! +! do 60 i=its,ite e1=svp1*exp(svp2*(tgdsa(i)-svpt0)/(tgdsa(i)-svp3)) + !the saturation vapor pressure for salty water is on average 2% lower + if(xland(i).gt.1.5 .and. lakemask(i).eq.0.) e1=e1*salinity_factor !for land points qsfc can come from previous time step if(xland(i).gt.1.5.or.qsfc(i).le.0.0)qsfc(i)=ep2*e1/(psfc(i)-e1) !QGH CHANGED TO USE LOWEST-LEVEL AIR TEMP CONSISTENT WITH MYJSFC CHANGE @@ -333,7 +291,7 @@ subroutine sf_sfclayrev_run(ux,vx,t1d,qv1d,p1d,dz8w1d, & cpm(i)=cp*(1.+0.8*qx(i)) 60 continue 80 continue - + !-----COMPUTE THE HEIGHT OF FULL- AND HALF-SIGMA LEVELS ABOVE GROUND ! LEVEL, AND THE LAYER THICKNESSES. @@ -823,7 +781,7 @@ subroutine sf_sfclayrev_run(ux,vx,t1d,qv1d,p1d,dz8w1d, & !-----COMPUTE THE SURFACE SENSIBLE AND LATENT HEAT FLUXES: if(present(scm_force_flux) ) then - if(scm_force_flux.eq.1) goto 350 + if(scm_force_flux) goto 350 endif do i = its,ite qfx(i)=0. @@ -831,15 +789,15 @@ subroutine sf_sfclayrev_run(ux,vx,t1d,qv1d,p1d,dz8w1d, & enddo 350 continue - if(isfflx.eq.0) goto 410 - + if(.not. isfflx) goto 410 + !-----OVER WATER, ALTER ROUGHNESS LENGTH (ZNT) ACCORDING TO WIND (UST). do 360 i = its,ite if((xland(i)-1.5).ge.0)then ! znt(i)=czo*ust(i)*ust(i)/g+ozo ! PSH - formulation for depth-dependent roughness from ! ... Jimenez and Dudhia, 2018 - if(shalwater_z0 .eq. 1) then + if(shalwater_z0) then znt(i) = depth_dependent_z0(water_depth(i),znt(i),ust(i)) else !Since V3.7 (ref: EC Physics document for Cy36r1) @@ -892,15 +850,15 @@ subroutine sf_sfclayrev_run(ux,vx,t1d,qv1d,p1d,dz8w1d, & !IF(IDRY.EQ.1)GOTO 390 ! if(present(scm_force_flux)) then - if(scm_force_flux.eq.1) goto 405 + if(scm_force_flux) goto 405 endif do 370 i = its,ite qfx(i)=flqc(i)*(qsfc(i)-qx(i)) - qfx(i)=amax1(qfx(i),0.) +! qfx(i)=amax1(qfx(i),0.) lh(i)=xlv*qfx(i) 370 continue - + !-----COMPUTE SURFACE HEAT FLUX: ! 390 continue @@ -915,7 +873,7 @@ subroutine sf_sfclayrev_run(ux,vx,t1d,qv1d,p1d,dz8w1d, & ! endif elseif(xland(i)-1.5.lt.0.)then hfx(i)=flhc(i)*(thgb(i)-thx(i)) - hfx(i)=amax1(hfx(i),-250.) +! hfx(i)=amax1(hfx(i),-250.) endif 400 continue @@ -942,7 +900,7 @@ subroutine sf_sfclayrev_run(ux,vx,t1d,qv1d,p1d,dz8w1d, & cqs2(i)=ust(i)*karman/denomq2(i) chs2(i)=ust(i)*karman/denomt2(i) enddo - + 410 continue !jdf diff --git a/src/core_atmosphere/physics/physics_monan/Makefile b/src/core_atmosphere/physics/physics_monan/Makefile index e02b6c7e5..9fb7c0c1d 100644 --- a/src/core_atmosphere/physics/physics_monan/Makefile +++ b/src/core_atmosphere/physics/physics_monan/Makefile @@ -34,7 +34,7 @@ clean: .F.o: ifeq "$(GEN_F90)" "true" $(CPP) $(CPPFLAGS) $(COREDEF) $(CPPINCLUDES) $< > $*.f90 - $(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES) -I.. -I../physics_mmm -I../../../framework -I../../../external/esmf_time_f90 + $(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES) -I./ -I.. -I../physics_mmm -I../../../framework -I../../../external/esmf_time_f90 else - $(FC) $(CPPFLAGS) $(COREDEF) $(FFLAGS) -c $*.F $(CPPINCLUDES) $(FCINCLUDES) -I.. -I../physics_mmm -I../../../framework -I../../../external/esmf_time_f90 + $(FC) $(CPPFLAGS) $(COREDEF) $(FFLAGS) -c $*.F $(CPPINCLUDES) $(FCINCLUDES) -I./ -I.. -I../physics_mmm -I../../../framework -I../../../external/esmf_time_f90 endif diff --git a/src/core_atmosphere/physics/physics_monan/module_bl_mixingscalars.F b/src/core_atmosphere/physics/physics_monan/module_bl_mixingscalars.F index 9a6c6a3da..c409e8982 100644 --- a/src/core_atmosphere/physics/physics_monan/module_bl_mixingscalars.F +++ b/src/core_atmosphere/physics/physics_monan/module_bl_mixingscalars.F @@ -10,7 +10,7 @@ module module_pbl_scalars ! !================================================================================================================= ! A routine to calculate the dry mixing in PBL for scalars not included in the MYNN routine. - ! This is strongly based on "mynn_mix_chem" routine in the file 'bl_mynn_subroutines.F' + ! This is mostly based on "mynn_mix_chem" routine in the file 'bl_mynn_subroutines.F' ! Saulo R. Freitas - 19 Sep 2024 (send comments to saulo.freitas@inpe.br) !================================================================================================================= subroutine driver_pbl_scalars (itimestep,diag_physics,configs,state,mesh,time_lev,its,ite,kts,kte,dt_pbl) @@ -70,11 +70,13 @@ subroutine driver_pbl_scalars (itimestep,diag_physics,configs,state,mesh,time_le nscalars = nscalars + 1 index_scalar(nscalars) = index_buoyx endif - call mpas_pool_get_dimension(state,'index_cnvcf',index_cnvcf) - if(index_cnvcf > 0) then - nscalars = nscalars + 1 - index_scalar(nscalars) = index_cnvcf - endif + ! + !--- srf 15/02/2026 not mixing convective cloud fraction + !call mpas_pool_get_dimension(state,'index_cnvcf',index_cnvcf) + !if(index_cnvcf > 0) then + ! nscalars = nscalars + 1 + ! index_scalar(nscalars) = index_cnvcf + !endif !--- if no scalar to be mixed, make a "U-turn" if(nscalars == 0) return diff --git a/src/core_atmosphere/physics/physics_monan/module_cu_gf.monan.F b/src/core_atmosphere/physics/physics_monan/module_cu_gf.monan.F index a5052bfe6..2c78d34f1 100644 --- a/src/core_atmosphere/physics/physics_monan/module_cu_gf.monan.F +++ b/src/core_atmosphere/physics/physics_monan/module_cu_gf.monan.F @@ -97,17 +97,14 @@ module module_cu_gf_monan ,cum_hei_down_ocean,cum_hei_updf_land, cum_hei_updf_ocean & ,use_momentum_transp,cum_entr_rate & ,nmp, lsmp, cnmp,moist_trigger,frac_modis,max_tq_tend & - ,cum_use_excess, cum_ave_layer & - ,use_smooth_prof, output_sound,use_cloud_dissipation & - ,cum_use_smooth_tend,beta_sh,c0_shal & - ,use_linear_subcl_mf,cap_maxs,liq_ice_number_conc & - ,sig_factor,lcl_trigger, add_coldpool_prop & + ,cum_use_excess, cum_ave_layer,use_smooth_prof, output_sound & + ,use_cloud_dissipation,cum_use_smooth_tend,beta_sh,c0_shal & + ,use_linear_subcl_mf,cap_maxs,liq_ice_number_conc,sig_factor & ,add_coldpool_clos,add_coldpool_trig,mx_buoy1, mx_buoy2, cum_t_star& - ,add_coldpool_diff,n_cldrop,use_gustiness, use_random_num & - ,modConvParGF_initialized,use_pass_cloudvol & + ,n_cldrop,use_random_num,modConvParGF_initialized,use_pass_cloudvol& ,use_lcl_ctrl_entr,use_rhu_ctrl_entr,cum_min_cloud_depth,use_sub3d & ,cum_fr_min_entr,use_shear_ctrl_entr,use_cwv_ctrl_entr,adv_trigger & - ,dcape_threshold,use_cold_start + ,dcape_threshold,use_cold_start,tu_buoyx public makeDropletNumber,makeIceNumber,FractLiqF & ,coldPoolStart,readGFConvParNML,initModConvParGF,cu_gf_monan_driver& @@ -146,8 +143,8 @@ module module_cu_gf_monan !-- gross entrainment rate: deep, shallow, congestus real, dimension(maxiens) :: cum_entr_rate != (/& ! 6.3e-4 & !deep - !,1.0e-3 & !shallow - !,5.0e-4 & !mid + !,1.3e-3 & !shallow + !,2.0e-3 & !mid !/) integer, parameter :: opt = 1 @@ -177,14 +174,10 @@ module module_cu_gf_monan integer :: use_memory != -1/0/1/2 .../10 !- - integer :: add_coldpool_prop != -1,0,1,2,3 add coldpool propagation - integer :: add_coldpool_clos ! add the the mass flux associated to the W @ leading of the gust front integer :: add_coldpool_trig ! add triggering criteria based on cold pool presence - integer :: add_coldpool_diff ! add vert/horizontal diffusion to the cold pool propaga - integer :: use_scale_dep != 0/1: scale dependence flag, default = 1 integer :: dicycle != 0/1/2: diurnal cycle closure, default = 1 @@ -254,8 +247,6 @@ module module_cu_gf_monan integer :: moist_trigger != relative humidity effects on the cap_max trigger function integer :: frac_modis != use fraction liq/ice content derived from modis/calipo sensors - integer :: lcl_trigger != greater than zero, activates the lcl trigger which requires the lcl height - != be lower than the pbl height, only for shallow convection integer :: output_sound != outputs a vertical profile for the gf stand alone model integer :: use_sub3d !=0,1,2 : > 0 activates the 3d subsidence lateral spreading @@ -263,8 +254,8 @@ module module_cu_gf_monan real :: tau_land_cp != cold pool lifetime over land real :: mx_buoy1 != 250.5 J/kg real :: mx_buoy2 != 20004.0 J/kg: temp exc=10 K, q deficit=4 g/kg (=> mx_buoy ~ 20 kJ/kg) + real :: tu_buoyx real :: use_cloud_dissipation != to acccount for the cloud dissipation at the decayment phase - integer :: use_gustiness != not in use real :: use_random_num != stochastic pertubation for the height of maximum Zu real :: beta_sh != only for shallow plume integer :: use_linear_subcl_mf != only for shallow plume @@ -291,9 +282,11 @@ module module_cu_gf_monan integer :: use_excess != default= 1 - use for t,q excess sub-grid scale variability integer :: use_smooth_tend != default 1,1,1, + !--- make less restrictive the activation of deep convection on the first 24h time integration integer :: use_cold_start != 0/1 default 0 - real :: fac_cold_start = 1 - !-- General internal controls for the diverse options in GF + real :: fac_cold_start = 1.0 + + !--- General internal controls for the diverse options in GF logical, parameter :: melt_glac = .true. != turn on/off ice phase/melting @@ -305,13 +298,16 @@ module module_cu_gf_monan logical :: use_inv_layers=.false. ! - !- proportionality constant to estimate pressure - !- gradient of updraft (Zhang and Wu, 2003, JAS) => REAL, PARAMETER :: pgcon=-0.55 + !--- proportionality constant to estimate pressure + !--- gradient of updraft (Zhang and Wu, 2003, JAS) => REAL, PARAMETER :: pgcon=-0.55 real, parameter :: pgcon= 0.0 + !--- new entrainment formulation which uses the lateral entrainment rate as a trigger function real, parameter :: delta_ref= 30.e+3 & ! meters - ,entr_ref = 8.e-4 ! ref entrainment for dx = 30000 m - + ,entr_ref = 1.2e-3 ! ref entrainment for dx = 30000 m + real, parameter, dimension(2) :: entr_red = (/1.,0.333/) + ! + !--- for tracer transport integer, parameter :: MAX_NSPEC=200 integer ,dimension(MAX_NSPEC) :: ind_chem character(len=100),dimension(MAX_NSPEC) :: CHEM_NAME @@ -329,6 +325,7 @@ module module_cu_gf_monan integer :: nrec = 0, ntimes = 0 real :: int_time = 0. + integer :: vec_max_size !! max size control loop vector can assume type(vector_t) :: vec_ok @@ -733,7 +730,7 @@ subroutine cu_gf_monan_driver( & !- cloud fraction cnvcf2d (k,i) = cnvcf(i,k,j) !-buoyancy excess - buoyx2d(k,i) = buoyx(i,k,j) + buoyx2d(k,i) = buoyx(i,k,j) * tu_buoyx !-- turb length scale turb_len_scale2d (k,i) = turb_len_scale (i,k,j) end do @@ -1002,12 +999,13 @@ subroutine cu_gf_monan_driver( & !-- set the temp and water vapor anomalies from the sub-grid scale variability call set_Tq_pertub (use_excess,its,ite,itf,xlandi,ztexec,zqexec,cum_ztexec,cum_zqexec) ! - call CUP_GF(its,ite,kts,kte, itf,ktf, mtp, nmp, FSCAV & + call CUP_GF(its,ite,kts,kte, itf,ktf, mtp, FSCAV & ,cumulus_type (plume) & ,closure_choice(plume) & ,cum_entr_rate (plume) & - ,cum_use_excess(plume) & !- input data + ,mpas_cape (:,j) & + ,mpas_cin (:,j) & ,dx2d (:,j) & ,stochastic_sig(:,j) & ,col_sat (:,j) & @@ -1270,8 +1268,8 @@ subroutine cu_gf_monan_driver( & do k = kts,kte rbuoyxcuten (i,k,j) = - min(0.,( outbuoy(k,i,shal) + & outbuoy(k,i, mid) + & - outbuoy(k,i,deep) ) *fixout_qv(i)) - var3d1 (i,k,j) = rbuoyxcuten (i,k,j) + outbuoy(k,i,deep) ) * fixout_qv(i)) * tu_buoyx + var3d1 (i,k,j) = rbuoyxcuten (i,k,j) enddo enddo endif @@ -1311,6 +1309,12 @@ subroutine cu_gf_monan_driver( & up_massdetr5d(k,i,j,mid ) + & up_massdetr5d(k,i,j,deep) ) *fixout_qv(i) & /(dz8w(i,k,j) * rho(i,k,j)) + !--- adding in-updraft cloud fraction + rcnvcfcuten (i,k,j) = rcnvcfcuten (i,k,j) + & + ( conv_cld_fr5d(k,i,j,shal) + & + conv_cld_fr5d(k,i,j,mid ) + & + conv_cld_fr5d(k,i,j,deep) ) *fixout_qv(i) / dt + enddo enddo endif @@ -1463,13 +1467,14 @@ subroutine cu_gf_monan_driver( & end subroutine cu_gf_monan_driver !--------------------------------------------------------------------------------------------------- - subroutine CUP_GF (its,ite,kts,kte ,itf,ktf, mtp, nmp & + subroutine CUP_GF (its,ite,kts,kte ,itf,ktf, mtp & ,fscav & ,cumulus & ,ichoice & ,entr_rate_input & - ,use_excess & !input data + ,mpas_cape & + ,mpas_cin & ,dx & ,stochastic_sig & ,col_sat & @@ -1567,7 +1572,7 @@ subroutine CUP_GF (its,ite,kts,kte ,itf,ktf, mtp, nmp & implicit none character*(*),intent(in) :: cumulus - integer ,intent(in) :: itf,ktf,its,ite,kts,kte,ichoice,use_excess,mtp, nmp + integer ,intent(in) :: itf,ktf,its,ite,kts,kte,ichoice,mtp integer ,intent(inout), dimension (:) :: kpbl ! ! outtem = output temp tendency (per s) @@ -1591,7 +1596,9 @@ subroutine CUP_GF (its,ite,kts,kte ,itf,ktf, mtp, nmp & ,h_sfc_flux,le_sfc_flux,tsur,dx & ,zlcl_sfc - real, dimension (:) ,intent (in ) :: col_sat,stochastic_sig,tke_pbl + real, dimension (:) ,intent (in ) :: col_sat,stochastic_sig,tke_pbl & + ,mpas_cape,mpas_cin + real, dimension (:) ,intent (inout) :: zws,ztexec,zqexec,wlpool real ,intent (in ) :: dtime,entr_rate_input real, dimension (:,:,:),intent (inout) :: mpqi,mpql,mpcf @@ -1712,8 +1719,7 @@ subroutine CUP_GF (its,ite,kts,kte ,itf,ktf, mtp, nmp & ,massfld,dh,trash,frh,xlamdd,radiusd,frhd,effec_entrain,detdo1,detdo2,entdo & ,dp,subin,detdo,entup,detup,subdown,entdoj,entupk,detupk,totmas,min_entr_rate & ,tot_time_hr,beta,env_mf,env_mf_p,env_mf_m,dts,denom,denomU - - integer :: ipr=0,jpr=0 + integer :: ipr=0,jpr=0,step_ent,ii integer :: k,i,iedt,nens,nens3,kii,kff integer :: vtp_index @@ -1730,7 +1736,7 @@ subroutine CUP_GF (its,ite,kts,kte ,itf,ktf, mtp, nmp & ,vvel1d, x_add_buoy,lambau_dn,lambau_dp,q_wetbulb,t_wetbulb,col_sat_adv & ,Q_adv,alpha_adv,aa1_radpbl,p_cwv_ave,cape, depth_neg_buoy,frh_bcon & ,check_sig,random,rh_entr_factor,rntot,delqev,delq2,qevap,rn,qcond,rainevap,vshear2& - ,entr_rescaled,overshoot_rescaled,precip_rescaled + ,entr_rescaled,precip_rescaled real, dimension (kts:kte) ::xh_env_eff @@ -1778,11 +1784,11 @@ subroutine CUP_GF (its,ite,kts,kte ,itf,ktf, mtp, nmp & endif !---------------------------------------------------------------------- ! - !-- init the vector vec_ok with the all indexes to process + !--- init the vector vec_ok with the all indexes to process vec_max_size = ite - its + 1 call init(vec_ok, vec_max_size) call insert_range(vec_ok, its, ite) - !-- vec removed will be inserted when removing + !--- vec removed will be inserted when removing call init(vec_removed, vec_max_size) ! @@ -1794,7 +1800,7 @@ subroutine CUP_GF (its,ite,kts,kte ,itf,ktf, mtp, nmp & call get_lambdaU(cumulus,itf,ktf,its,ite,kts,kte,lambau_dp,lambau_dn & ,lambau_deep,lambau_shdn,pgcon) ! - !-- init/reset 1-d and 2-d local vars + !--- init/reset 1-d and 2-d local vars call reset_1d(its,ite,ierrc,xland,xland1,aa0,aa1,aa2,aa3 & ,aa1_bl,aa1_fa,aa0_bl,q_adv,aa1_radpbl,alpha_adv,cin1 & ,xk_x,edt,edto,tau_bl,q_wetbulb,t_wetbulb,tau_ecmwf,xf_dicycle & @@ -1808,7 +1814,7 @@ subroutine CUP_GF (its,ite,kts,kte ,itf,ktf, mtp, nmp & if( cumulus == 'deep' .and. use_random_num > 1.e-6) & call gen_random(its,ite,use_random_num,random) ! - !-- define limits of evaporation by the downdrafts + !--- define limits of evaporation by the downdrafts call get_edt(cumulus,itf,ktf,its,ite,kts,kte,xland,edtmin,edtmax,max_edt_ocean,max_edt_land & ,c0_mid) ! @@ -1838,101 +1844,93 @@ subroutine CUP_GF (its,ite,kts,kte ,itf,ktf, mtp, nmp & ,heso_cup,zo_cup,po_cup,gammao_cup ,tn_cup,psur,tsur,ierr,z1 & ,itf,ktf,its,ite, kts,kte) ! - !-- partition between liq/ice cloud contents + !--- partition between liq/ice cloud contents ! call get_partition_liq_ice(ierr,tn,z1,zo_cup,po_cup,p_liq_ice,melting_layer & ,itf,ktf,its,ite,kts,kte,cumulus) ! - !-- get several indexes + !--- get several indexes ! call get_kbmax_kdet_k22(cumulus,itf,ktf,its,ite,kts,kte,ierr,ierrc,z1,zo_cup,heo_cup& ,depth_min,z_detr,zkbmax,kbmax,kdet,k22,kstabm) ! - !-- define entrainment/detrainment profiles for updrafts - ! - !- reescale entrainment rate in terms of the grid spacing (Zhao et al 2024, GRL https://doi.org/10.1029/2024GL110735) - if(entr_rate_input < 0.0 .and. trim(cumulus) == 'deep') then - entr_rescaled(:) = (delta_ref/dx(:))**0.2 * fac_cold_start - entr_rate (:) = entr_ref * entr_rescaled(:) - min_entr_rate = entr_ref * fr_min_entr * minval(entr_rescaled) - overshoot_rescaled(:) = min(0.7, overshoot * entr_rescaled(:)) - else - !-- initial entrainment rate and the mininum acceptable entrainment rate - entr_rate(:) = entr_rate_input * fac_cold_start - min_entr_rate = entr_rate_input * fr_min_entr - overshoot_rescaled(:) = overshoot * fac_cold_start - endif - ! - !-- controls of LCL and PBL turbulence on the entrainment rate - if(use_lcl_ctrl_entr > 0 ) then - call get_lcl2(cumulus,ave_layer,its,ite,itf,kts,kte,ktf,ierr,zqexec,ztexec,xland & - ,po,t_cup,p_cup,z_cup,q_cup,k22,klcl,kpbl,psur,zlcl_sfc) - call LCL_and_PBL_ctrl_on_entrainment(cumulus,its,ite,itf,kts,kte,ktf,min_entr_rate & - ,entr_rate,zlcl_sfc,turb_len_scale) - endif - ! - !-- cold pool parameterization and convective memory - ! - if (convection_tracer == 1 .and. trim(cumulus) /= 'shallow') then - call coldPoolConvMem(cumulus,its, itf, kts, kte, ktf, ztexec, zqexec & - , xland, po, buoy_exc, ierr, cap_max, wlpool, x_add_buoy & - , min_entr_rate, entr_rate) - end if - ! - if( use_shear_ctrl_entr >= 0 .and. trim(cumulus) == 'deep') & - call get_entr_vshear(cumulus,ierr,us,vs,zo,ktop,kbcon,klcl,po,po_cup,itf,ktf,its,ite, kts,kte & - ,min_entr_rate,entr_rate, vshear2,var2d2,qo,x_add_buoy,zqexec,precip_rescaled ) - ! - !-- get the pickup of ensemble ave prec, following Neelin et al 2009. - if( use_cwv_ctrl_entr == 1 .and. trim(cumulus) == 'deep') & - call precip_cwv_factor(itf,ktf,its,ite,kts,kte,ierr,tn,po,qo,po_cup,cumulus,p_cwv_ave & - ,min_entr_rate,entr_rate,var2d1) - ! + !--- define entrainment/detrainment profiles for updrafts ! - !-- determine LCL for the air parcels around K22 - ! - call get_lcl(cumulus,convection_tracer,use_memory,ave_layer,its,ite,itf,kts,kte,ktf,ierr & - ,x_add_buoy,zqexec,ztexec,xland,po,t_cup,p_cup,z_cup,q_cup,k22,klcl) + step_ent = 1; if(entr_rate_input < 0.0) step_ent = 2 - !--- start_level - ! - start_level(:)= KLCL(:) !start_level(:)= KTS - ! - !-- check if LCL height is below PBL height to allow shallow convection - ! - if(lcl_trigger > 0 .and. cumulus == 'shallow')then - do vtp_index = get_num_elements(vec_ok),1,-1 - i = get_data_value(vec_ok,vtp_index) - if(klcl(i) > max(1,kpbl(i)-lcl_trigger)) then - ierr(i)=21 ; is_removed = remove(vec_ok, i) - ierrc(i)='for shallow convection: LCL height < PBL height' - endif - enddo - endif - ! - !--- determine the vertical entrainment/detrainment rates, the level of convective cloud base -kbcon- - !--- and the scale dependence factor (sig). - ! - call set_entr_detr_rates(cumulus,its,ite,itf,kts,kte,ktf,ierr,klcl,min_entr_rate,entr_rate & - ,entr_rate_2d,cd,mentrd_rate,cdd,qo_cup, qeso_cup,cnvcf,zo_cup) - ! - if( trim(cumulus) == 'deep') entr_rate_2d_initial(:,:) = entr_rate_2d(:,:) !<<<<<<<< tmp - ! - !--- determine the moist static energy of air parcels at source level - ! - do vtp_index = get_num_elements(vec_ok),1,-1; i = get_data_value(vec_ok,vtp_index) - x_add = (c_alvl*zqexec(i)+c_cp*ztexec(i)) + x_add_buoy(i) - call get_cloud_bc(cumulus,ave_layer,kts,kte,ktf,xland(i),po(kts:kte,i),he_cup (kts:kte,i),hkb (i),k22(i),x_add) - call get_cloud_bc(cumulus,ave_layer,kts,kte,ktf,xland(i),po(kts:kte,i),heo_cup(kts:kte,i),hkbo(i),k22(i),x_add) - enddo - ! - !--- determine the level of convective cloud base - kbcon - ! - call cup_cloud_limits(cumulus,ierrc,ierr,cap_max_increment,cap_max,heo_cup,heso_cup,qo_cup & - ,qeso_cup,po,po_cup,zo_cup,heo,hkbo,qo,qeso,entr_rate_2d,hcot,k22,kbmax & - ,klcl,kbcon,ktop,depth_neg_buoy,frh_bcon,start_level,use_excess,max_ktop & - ,zqexec,ztexec,x_add_buoy,xland,cnvcf,heso,wlpool,overshoot_rescaled & - ,itf,ktf,its,ite, kts,kte) + loop_entr_trigger: do ii = 1,step_ent + ! + !--- define the initial entrainment rate and the mininum acceptable entrainment rate + !--- formulation 1: reescale entrainment rate in terms of the grid spacing (Zhao et al 2024, GRL https://doi.org/10.1029/2024GL110735) + !--- and also use larger initial entrainment rate as trigger function + if( entr_rate_input < 0.0 ) then + entr_rescaled(:) = (delta_ref/dx(:))**0.2 * fac_cold_start + entr_rate (:) = entr_ref * entr_rescaled(:) * entr_red(ii) + min_entr_rate = entr_ref * fr_min_entr * minval(entr_rescaled) + else + !--- formulation 2: using the namelist definition + entr_rate(:) = entr_rate_input * fac_cold_start + min_entr_rate = entr_rate_input * fr_min_entr + endif + ! + !--- controls of LCL and PBL turbulence on the entrainment rate + if(use_lcl_ctrl_entr > 0 ) then + call get_lcl2(cumulus,ave_layer,its,ite,itf,kts,kte,ktf,ierr,zqexec,ztexec,xland & + ,po,t_cup,p_cup,z_cup,q_cup,k22,klcl,kpbl,psur,zlcl_sfc) + call LCL_and_PBL_ctrl_on_entrainment(cumulus,its,ite,itf,kts,kte,ktf,min_entr_rate & + ,entr_rate,zlcl_sfc,turb_len_scale) + endif + ! + !--- cold pool parameterization and convective memory + ! + if (convection_tracer == 1 .and. trim(cumulus) /= 'shallow') then + call coldPoolConvMem(cumulus,its,itf,kts,kte,ktf,ztexec,zqexec,xland,po,buoy_exc & + ,ierr,cap_max,wlpool,x_add_buoy,min_entr_rate,entr_rate) + end if + ! + if( use_shear_ctrl_entr >= 0 .and. trim(cumulus) == 'deep') & + call get_entr_vshear(cumulus,ierr,us,vs,zo,ktop,kbcon,klcl,po,po_cup,itf,ktf,its,ite, kts,kte & + ,min_entr_rate,entr_rate, vshear2,var2d2,qo,x_add_buoy,zqexec,precip_rescaled & + ,overshoot,mpas_cape,mpas_cin) + ! + !--- get the pickup of ensemble ave prec, following Neelin et al 2009. + if( use_cwv_ctrl_entr == 1 .and. trim(cumulus) == 'deep') & + call precip_cwv_factor(itf,ktf,its,ite,kts,kte,ierr,tn,po,qo,po_cup,cumulus,p_cwv_ave & + ,min_entr_rate,entr_rate,var2d1) + ! + !--- determine LCL for the air parcels around K22 + ! + call get_lcl(cumulus,convection_tracer,use_memory,ave_layer,its,ite,itf,kts,kte,ktf,ierr & + ,x_add_buoy,zqexec,ztexec,xland,po,t_cup,p_cup,z_cup,q_cup,k22,klcl) + ! + !--- start_level + ! + start_level(:)= KLCL(:) !start_level(:)= KTS + ! + !--- determine the vertical entrainment/detrainment profiles + ! + call set_entr_detr_rates(cumulus,its,ite,itf,kts,kte,ktf,ierr,klcl,min_entr_rate,entr_rate & + ,entr_rate_2d,cd,mentrd_rate,cdd,qo_cup, qeso_cup,cnvcf,zo_cup) + ! + if( trim(cumulus) == 'deep') entr_rate_2d_initial(:,:) = entr_rate_2d(:,:) ! output only + ! + !--- determine the moist static energy of air parcels at source level + ! + do vtp_index = get_num_elements(vec_ok),1,-1; i = get_data_value(vec_ok,vtp_index) + x_add = (c_alvl*zqexec(i)+c_cp*ztexec(i)) + x_add_buoy(i) + call get_cloud_bc(cumulus,ave_layer,kts,kte,ktf,xland(i),po(kts:kte,i),he_cup (kts:kte,i),hkb (i),k22(i),x_add) + call get_cloud_bc(cumulus,ave_layer,kts,kte,ktf,xland(i),po(kts:kte,i),heo_cup(kts:kte,i),hkbo(i),k22(i),x_add) + enddo + ! + !--- determine the level of convective cloud base - kbcon, cloud top - ktop + ! + call cup_cloud_limits(cumulus,ierrc,ierr,cap_max_increment,cap_max,heo_cup,heso_cup,qo_cup & + ,qeso_cup,po,po_cup,zo_cup,heo,hkbo,qo,qeso,entr_rate_2d,hcot,k22,kbmax & + ,klcl,kbcon,ktop,depth_neg_buoy,frh_bcon,start_level,use_excess,max_ktop & + ,zqexec,ztexec,x_add_buoy,xland,cnvcf,heso,wlpool,overshoot & + ,itf,ktf,its,ite, kts,kte) + + enddo loop_entr_trigger ! !--- scale dependence factor (sig) ! @@ -2124,7 +2122,7 @@ subroutine CUP_GF (its,ite,kts,kte ,itf,ktf, mtp, nmp & ! !--- get wet bulb temperature and moisture at jmin ! - if(USE_WETBULB == 1 .and. cumulus /= 'shallow' ) then + if(use_wetbulb == 1 .and. cumulus /= 'shallow' ) then do vtp_index = get_num_elements(vec_ok),1,-1 i = get_data_value(vec_ok,vtp_index) k = jmin(i) @@ -2242,7 +2240,7 @@ subroutine CUP_GF (its,ite,kts,kte ,itf,ktf, mtp, nmp & i = get_data_value(vec_ok,vtp_index) kii=start_level(i) ; kff=ktop(i) - if(use_pass_cloudvol == 2) then + if(use_pass_cloudvol == 1) then xh_env_eff(kii:kff) = (1.-cnvcf(kii:kff,i))*xhe(kii:kff,i) + cnvcf(kii:kff,i)*xhes(kii:kff,i) else xh_env_eff(kii:kff) = xhe(kii:kff,i) @@ -2439,6 +2437,7 @@ subroutine CUP_GF (its,ite,kts,kte ,itf,ktf, mtp, nmp & do k=kts,ktf tup (k,i) = tempco(k,i) !in-updraft temp cupclw(k,i) = qrco (k,i) !in-updraft condensed water + clfrac(k,i) = (xmb(i)/sig(i)) * zuo(k,i) / (rho(k,i)*vvel2d(k,i)) !in-updradt cloud fraction end do tup (kte,i) = t_cup(kte,i) end do @@ -2449,29 +2448,27 @@ subroutine CUP_GF (its,ite,kts,kte ,itf,ktf, mtp, nmp & !var2d1(:) = aa1(:) !var2d2(:) = aa1_bl(:) var2d1(:) = vshear2(:) - !var2d1(:) = x_add_buoy(:) - if( adv_trigger == 0 .and. convection_tracer == 1) then - do i=its,itf + var2d2(:) = x_add_buoy(:) + !if( adv_trigger == 0 .and. convection_tracer == 1) then + ! do i=its,itf ! var2d2(i) = maxval( buoy_exc(kts:ktop(i),i) ) !var2d1(i) = p_cwv_ave(i) - enddo - endif - !var2d2(:) = 0.0 + ! enddo + !endif + var2d2(:) = 0.0 do vtp_index = get_num_elements(vec_ok),1,-1 i = get_data_value(vec_ok,vtp_index) trash = 1.e-12 do k=kts,ktop(i) dp=100.*(po_cup(k,i)-po_cup(k+1,i)) trash=trash+dp - !if(use_pass_cloudvol > 0 ) & - !var2d2(i) = var2d2(i) + cnvcf(k,i)*dp/c_grav + if(use_pass_cloudvol > 0 ) var2d2(i) = var2d2(i) + cnvcf(k,i)*dp/c_grav !var2d2(i) = var2d2(i) + entr_rate_2d(k,i)*dp - !if(use_pass_cloudvol == 0 ) & !var2d1(i) = var2d1(i) + entr_rate_2d_initial(k,i)*dp enddo - !var2d2(i) = var2d2(i)/trash + var2d2(i) = var2d2(i)/trash !var2d1(i) = var2d1(i)/trash enddo endif @@ -3332,7 +3329,7 @@ subroutine cup_up_moisture(name,start_level,klcl,ierr,ierrc,z_cup,qc,qrc,pw,pwav do vtp_index = get_num_elements(vec_ok),1,-1 i = get_data_value(vec_ok,vtp_index) kii=start_level(i) ; kff=ktop(i) - if(use_pass_cloudvol == 2) then + if(use_pass_cloudvol == 1) then q_env_eff(kii:kff) = (1.-cnvcf(kii:kff,i))*q(kii:kff,i) + cnvcf(kii:kff,i)*qes(kii:kff,i) else q_env_eff(kii:kff) = q(kii:kff,i) @@ -4243,15 +4240,16 @@ subroutine cup_up_cape_cin(aa0,z_cup,zu,dby,GAMMA_CUP,t_cup,klcl ,k22,kbcon,ktop aa0(i)=aa0(i)+0.5*(daa1+daa2) enddo - ! print*,trim(integ_interval),AA0(I),kbcon(i) + enddo + !print*,trim(integ_interval),maxval(AA0),minval(AA0) end subroutine cup_up_cape_cin !------------------------------------------------------------------------------------ subroutine cup_cloud_limits(cumulus,ierrc,ierr,cap_inc,cap_max_in,heo_cup,heso_cup,qo_cup & ,qeso_cup,po,po_cup,z_cup,heo,hkbo,qo,qeso,entr_rate_2d,hcot & ,k22,kbmax,klcl,kbcon,ktop,depth_neg_buoy,frh & ,start_level_,use_excess,max_ktop,zqexec,ztexec,x_add_buoy & - ,xland,cnvcf,heso,wlpool,overshoot_rescaled,itf,ktf,its,ite, kts,kte) + ,xland,cnvcf,heso,wlpool,overshoot,itf,ktf,its,ite, kts,kte) implicit none character *(*) ,intent (in ) :: cumulus @@ -4259,10 +4257,11 @@ subroutine cup_cloud_limits(cumulus,ierrc,ierr,cap_inc,cap_max_in,heo_cup,heso_c integer ,intent (in ) :: itf,ktf,its,ite, kts,kte,use_excess integer, dimension (:) ,intent (in ) :: kbmax,start_level_,max_ktop integer, dimension (:) ,intent (inout) :: kbcon,ierr,ktop,klcl,k22 + real :: overshoot real, dimension (:,:) ,intent (in ) :: heo_cup,heso_cup,po_cup,z_cup,heo & ,qo_cup,qeso_cup,po,qo,qeso,heso real, dimension (:) ,intent (in ) :: cap_max_in,cap_inc,xland,wlpool - real, dimension (:) ,intent (in ) :: zqexec,ztexec,x_add_buoy,overshoot_rescaled + real, dimension (:) ,intent (in ) :: zqexec,ztexec,x_add_buoy real, dimension (:) ,intent (inout) :: hkbo,depth_neg_buoy,frh real, dimension (:,:) ,intent (in) :: entr_rate_2d,cnvcf real, dimension (:,:) ,intent (inout) :: hcot @@ -4284,7 +4283,7 @@ subroutine cup_cloud_limits(cumulus,ierrc,ierr,cap_inc,cap_max_in,heo_cup,heso_c x_add (:) = c_alvl*zqexec(:) + c_cp*ztexec(:) + x_add_buoy(:) start_level(:) = start_level_(:) - if(use_pass_cloudvol == 2) then + if(use_pass_cloudvol == 1) then h_env_eff(:,:) = (1.-cnvcf(:,:))*heo(:,:) + cnvcf(:,:)*heso(:,:) else h_env_eff(:,:) = heo(:,:) @@ -4373,8 +4372,8 @@ subroutine cup_cloud_limits(cumulus,ierrc,ierr,cap_inc,cap_max_in,heo_cup,heso_c !--- check cloud top for deep convection if(cumulus == 'deep') then - min_deep_top=500. - if(icumulus_gf(mid) == OFF) min_deep_top=600. + min_deep_top=500. ! mbar + if(icumulus_gf(mid) == OFF) min_deep_top=600. ! mbar do vtp_index = get_num_elements(vec_ok),1,-1 i = get_data_value(vec_ok,vtp_index) cloud_depth = po_cup(kbcon(i),i)-po_cup(ktop(i),i) @@ -4388,7 +4387,7 @@ subroutine cup_cloud_limits(cumulus,ierrc,ierr,cap_inc,cap_max_in,heo_cup,heso_c if(overshoot > 1.e-6) then do vtp_index = get_num_elements(vec_ok),1,-1 i = get_data_value(vec_ok,vtp_index) - Z_overshoot = (1. + overshoot_rescaled(i)) * z_cup(ktop(i),i) + Z_overshoot = (1. + overshoot) * z_cup(ktop(i),i) do k=ktop(i)+1,ktf-1 if(Z_overshoot <= z_cup(k,i)) then ktop(i) = min(k, max_ktop(i)) @@ -4431,13 +4430,13 @@ subroutine cup_up_vvel(vvel2d,vvel1d,zws,entr_rate_2d,cd ,z,z_cup,zu,dby,GAMMA_C ,wlpool,wlpool_bcon) implicit none - integer ,intent (in ) :: itf,ktf,its,ite, kts,kte - real, dimension (:,:) ,intent (in ) :: z,z_cup,zu,gamma_cup,t_cup,dby & + integer ,intent (in ) :: itf,ktf,its,ite, kts,kte + real, dimension (:,:) ,intent (in ) :: z,z_cup,zu,gamma_cup,t_cup,dby & ,entr_rate_2d,cd,tempco,qco,qrco,qo - integer, dimension (:) ,intent (in ) :: klcl,kbcon,ktop,start_level - real, dimension (:) ,intent (in ) :: zws - real, dimension (:) ,intent (inout) :: wlpool + integer, dimension (:) ,intent (in ) :: klcl,kbcon,ktop,start_level + real, dimension (:) ,intent (in ) :: zws + real, dimension (:) ,intent (inout) :: wlpool ! input and output integer, dimension (:) ,intent (inout) :: ierr @@ -6149,18 +6148,16 @@ subroutine readGFConvParNML(mynum, IO_NODE,config_gf_cporg,config_gf_pcvol,confi ,c0_deep, qrc_crit,lambau_deep,lambau_shdn,c0_mid & ,cum_max_edt_land ,cum_max_edt_ocean, cum_hei_down_land & ,cum_hei_down_ocean,cum_hei_updf_land, cum_hei_updf_ocean & - ,cum_entr_rate ,tau_deep,tau_mid & - ,use_momentum_transp ,moist_trigger,frac_modis & - ,cum_use_excess,cum_ave_layer,use_smooth_prof & - ,use_cloud_dissipation,cum_use_smooth_tend,use_gustiness, use_random_num & - ,beta_sh,c0_shal,use_linear_subcl_mf,liq_ice_number_conc & - ,cap_maxs,sig_factor,lcl_trigger & - ,cum_t_star, convection_tracer, tau_ocea_cp, tau_land_cp & - ,use_memory, add_coldpool_prop ,mx_buoy1, mx_buoy2,max_tq_tend & - ,add_coldpool_clos,add_coldpool_trig,add_coldpool_diff,n_cldrop & + ,cum_entr_rate ,tau_deep,tau_mid,use_momentum_transp ,moist_trigger & + ,frac_modis,cum_use_excess,cum_ave_layer,use_smooth_prof & + ,use_cloud_dissipation,cum_use_smooth_tend, use_random_num & + ,beta_sh,c0_shal,use_linear_subcl_mf,liq_ice_number_conc,cap_maxs & + ,sig_factor,cum_t_star, convection_tracer, tau_ocea_cp, tau_land_cp & + ,use_memory ,mx_buoy1, mx_buoy2,max_tq_tend & + ,add_coldpool_clos,add_coldpool_trig,n_cldrop & ,output_sound,use_pass_cloudvol,use_lcl_ctrl_entr,use_rhu_ctrl_entr & ,cum_min_cloud_depth,use_sub3d,cum_fr_min_entr,use_shear_ctrl_entr & - ,use_cwv_ctrl_entr,adv_trigger,dcape_threshold,use_cold_start + ,use_cwv_ctrl_entr,adv_trigger,dcape_threshold,use_cold_start,tu_buoyx if(present(IO_NODE)) then local_io_node = IO_NODE @@ -6235,7 +6232,6 @@ subroutine readGFConvParNML(mynum, IO_NODE,config_gf_cporg,config_gf_pcvol,confi print*, 't_star ' , real(cum_t_star ,4) print*, 'cap_maxs ' , real(cap_maxs ,4) print*, 'moist_trigger ' , moist_trigger - print*, 'lcl_trigger ' , lcl_trigger print*, 'tau_deep,tau_mid ' , real(tau_deep,4),real(tau_mid,4) print*, 'sgs_w_timescale ' , sgs_w_timescale print*, 'convection_tracer ' , convection_tracer @@ -6246,6 +6242,8 @@ subroutine readGFConvParNML(mynum, IO_NODE,config_gf_cporg,config_gf_pcvol,confi print*, 'tau_land_cp ' , tau_land_cp print*, 'mx_buoy1 - kJ/kg ' , mx_buoy1*1.e-3 print*, 'mx_buoy2 - kJ/kg ' , mx_buoy2*1.e-3 + print*, 'tu_buoyx - # ' , tu_buoyx + print*, 'use_pass_cloudvol ' , use_pass_cloudvol print*, 'use_lcl_ctrl_entr ' , use_lcl_ctrl_entr print*, 'use_rhu_ctrl_entr ' , use_rhu_ctrl_entr @@ -6301,7 +6299,6 @@ subroutine readGFConvParNML(mynum, IO_NODE,config_gf_cporg,config_gf_pcvol,confi print*, 'lightning_diag ' , lightning_diag print*, 'overshoot ' , real(overshoot ,4) print*, 'liq_ice_number_conc' , liq_ice_number_conc - print*, 'use_gustiness ' , use_gustiness print*, '!----misc controls' print*, 'output_sound ' , output_sound @@ -6311,8 +6308,6 @@ subroutine readGFConvParNML(mynum, IO_NODE,config_gf_cporg,config_gf_pcvol,confi print*, 'clev_grid ' , clev_grid print*, 'vert_discr ' , vert_discr print*, 'max_tq_tend ' , real(max_tq_tend,4) - print*, 'add_coldpool_prop ' , add_coldpool_prop - print*, 'add_coldpool_diff ' , add_coldpool_diff print*, 'use_inv_layers ' , use_inv_layers print*,"========================================================================" !call flush(6) @@ -6676,7 +6671,7 @@ subroutine coldPoolConvMem(cumulus,its, itf, kts, kte, ktf, ztexec & !-- reduce entr rate, where cold pools exist do vtp_index = get_num_elements(vec_ok),1,-1 i = get_data_value(vec_ok,vtp_index) - entr_rate(i) = coldPoolStart (x_add_buoy(i)) * entr_rate(i) + entr_rate(i) = coldPoolStart(x_add_buoy(i)) * entr_rate(i) enddo endif @@ -7070,8 +7065,9 @@ subroutine set_entr_detr_rates(cumulus,its,ite,itf,kts,kte,ktf,ierr,klcl !-- local vars integer :: i,k,vtp_index real :: crh1 = 1.3, crh2 = 1.6 , fq = 1.0 + real, parameter :: width = 0.1, turncf = 0.4 real, dimension(kts:kte,its:ite) :: rh2d,entr_frh2d,detr_frh2d - + do i=its,itf entr_rate_2d(:,i) = entr_rate (i) cd (:,i) = entr_rate (i) @@ -7084,15 +7080,19 @@ subroutine set_entr_detr_rates(cumulus,its,ite,itf,kts,kte,ktf,ierr,klcl i = get_data_value(vec_ok,vtp_index) rh2d(:,i) = min(qo_cup(:,i)/qeso_cup(:,i),1.) enddo - + if(use_pass_cloudvol == 1) then - crh1 = 1.3 ; crh2 = 1.6 + crh1 = 1.0 ; crh2 = 1.3 !-- The Role of Passive Cloud Volumes in the Transition !-- From Shallow to Deep Atmospheric Convection - GRL 2023 do vtp_index = get_num_elements(vec_ok),1,-1 i = get_data_value(vec_ok,vtp_index) - !--effective RH = environmental + saturated - rh2d(:,i) = (1. - cnvcf(:,i)) * rh2d(:,i) + cnvcf(:,i)*1.0 + + !rh2d(:,i) = min(0.6666,cnvcf(:,i)*1.0) + do k=kts,ktf + rh2d(k,i) = (1.5 + atan((cnvcf(k,i) - turncf)/width))/3. + rh2d(k,i) = min(0.666,rh2d(k,i)) + enddo enddo endif @@ -7102,7 +7102,7 @@ subroutine set_entr_detr_rates(cumulus,its,ite,itf,kts,kte,ktf,ierr,klcl entr_frh2d(:,i) = crh1 - rh2d(:,i) detr_frh2d(:,i) = crh2 - rh2d(:,i) enddo - + do vtp_index = get_num_elements(vec_ok),1,-1 i = get_data_value(vec_ok,vtp_index) do k=kts,ktf @@ -7113,7 +7113,8 @@ subroutine set_entr_detr_rates(cumulus,its,ite,itf,kts,kte,ktf,ierr,klcl cd(k,i) = 0.75e-4*detr_frh2d(k,i) enddo enddo - + ! print*,'entr2',i,maxval( entr_rate_2d(:,:)),minval(entr_rate_2d(:,:)),maxval(entr_frh2d(:,:)),minval(entr_frh2d(:,:)) + ! print*,'entr3',i,maxval( cnvcf(:,:)),minval(cnvcf(:,:)) else ! no RH control on entr/detr rates do vtp_index = get_num_elements(vec_ok),1,-1 @@ -7546,7 +7547,7 @@ subroutine get_1st_guess_MSE_profile(cumulus,ave_layer,its,ite,itf,kts,kte,ktf,i hco(k,i) = hkbo(i) enddo kii=start_level(i) ; kff=ktop(i) - if(use_pass_cloudvol == 2) then + if(use_pass_cloudvol == 1) then h_env_eff(kii:kff) = (1.-cnvcf(kii:kff,i))*heo(kii:kff,i) + cnvcf(kii:kff,i)*heso(kii:kff,i) else h_env_eff(kii:kff) = heo(kii:kff,i) @@ -7625,7 +7626,7 @@ subroutine get_updraft_profile(cumulus,ave_layer,use_linear_subcl_mf,its,ite,itf do vtp_index = get_num_elements(vec_ok),1,-1 i = get_data_value(vec_ok,vtp_index) kii=start_level(i) ; kff=ktop(i) - if(use_pass_cloudvol == 2) then + if(use_pass_cloudvol == 1) then h_env_eff (kii:kff) = (1.-cnvcf(kii:kff,i))*he (kii:kff,i) + cnvcf(kii:kff,i)*hes (kii:kff,i) h_env_effo(kii:kff) = (1.-cnvcf(kii:kff,i))*heo(kii:kff,i) + cnvcf(kii:kff,i)*heso(kii:kff,i) else @@ -8620,13 +8621,11 @@ function initModConvParGF() result(is_init) use_memory = 0 add_coldpool_clos = 4 add_coldpool_trig = 0 - add_coldpool_prop = 3 - add_coldpool_diff = 3 tau_ocea_cp = 3600. tau_land_cp = 3600. mx_buoy1 = 250.5 ! J/kg (real(c_cp)*5.0 + real(c_alvl)*2.e-3)*0.025 - mx_buoy2 = 20004.0 ! J/kg (real(c_cp)*10.+real(c_alvl)*4.e-3) - use_gustiness = 0 + mx_buoy2 = 20004.0 ! J/kg (real(c_cp)*10.+real(c_alvl)*4.e-3) + tu_buoyx = 1.0 use_sub3d = 0 use_scale_dep = 1 @@ -8651,7 +8650,7 @@ function initModConvParGF() result(is_init) liq_ice_number_conc=0 apply_sub_mp = 0 use_wetbulb = 0 - overshoot = 0.6 + overshoot = 0.2 autoconv = 4 c0_deep = 1.0e-3 @@ -8675,7 +8674,6 @@ function initModConvParGF() result(is_init) moist_trigger = 0 frac_modis = 1 - lcl_trigger = 0 use_random_num = 0.0 cap_maxs = 50. beta_sh = 2.2 @@ -10868,15 +10866,16 @@ subroutine reset_2d(its,ite,kts,kte,zo,z,xz,hcdo,cupclw,qrcdo& end subroutine reset_2d !---------------------------------------------------------------------------------------------! - subroutine get_entr_vshear(cumulus,ierr,us,vs,zo,ktop,kbcon,klcl,po,po_cup,itf,ktf,its,ite, kts,kte & - ,min_entr_rate,entr_rate, vshear,var2d2,qo,x_add_buoy,zqexec,precip_rescaled) + subroutine get_entr_vshear(cumulus,ierr,us,vs,zo,ktop,kbcon,klcl,po,po_cup,itf,ktf,its,ite, kts,kte & + ,min_entr_rate,entr_rate, vshear,var2d2,qo,x_add_buoy,zqexec,precip_rescaled & + ,overshoot,mpas_cape,mpas_cin) implicit none character *(*) ,intent (in) :: cumulus integer ,intent (in) :: itf,ktf,its,ite, kts,kte ! integer, dimension (:) ,intent (in ) :: ktop,kbcon,klcl - real, intent(in ) :: min_entr_rate - real, dimension (:) ,intent (in ) :: x_add_buoy,zqexec + real, intent(in ) :: min_entr_rate,overshoot + real, dimension (:) ,intent (in ) :: x_add_buoy,zqexec,mpas_cape,mpas_cin real, dimension (:,:),intent (in ) :: us,vs,zo,po,qo,po_cup integer, dimension (:) ,intent (inout) :: ierr @@ -10897,30 +10896,49 @@ subroutine get_entr_vshear(cumulus,ierr,us,vs,zo,ktop,kbcon,klcl,po,po_cup,itf,k real, parameter :: Pmax = 27.0 real, parameter :: rmin=12.0,rmax=33.0,xc=15.0,yc=50.0,alpha2=0.2,beta2=0.2 real, parameter :: p850 = 850. ! lower level of shear calculation + real, parameter :: p490 = 490. ! upper level of shear calculation + real, parameter :: p550 = 550. ! upper level of shear calculation ! for use_shear_ctrl_entr == 1 or 2 - !real, parameter :: center = 12.0, width2 = 20.0, sharpness = 1.0 - real, parameter :: center = 14.0, width2 = 20.0, sharpness = 5.0 + !real, parameter :: center = 12.0, width2 = 20.0, sharpness = 5.0 ! ver 1.6.3 + real, parameter :: center = 20.0, width2 = 20.0, sharpness = 5.0 ! + + ! for use_shear_ctrl_entr == 5 + real, parameter :: disc_crit = 19691164. - integer :: i,k,k650,k850 - real :: u650, u975, v650, v975, H, u850,sigx,sigy,x,y,dp + integer :: i,k,k650,k850,k490,k2,k1 + real :: u650, u975, v650, v975, H, u850,sigx,sigy,x,y,dp,u490,v490, u2,v2,u1,v1,p2,disc real, dimension (its:itf) :: scale_factor,w_col !scale_factor = 1.0 if( use_shear_ctrl_entr <= 2 ) then do i=its,itf - k650 = minloc( abs(po(kts:ktf,i)-p650),1 ) - !-- v1 + !-- v1 + !k650 = minloc( abs(po(kts:ktf,i)-p650),1 ) !u650 = sqrt(us(k650,i)*us(k650,i) + vs(k650,i)*vs(k650,i)) !u975 = sqrt(us(k975,i)*us(k975,i) + vs(k975,i)*vs(k975,i)) !vshear(i) = abs(u650-u975) - !print*,'A',po(k650,i),po(k975,i),vshear(i) - !-- v2 - u650 = us(k650,i) ; v650 = vs(k650,i) - u975 = us(k975,i) ; v975 = vs(k975,i) - vshear(i) = sqrt( (u650-u975)**2 + (v650-v975)**2 ) - !print*,'B',po(k650,i),po(k975,i),vshear(i) + !-- v2 ver 1.6.3 + !k650 = minloc( abs(po(kts:ktf,i)-p650),1 ) + !u650 = us(k650,i) ; v650 = vs(k650,i) + !u975 = us(k975,i) ; v975 = vs(k975,i) + !vshear(i) = sqrt( (u650-u975)**2 + (v650-v975)**2 ) + + !-- v3 + !k490 = minloc( abs(po(kts:ktf,i)-p490),1 ) + !u490 = us(k490,i) ; v490 = vs(k490,i) + !u975 = us(k975,i) ; v975 = vs(k975,i) + !vshear(i) = sqrt( (u490-u975)**2 + (v490-v975)**2 ) + + !-- v4 + k1 = k975 + u1 = us(k1,i) ; v1 = vs(k1,i) + p2 = p550 + k2 = minloc( abs(po(kts:ktf,i)-p2),1 ) + u2 = us(k2,i) ; v2 = vs(k2,i) + vshear(i) = sqrt( (u2-u1)**2 + (v2-v1)**2 ) + enddo endif if( use_shear_ctrl_entr == 1 ) then @@ -10934,9 +10952,11 @@ subroutine get_entr_vshear(cumulus,ierr,us,vs,zo,ktop,kbcon,klcl,po,po_cup,itf,k if( use_shear_ctrl_entr == 2 ) then do i=its,itf scale_factor(i) = 1.0 + tanh(sharpness * (vshear(i) - center) / width2) - scale_factor(i) = max(0.5, min(0.85/scale_factor(i),1.)) - var2d2(i) = scale_factor(i) - entr_rate(i) = max(scale_factor(i)*entr_rate(i), min_entr_rate) + !scale_factor(i) = max(0.20, min(0.50/scale_factor(i),1.)) !ver 1.6.3 + scale_factor(i) = max(0.10, min(0.20/scale_factor(i),1.)) + + var2d2(i) = scale_factor(i) + entr_rate(i) = max(scale_factor(i)*entr_rate(i), min_entr_rate) enddo endif if( use_shear_ctrl_entr == 20 ) then @@ -10993,6 +11013,24 @@ subroutine get_entr_vshear(cumulus,ierr,us,vs,zo,ktop,kbcon,klcl,po,po_cup,itf,k endif endif + if( use_shear_ctrl_entr == 5 ) then + do i=its,itf + k1 = k975 + u1 = us(k1,i) ; v1 = vs(k1,i) + p2 = p490 + k2 = minloc( abs(po(kts:ktf,i)-p2),1 ) + u2 = us(k2,i) ; v2 = vs(k2,i) + vshear(i) = sqrt( (u2-u1)**2 + (v2-v1)**2 ) + enddo + do i=its,itf + disc = max(1.0, mpas_cape(i)*vshear(i)**4.10) + scale_factor(i) = max(min(1., 1.0/(disc/disc_crit)),0.1) + entr_rate(i) = max(scale_factor(i)*entr_rate(i), min_entr_rate) + var2d2(i) = scale_factor(i) !--- for output only + enddo + !print*,'DISC',maxval(scale_factor),minval(scale_factor) + endif + end subroutine get_entr_vshear !---------------------------------------------------------------------------------------------! subroutine adv_trigger_check(cumulus,ave_layer,ierr,ierrc,itf,ktf,its,ite,kts,kte,dtime,us,vs & diff --git a/src/core_atmosphere/physics/physics_noahmp/LICENSE.txt b/src/core_atmosphere/physics/physics_noahmp/LICENSE.txt new file mode 100644 index 000000000..fad4f4232 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/LICENSE.txt @@ -0,0 +1,66 @@ +USE OF THIS SOFTWARE IS SUBJECT TO THE FOLLOWING TERMS AND CONDITIONS: + +1. License. Subject to these terms and conditions, University Corporation for Atmospheric Research (UCAR) +grants you a non-exclusive, royalty-free license to use, create derivative works, publish, distribute, +disseminate, transfer, modify, revise and copy the Noah-MP software, in both object and source code +(the "Software"). You shall not sell, license or transfer for a fee the Software, or any work that in any +manner contains the Software. + +2. Disclaimer of Warranty on Software. Use of the Software is at your sole risk. The Software is provided +"AS IS" and without warranty of any kind and UCAR EXPRESSLY DISCLAIMS ALL WARRANTIES AND/OR CONDITIONS OF +ANY KIND, EXPRESS OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, ANY WARRANTIES OR CONDITIONS OF TITLE, +NON-INFRINGEMENT OF A THIRD PARTY'S INTELLECTUAL PROPERTY, MERCHANTABILITY OR SATISFACTORY QUALITY AND +FITNESS FOR A PARTICULAR PURPOSE. THE PARTIES EXPRESSLY DISCLAIM THAT THE UNIFORM COMPUTER INFORMATION +TRANSACTIONS ACT (UCITA) APPLIES TO OR GOVERNS THIS AGREEMENT. No oral or written information or advice +given by UCAR or a UCAR authorized representative shall create a warranty or in any way increase the scope +of this warranty. Should the Software prove defective, you (and neither UCAR nor any UCAR representative) +assume the cost of all necessary correction. + +3. Limitation of Liability. UNDER NO CIRCUMSTANCES, INCLUDING NEGLIGENCE, SHALL UCAR BE LIABLE FOR ANY +DIRECT, INCIDENTAL, SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES INCLUDING LOST REVENUE, PROFIT OR DATA, +WHETHER IN AN ACTION IN CONTRACT OR TORT ARISING OUT OF OR RELATING TO THE USE OF OR INABILITY TO USE THE +SOFTWARE, EVEN IF UCAR HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. + +4. Compliance with Law. All Software and any technical data delivered under this Agreement are subject to +U.S. export control laws and may be subject to export or import regulations in other countries. You agree +to comply strictly with all applicable laws and regulations in connection with use and distribution of the +Software, including export control laws, and you acknowledge that you have responsibility to obtain any +required license to export, re-export, or import as may be required. + +5. No Endorsement/No Support. The names UCAR/NCAR, National Center for Atmospheric Research and the +University Corporation for Atmospheric Research may not be used in any advertising or publicity to endorse +or promote any products or commercial entity unless specific written permission is obtained from UCAR. The +Software is provided without any support or maintenance, and without any obligation to provide you with +modifications, improvements, enhancements, or updates of the Software. + +6. Controlling Law and Severability. This Agreement shall be governed by the laws of the United States and the +State of Colorado. If for any reason a court of competent jurisdiction finds any provision, or portion +thereof, to be unenforceable, the remainder of this Agreement shall continue in full force and effect. This +Agreement shall not be governed by the United Nations Convention on Contracts for the International Sale of +Goods, the application of which is hereby expressly excluded. + +7. Termination. Your rights under this Agreement will terminate automatically without notice from UCAR if you +fail to comply with any term(s) of this Agreement. You may terminate this Agreement at any time by destroying +the Software and any related documentation and any complete or partial copies thereof. Upon termination, all +rights granted under this Agreement shall terminate. The following provisions shall survive termination: +Sections 2, 3, 6 and 9. + +8. Complete Agreement. This Agreement constitutes the entire agreement between the parties with respect to the +use of the Software and supersedes all prior or contemporaneous understandings regarding such subject matter. +No amendment to or modification of this Agreement will be binding unless in a writing and signed by UCAR. + +9. Notices and Additional Terms. Copyright in Software is held by UCAR. You must include, with each copy of the +Software and associated documentation, a copy of this Agreement and the following notice: + +"The source of this material is the Research Applications Laboratory at the National Center for Atmospheric +Research, a program of the University Corporation for Atmospheric Research (UCAR) pursuant to a Cooperative +Agreement with the National Science Foundation; ©2007 University Corporation for Atmospheric Research. All +Rights Reserved." + +The following notice shall be displayed on any scholarly works associated with, related to or derived from +the Software: + +"The Noah-MP modeling system was developed at the National Center for Atmospheric Research (NCAR) with collaborations +from university partners. NCAR is sponsored by the United States National Science Foundation." + +BY USING OR DOWNLOADING THIS SOFTWARE, YOU AGREE TO BE BOUND BY THE TERMS AND CONDITIONS OF THIS AGREEMENT. diff --git a/src/core_atmosphere/physics/physics_noahmp/README.md b/src/core_atmosphere/physics/physics_noahmp/README.md new file mode 100644 index 000000000..de0a3fb93 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/README.md @@ -0,0 +1,88 @@ +![noahmp_logo_update](https://github.com/NCAR/noahmp/assets/43385564/1fb47fc2-99bd-4360-9ed0-6d5656c29626) + + +[![DOI](https://zenodo.org/badge/236657733.svg)](https://zenodo.org/badge/latestdoi/236657733) + + +# Noah-MP® Community Model Repository + +Noah-MP® is a widely-used state-of-the-art land surface model used in many research and operational weather/climate models (e.g., HRLDAS, WRF, MPAS, WRF-Hydro/NWM, NOAA/UFS, NASA/LIS, etc.). + +This is the official Noah-MP land surface model unified repository for code downloading and contribution. Noah-MP is a community open-source model developed with the contributions from the entire scientific community. For development, maintenance, and release of the community Noah-MP GitHub code, please contact: Cenlin He (cenlinhe@ucar.edu) and Fei Chen (feichen@ucar.edu). + +Noah-MP model website: https://ral.ucar.edu/solutions/products/noah-multiparameterization-land-surface-model-noah-mp-lsm + + +## New: Release of Noah-MP version 5.0 (Refactored/Modernized version) + +The latest Noah-MP model version (version 5.0) has been released in March 9, 2023, which is a modernized/refactored version by re-writing the entire model with modern Fortran code infrastructure and data structures. All future Noah-MP developments and updates will be made only to this modernized/refactored version. The version 5.0 has the same model physics as the version 4.5, but with a different code infrastructure. More details about the Noah-MP version 5.0 can be found in the model description paper (He et al., 2023b, in review) and the technical documentation (He et al. 2023a). Currently, the Noah-MP version 5.0 coupling with HRLDAS has been completed, but its coupling with other host models (e.g., WRF-Hydro, NASA/LIS, WRF, MPAS, UFS, etc.) is still on-going. + + +## Noah-MP technical documentation and model description papers + +Technical documentation freely available at http://dx.doi.org/10.5065/ew8g-yr95 + +**To cite the technical documentation**: He, C., P. Valayamkunnath, M. Barlage, F. Chen, D. Gochis, R. Cabell, T. Schneider, R. Rasmussen, G.-Y. Niu, Z.-L. Yang, D. Niyogi, and M. Ek (2023): The Community Noah-MP Land Surface Modeling System Technical Description Version 5.0, (No. NCAR/TN-575+STR). doi:10.5065/ew8g-yr95 + +**Original Noah-MP model description paper**: Niu, G. Y., Yang, Z. L., Mitchell, K. E., Chen, F., Ek, M. B., Barlage, M., ... & Xia, Y. (2011). The community Noah land surface model with multiparameterization options (Noah‐MP): 1. Model description and evaluation with local‐scale measurements. Journal of Geophysical Research: Atmospheres, 116(D12). + +**Noah-MP version 5.0 model description paper**: He, C., Valayamkunnath, P., Barlage, M., Chen, F., Gochis, D., Cabell, R., Schneider, T., Rasmussen, R., Niu, G.-Y., Yang, Z.-L., Niyogi, D., and Ek, M.: Modernizing the open-source community Noah with multi-parameterization options (Noah-MP) land surface model (version 5.0) with enhanced modularity, interoperability, and applicability, Geosci. Model Dev., 16, 5131–5151, https://doi.org/10.5194/gmd-16-5131-2023, 2023. + + +## Noah-MP GitHub structure + +**The folders**: + +1. docs/: Noah-MP variable glossary and technical documentation; + +2. drivers/: Noah-MP driver and interface code to connect to different host models (each host model will has its own subdirectory under this driver/); + +3. parameters/: Noah-MP parameter table (note that the original 3 parameter tables have been merged into one NoahmpTable.TBL starting from version 5.0); + +4. src/: Noah-MP source code modules; + +5. utility/: Noah-MP utility code. + +**The branches**: + +1. "master" branch: (currently version 5.0), most stable & latest version, updated whenever there are bug fixes or major model update/release (by merging from the "develop" branch); + +2. "develop" branch: (currently version 5.0), used for continuous NoahMP development, keep updated by including bug fixes and code updates (e.g., new physics options, processes, etc.); + +3. other version release branches: store different released code versions. + + +## Important notes + +This GitHub repository only provides the Noah-MP source code and driver/interface code. To run Noah-MP in either offline or online mode, users need to have the host model system/framework coupled with Noah-MP. + +NCAR also maintains and releases the HRLDAS (High Resolution Land Data Assimilation System) coupled with Noah-MP to allow offline Noah-MP simulations. Please see the HRLDAS GitHub repository (https://github.com/NCAR/hrldas) for details. For users who are interested in other host models that couple with Noah-MP, please refer to those host model GitHub repositories. + +For users who are interested in previous Noah-MP code versions (prior to version 5.0), please refer to the different GitHub branches in this repository. Particularly, the "release-v4.5-WRF" branch has the same model physics as the Noah-MP version 5.0, but with an old model code structures, which is consistent with the Noah-MP code released along with WRF version 4.5. + + +## Code contribution via GitHub + +Users are welcome to make code development and contributions through GitHub pull requests. The pull request will be reviewed by the Noah-MP model physics and code release team, and if everything looks good, the pull request of new code development or bug fixes will be merged into the develop branch. During each year's major version release period, the updated develop branch will be further merged into the master branch for official release of a new Noah-MP model version. + +Some suggestions for model developers to contribute to Noah-MP code through the GitHub repository (typical procedures): + +1. Step (1) Create a fork of this official Noah-MP repository to your own GitHub account; + +2. Step (2) Create a new branch based on the latest "develop" branch and make code updates/changes in the forked repository under your own account; + +3. Step (3) Finalize and test the code updates you make; + +4. Step (4) Submit a pull request for your code updates from your own forked Github repository to the "develop" branch of this official Noah-MP repository; + +5. Step (5) The Noah-MP physics and code review committee reviews and tests the model updates in the submitted pull request and discusses with the developer if there is any problem; + +6. Step (6) The Noah-MP physics and code review committee confirms the pull request and merges the updated code to the "develop" branch in this official Noah-MP repository; + +7. Step (7) The Noah-MP physics and code review committee merges the updated "develop" branch to the master branch during the annual release of new model versions. + + +## License + +The license and terms of use for this software can be found [here](https://github.com/NCAR/noahmp/blob/develop/LICENSE.txt) + diff --git a/src/core_atmosphere/physics/physics_noahmp/RELEASE_NOTES.md b/src/core_atmosphere/physics/physics_noahmp/RELEASE_NOTES.md new file mode 100644 index 000000000..ae45c39f5 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/RELEASE_NOTES.md @@ -0,0 +1,426 @@ +# Noah-MP model release notes + +## Noah-MP version 5.0 release + +### LSM capabilities/enhancements + +- Modernization/refactoring: + + - Major re-structure/refactoring of the entire Noah-MP code with modern Fortran standards without physics changes. + +### LSM bug fixes + +- None + +### External modules capabilities/enhancements + +- None + +### Driver capabilities/enhancements + +- Refactored driver to work with the modernized Noah-MP version 5.0 + +### Driver bug fixes + +- None + + +## Noah-MP version 4.5 release + +### LSM capabilities/enhancements + +- Urban modeling: + + - Update the local climate zone numbers + +- Canopy heat storage: + + - bring hard-coded tunable canopy heat capacity parameter to MPTABLE + +### LSM bug fixes + +- Several bug fixes in urban, runoff, canopy, crop processes + +### External modules capabilities/enhancements + +- None + +### Driver capabilities/enhancements + +- None + +### Driver bug fixes + +- None + + +## Noah-MP version 4.4 release + +### LSM capabilities/enhancements + +- Tile drainage: + + - Add new tile drainage physics and options + +- Snowpack process enhancement: + + - Improved snow viscosity to enhance snowpack compaction + +- Canopy heat storage: + + - add canopy heat storage in vegetation temperature calculation + +- Runoff scheme: + + - Updated formulation in runoff option =1 (TOPMODEL with groundwater) + +- Soil processes: + + - Add new capabilities to allow using a different soil timestep with main Noah-MP timestep using namelist control + +- Input/output: + + - Add new capabilities to output additional detailed Noah-MP water budget terms using namelist control + +### LSM bug fixes + +- Several bug fixes in inout variables, energy, water, and canopy processes + +### External modules capabilities/enhancements + +- None + +### Driver capabilities/enhancements + +- None + +### Driver bug fixes + +- None + + +## Noah-MP version 4.3 release + +### LSM capabilities/enhancements + +- Snow-related updates: + + - Add wet-bulb temperature snow-rain partitioning scheme (OPT_SNF=5) based on Wang et al. 2019 (NWM) + - Add snow retention process at the snowpack bottom to improve streamflow modeling (NWM) + - Modify wind-canopy absorption coefficient (CWPVT) parameter values in MPTABLE to be vegetation dependent based on Goudriaan1977 + - Bring hard-coded snow emissivity and parameter (2.5*z0) in snow cover formulation to tunable MPTABLE parameters + - Update MFSNO in snow cover formulation with optimized vegetation-dependent values + - Limit the bulk leaf boundary layer resistance (RB) to a more realistic range (5~50) + +- New irrigation scheme: + + - multiple irrigation methods: sprinkler, micro, and surface flooding + +- Crop scheme update: + + - separate the original generic crop physiology parameters in the modis vegetation section into C3/C4 specific parameters in the crop section + +- New urban physics working with Noah-MP: + + - Local climate zone (LCZ), solar panel, green roof, new building drag parameterization + +### LSM bug fixes + +- None + +### External modules capabilities/enhancements + +- None + +### Driver capabilities/enhancements + +- None + +### Driver bug fixes + +- None + + +## Noah-MP version 4.1 release + +### LSM capabilities/enhancements + +- Consolidate NWM changes into WRF version (#18) + - add unpopulated header required by NOAA + - add BATS parameters to data structure and output band snow albedo + - update MPTABLE for BATS albedo parameters + - add BATS albedo local variables to noahmpdrv + - transfer new BATS table values to parameters data structure in noahmpdrv + - add RSURF_EXP parameter to data structure and update MPTABLE + - change snow water equivalent limit to 5000mm + - assume LAI is stand LAI and doesn't need to be rescaled by FVEG + - conserve snow pack heat when layer melts completely + - change output messages and Fortran open/read unit numbers to WCOSS standard + - include a few missed changes from WRF + +### LSM bug fixes + +- Define and declare a few variables in physics routines + +- Noah-MP bulk urban roughness length set to table values + +### External modules capabilities/enhancements + +- Air conditioning fraction for BEM model + +- Improve urban memory by allowing different dimensions for urban variables + +### Driver capabilities/enhancements + +- None + +### Driver bug fixes + +- None + + +## Noah-MP version 4.0.1 release + +### LSM capabilities/enhancements + +- None + +### LSM bug fixes + +- Noah-MP frozen soil initialization- An incorrect sign change was introduced in v4.0, impacting soil moisture and soil temperature initialization. + +- Array out of bounds Noah-MP - Fix possible/likely array out of bounds by assuming homogeneous soil with depth.Only applies to opt_run=2. + +- Noah-MP snow liquid water movement - prevent excessive gravitational water movement. Fixes unrealistic snow density values during melt season. + +- Noah-MP divide by zero - Bug fix in v4.0 introduced a possible divide by zero when LAI is zero. + +- Noah-MP leaf aerodynamic resistance - limit leaf aerodynamic resistance to prevent very large canopy exchange coefficients with high wind speed. + +### Driver capabilities/enhancements + +- Add new single point driver based on Bondville data + +### Driver bug fixes + +- Missing quotation mark in spatial_filename check print statement + + +## Noah-MP version 4.0 release + +### LSM capabilities/enhancements + +- Add pedotransfer function option for soil propertis + - add optional read for soil composition and multi-layer soil texture from setup/input file + - activated with opt_soil and opt_pedo + - update MPTABLE.TBL with pedotransfer function coefficients + +- Add Gecros crop model + - activated with opt_crop=2 (Liu et al. crop now opt_crop=1) + - some modifications for crop initialization + +- Groundwater module (opt_run=5) updates + - move init to driver for parallel capability + - remove rivermask/nonriver from input + +- EPA modifications to output total stomatal resistance + +### LSM bug fixes + +- None + +### Driver capabilities/enhancements + +- Change some predefined defaults in user_build_options.compiler files based on some Cheyenne tests + +- Add ISLAKE to the preprocessing and driver to accommodate WRF files that define a distinct lake category + +### Driver bug fixes + +- Change PGSXY and CROPCAT to be initialized undefined_int + + +## Noah-MP version 3.9 release + +### LSM capabilities/enhancements + +- Crop modifications in v3.9 to read in crop datasets and initialize properly + +- Modifications in v3.9 to read in groundwater datasets + +- Noah-MP can now run with single-layer and multi-layer urban models + +### LSM bug fixes + +- Several fixes in Section 1 of SOILPARM.TBL + +- Fix strange Noah-MP behavior in soil water in certain conditions + +- Fix uninitialized variable in Noah-MP surface exchange option + +### Driver capabilities/enhancements + +- Add capability to include snow in forcing files + - Need to set FORCING_NAME_SN and PCP_PARTITION_OPTION = 4 + - Snow is assumed to be <= incoming precipitation + +- Add capability to define name of forcing variables in namelist.hrldas + +- Add spinup option to namelist + - controlled by spinup_loops in namelist.hrldas + - will run kday/khour spinup_loops times before starting the simulation + +- Add capability to exclude the first output file since this file contains only initial states + - and no computed fluxes + - activated by namelist.hrldas option: SKIP_FIRST_OUTPUT = .true. + +- Added README.namelist to describe all the namelist.hrldas options + +### Driver bug fixes + +- None + + +## Noah-MP version 3.8.1 release + +### LSM capabilities/enhancements + +- None + +### LSM bug fixes + +- Change C3C4 in MPTABLE to integer + +- Set some limits on stability function for OPT_SFC = 2 + +- Change limit for minimum wood pool in dynamic vegetation + +- Fix bug in QSFC calculation + +- Prevent divide by zero when soil moisture is zero + +- Fix a few bugs in the crop code; make DVEG = 10 activate crop model + +### Driver capabilities/enhancements + +- Added configure script for generating user_build_options file + +### Driver bug fixes + +- None + + +## Noah-MP version 3.8 release + +### LSM capabilities/enhancements + +- Added 3 new dveg option for reading LAI from forcing and 1 new dveg option for reading FVEG; + + - Also added initial commit of crop model; currently runs crop everywhere + - dveg = 6 -> dynamic vegetation on (use FVEG = SHDFAC from input) + - dveg = 7 -> dynamic vegetation off (use input LAI; use FVEG = SHDFAC from input) + - dveg = 8 -> dynamic vegetation off (use input LAI; calculate FVEG) + - dveg = 9 -> dynamic vegetation off (use input LAI; use maximum vegetation fraction) + - dveg = 10 -> crop model on (use maximum vegetation fraction) + +- Added glacier options: + + - opt_gla = 1 -> original Noah-MP version + - opt_gla = 2 -> no ice phase change or sublimation (like Noah glacier) + +- Added surface resistance as an option (now four options) + + - opt_sfc = 1 -> Sakaguchi and Zeng, 2009 (has been Noah-MP default) + - opt_sfc = 2 -> Sellers (1992) + - opt_sfc = 3 -> adjusted Sellers to decrease RSURF for wet soil + - opt_sfc = 4 -> option 1 for non-snow; rsurf = rsurf_snow for snow (set as RSURF_SNOW in MPTABLE) + +- Made the specification of urban types more general + + - (LOW_DENSITY_RESIDENTIAL, HIGH_DENSITY_RESIDENTIAL, HIGH_INTENSITY_INDUSTRIAL), + - now set in the MPTABLE dependent on classification scheme (i.e., not limited to 31,32,33); + - this is for future coupling with urban models. + +### LSM bug fixes + +- Fixed two bugs with OPT_STC=3 + +- Fixed bug in new surface resistance option causing divide by 0 + +- Write a message if incoming snow water and snow depth are inconsistent; + Reduce SWE to 2000mm if input is >2000mm, Noah-MP limits SWE internally to 2000mm + +- Recalculate ESTG in glacier code when snow is melting, will decrease sublimation, but likely increase melting + +### Driver capabilities/enhancements + +- Added instructions and scripts for extraction of single point forcing and setup files from + 2D datasets (e.g., NLDAS) + +- Structure for spatially-varying soil properties added to DRV and LSM; + Use of the 2D/3D fields in the driver and DRV commented to be consistent with WRF + +### Driver bug fixes + +- Zero forcing where not land to prevent overflow with ifort + + +## Noah-MP version 3.7.1 release + +### LSM capabilities/enhancements + +- Added depth dimension to soil parameters. + +### LSM bug fixes + +- Reorganized parameters to fix problems with OpenMP in WRF simulations. + +### Driver capabilities/enhancements + +- none + +### Driver bug fixes + +- Initialized some accumulated fields at 0 (instead of undefined). + + +## Noah-MP version 3.7 release + +### New capabilities: + +- A parallel capability has been added by Wei Yu (weiyu@ncar.edu) to support mpi only. + + - To compile with parallel version, edit the file 'user_build_options', + uncommment the compiler section with MPI (available for pgf90 and ifort compilers) + - To compile with sequential version, edit the file 'user_build_options', uncommment the compiler section without MPI + +- System setup and execution now requires only a WRF/WPS geo_em file, Dependence on the wrfinput file has been removed. + +- As part of #2, initialization no longer occurs in the first forcing file, + + - but in the file listed in the namelist as: HRLDAS_SETUP_FILE = " + - The initialization fields are: SNOW,CANWAT,TSK,TSLB,SMOIS + - This file also contains the static grid/domain information: XLAT,XLONG,TMN,HGT,SEAICE,MAPFAC_MX,MAPFAC_MY,SHDMAX,SHDMIN,XLAND,IVGTYP,ISLTYP,DZS,ZS + - This file can also contains some optional fields: LAI + - NOTE: a WRF input file can be used as a HRLDAS_SETUP_FILE + +- The timing structure has changed: + + - The initial conditions are the states at START time. + - First forcing file used is START time + FORCING_TIMESTEP + - First integration is START time + NOAH_TIMESTEP + +- First output file is now START time + OUTPUT_TIMESTEP + +- RESTART file states are consistent with OUTPUT file states with the same time stamp + +- Instructions for using GLDAS and NLDAS as forcing has been provided in addition to the NARR instructions (see /docs) + - Also, a NCL script has been included for preparing single- or multi-point forcing + +- Initial LAI (if present in the HRLDAS_SETUP_FILE) will be used to initialize the leaf and stem carbon pools + +- Removed dependence on external GRIB tables for forcing creation; now in namelist only + + + +Updated: March 10, 2023 diff --git a/src/core_atmosphere/physics/physics_noahmp/docs/NoahMP_refactored_variable_name_glossary_Feb2023.xlsx b/src/core_atmosphere/physics/physics_noahmp/docs/NoahMP_refactored_variable_name_glossary_Feb2023.xlsx new file mode 100644 index 000000000..8008b630b Binary files /dev/null and b/src/core_atmosphere/physics/physics_noahmp/docs/NoahMP_refactored_variable_name_glossary_Feb2023.xlsx differ diff --git a/src/core_atmosphere/physics/physics_noahmp/docs/NoahMP_v5_technote.pdf b/src/core_atmosphere/physics/physics_noahmp/docs/NoahMP_v5_technote.pdf new file mode 100644 index 000000000..ba1095ba1 Binary files /dev/null and b/src/core_atmosphere/physics/physics_noahmp/docs/NoahMP_v5_technote.pdf differ diff --git a/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/BiochemVarInTransferMod.F90 b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/BiochemVarInTransferMod.F90 new file mode 100644 index 000000000..82d041957 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/BiochemVarInTransferMod.F90 @@ -0,0 +1,148 @@ +module BiochemVarInTransferMod + +!!! Transfer input 2-D NoahmpIO Biochemistry variables to 1-D column variable +!!! 1-D variables should be first defined in /src/BiochemVarType.F90 +!!! 2-D variables should be first defined in NoahmpIOVarType.F90 + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use Machine + use NoahmpIOVarType + use NoahmpVarType + + implicit none + +contains + +!=== initialize with input data or table values + + subroutine BiochemVarInTransfer(noahmp, NoahmpIO) + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + type(NoahmpIO_type), intent(inout) :: NoahmpIO + +! ------------------------------------------------------------------------- + associate( & + I => noahmp%config%domain%GridIndexI ,& + VegType => noahmp%config%domain%VegType ,& + CropType => noahmp%config%domain%CropType ,& + OptCropModel => noahmp%config%nmlist%OptCropModel & + ) +! ------------------------------------------------------------------------- + + ! biochem state variables + noahmp%biochem%state%PlantGrowStage = NoahmpIO%PGSXY (I) + noahmp%biochem%state%LeafMass = NoahmpIO%LFMASSXY(I) + noahmp%biochem%state%RootMass = NoahmpIO%RTMASSXY(I) + noahmp%biochem%state%StemMass = NoahmpIO%STMASSXY(I) + noahmp%biochem%state%WoodMass = NoahmpIO%WOODXY (I) + noahmp%biochem%state%CarbonMassDeepSoil = NoahmpIO%STBLCPXY(I) + noahmp%biochem%state%CarbonMassShallowSoil = NoahmpIO%FASTCPXY(I) + noahmp%biochem%state%GrainMass = NoahmpIO%GRAINXY (I) + noahmp%biochem%state%GrowDegreeDay = NoahmpIO%GDDXY (I) + noahmp%biochem%state%NitrogenConcFoliage = 1.0 ! for now, set to nitrogen saturation + + ! biochem parameter variables + noahmp%biochem%param%NitrogenConcFoliageMax = NoahmpIO%FOLNMX_TABLE (VegType) + noahmp%biochem%param%QuantumEfficiency25C = NoahmpIO%QE25_TABLE (VegType) + noahmp%biochem%param%CarboxylRateMax25C = NoahmpIO%VCMX25_TABLE (VegType) + noahmp%biochem%param%CarboxylRateMaxQ10 = NoahmpIO%AVCMX_TABLE (VegType) + noahmp%biochem%param%PhotosynPathC3 = NoahmpIO%C3PSN_TABLE (VegType) + noahmp%biochem%param%SlopeConductToPhotosyn = NoahmpIO%MP_TABLE (VegType) + noahmp%biochem%param%RespMaintQ10 = NoahmpIO%ARM_TABLE (VegType) + noahmp%biochem%param%RespMaintLeaf25C = NoahmpIO%RMF25_TABLE (VegType) + noahmp%biochem%param%RespMaintStem25C = NoahmpIO%RMS25_TABLE (VegType) + noahmp%biochem%param%RespMaintRoot25C = NoahmpIO%RMR25_TABLE (VegType) + noahmp%biochem%param%WoodToRootRatio = NoahmpIO%WRRAT_TABLE (VegType) + noahmp%biochem%param%WoodPoolIndex = NoahmpIO%WDPOOL_TABLE (VegType) + noahmp%biochem%param%TurnoverCoeffLeafVeg = NoahmpIO%LTOVRC_TABLE (VegType) + noahmp%biochem%param%TemperaureLeafFreeze = NoahmpIO%TDLEF_TABLE (VegType) + noahmp%biochem%param%LeafDeathWaterCoeffVeg = NoahmpIO%DILEFW_TABLE (VegType) + noahmp%biochem%param%LeafDeathTempCoeffVeg = NoahmpIO%DILEFC_TABLE (VegType) + noahmp%biochem%param%GrowthRespFrac = NoahmpIO%FRAGR_TABLE (VegType) + noahmp%biochem%param%MicroRespCoeff = NoahmpIO%MRP_TABLE (VegType) + noahmp%biochem%param%TemperatureMinPhotosyn = NoahmpIO%TMIN_TABLE (VegType) + noahmp%biochem%param%LeafAreaPerMass1side = NoahmpIO%SLA_TABLE (VegType) + noahmp%biochem%param%StemAreaIndexMin = NoahmpIO%XSAMIN_TABLE (VegType) + noahmp%biochem%param%WoodAllocFac = NoahmpIO%BF_TABLE (VegType) + noahmp%biochem%param%WaterStressCoeff = NoahmpIO%WSTRC_TABLE (VegType) + noahmp%biochem%param%LeafAreaIndexMin = NoahmpIO%LAIMIN_TABLE (VegType) + noahmp%biochem%param%TurnoverCoeffRootVeg = NoahmpIO%RTOVRC_TABLE (VegType) + noahmp%biochem%param%WoodRespCoeff = NoahmpIO%RSWOODC_TABLE(VegType) + ! crop model specific parameters + if ( (OptCropModel > 0) .and. (CropType > 0) ) then + noahmp%biochem%param%DatePlanting = NoahmpIO%PLTDAY_TABLE (CropType) + noahmp%biochem%param%DateHarvest = NoahmpIO%HSDAY_TABLE (CropType) + noahmp%biochem%param%NitrogenConcFoliageMax = NoahmpIO%FOLNMXI_TABLE (CropType) + noahmp%biochem%param%QuantumEfficiency25C = NoahmpIO%QE25I_TABLE (CropType) + noahmp%biochem%param%CarboxylRateMax25C = NoahmpIO%VCMX25I_TABLE (CropType) + noahmp%biochem%param%CarboxylRateMaxQ10 = NoahmpIO%AVCMXI_TABLE (CropType) + noahmp%biochem%param%PhotosynPathC3 = NoahmpIO%C3PSNI_TABLE (CropType) + noahmp%biochem%param%SlopeConductToPhotosyn = NoahmpIO%MPI_TABLE (CropType) + noahmp%biochem%param%RespMaintQ10 = NoahmpIO%Q10MR_TABLE (CropType) + noahmp%biochem%param%RespMaintLeaf25C = NoahmpIO%LFMR25_TABLE (CropType) + noahmp%biochem%param%RespMaintStem25C = NoahmpIO%STMR25_TABLE (CropType) + noahmp%biochem%param%RespMaintRoot25C = NoahmpIO%RTMR25_TABLE (CropType) + noahmp%biochem%param%GrowthRespFrac = NoahmpIO%FRA_GR_TABLE (CropType) + noahmp%biochem%param%TemperaureLeafFreeze = NoahmpIO%LEFREEZ_TABLE (CropType) + noahmp%biochem%param%LeafAreaPerBiomass = NoahmpIO%BIO2LAI_TABLE (CropType) + noahmp%biochem%param%TempBaseGrowDegDay = NoahmpIO%GDDTBASE_TABLE (CropType) + noahmp%biochem%param%TempMaxGrowDegDay = NoahmpIO%GDDTCUT_TABLE (CropType) + noahmp%biochem%param%GrowDegDayEmerg = NoahmpIO%GDDS1_TABLE (CropType) + noahmp%biochem%param%GrowDegDayInitVeg = NoahmpIO%GDDS2_TABLE (CropType) + noahmp%biochem%param%GrowDegDayPostVeg = NoahmpIO%GDDS3_TABLE (CropType) + noahmp%biochem%param%GrowDegDayInitReprod = NoahmpIO%GDDS4_TABLE (CropType) + noahmp%biochem%param%GrowDegDayMature = NoahmpIO%GDDS5_TABLE (CropType) + noahmp%biochem%param%PhotosynRadFrac = NoahmpIO%I2PAR_TABLE (CropType) + noahmp%biochem%param%TempMinCarbonAssim = NoahmpIO%TASSIM0_TABLE (CropType) + noahmp%biochem%param%TempMaxCarbonAssim = NoahmpIO%TASSIM1_TABLE (CropType) + noahmp%biochem%param%TempMaxCarbonAssimMax = NoahmpIO%TASSIM2_TABLE (CropType) + noahmp%biochem%param%CarbonAssimRefMax = NoahmpIO%AREF_TABLE (CropType) + noahmp%biochem%param%LightExtCoeff = NoahmpIO%K_TABLE (CropType) + noahmp%biochem%param%LightUseEfficiency = NoahmpIO%EPSI_TABLE (CropType) + noahmp%biochem%param%CarbonAssimReducFac = NoahmpIO%PSNRF_TABLE (CropType) + noahmp%biochem%param%RespMaintGrain25C = NoahmpIO%GRAINMR25_TABLE(CropType) + noahmp%biochem%param%LeafDeathTempCoeffCrop = NoahmpIO%DILE_FC_TABLE (CropType,:) + noahmp%biochem%param%LeafDeathWaterCoeffCrop = NoahmpIO%DILE_FW_TABLE (CropType,:) + noahmp%biochem%param%CarbohydrLeafToGrain = NoahmpIO%LFCT_TABLE (CropType,:) + noahmp%biochem%param%CarbohydrStemToGrain = NoahmpIO%STCT_TABLE (CropType,:) + noahmp%biochem%param%CarbohydrRootToGrain = NoahmpIO%RTCT_TABLE (CropType,:) + noahmp%biochem%param%CarbohydrFracToLeaf = NoahmpIO%LFPT_TABLE (CropType,:) + noahmp%biochem%param%CarbohydrFracToStem = NoahmpIO%STPT_TABLE (CropType,:) + noahmp%biochem%param%CarbohydrFracToRoot = NoahmpIO%RTPT_TABLE (CropType,:) + noahmp%biochem%param%CarbohydrFracToGrain = NoahmpIO%GRAINPT_TABLE (CropType,:) + noahmp%biochem%param%TurnoverCoeffLeafCrop = NoahmpIO%LF_OVRC_TABLE (CropType,:) + noahmp%biochem%param%TurnoverCoeffStemCrop = NoahmpIO%ST_OVRC_TABLE (CropType,:) + noahmp%biochem%param%TurnoverCoeffRootCrop = NoahmpIO%RT_OVRC_TABLE (CropType,:) + + if ( OptCropModel == 1 ) then + noahmp%biochem%param%DatePlanting = NoahmpIO%PLANTING(I) + noahmp%biochem%param%DateHarvest = NoahmpIO%HARVEST(I) + noahmp%biochem%param%GrowDegDayEmerg = NoahmpIO%SEASON_GDD(I) / 1770.0 * & + noahmp%biochem%param%GrowDegDayEmerg + noahmp%biochem%param%GrowDegDayInitVeg = NoahmpIO%SEASON_GDD(I) / 1770.0 * & + noahmp%biochem%param%GrowDegDayInitVeg + noahmp%biochem%param%GrowDegDayPostVeg = NoahmpIO%SEASON_GDD(I) / 1770.0 * & + noahmp%biochem%param%GrowDegDayPostVeg + noahmp%biochem%param%GrowDegDayInitReprod = NoahmpIO%SEASON_GDD(I) / 1770.0 * & + noahmp%biochem%param%GrowDegDayInitReprod + noahmp%biochem%param%GrowDegDayMature = NoahmpIO%SEASON_GDD(I) / 1770.0 * & + noahmp%biochem%param%GrowDegDayMature + endif + endif ! activate crop parameters + + if ( noahmp%config%nmlist%OptIrrigation == 2 ) then + noahmp%biochem%param%DatePlanting = NoahmpIO%PLANTING(I) + noahmp%biochem%param%DateHarvest = NoahmpIO%HARVEST (I) + endif + + end associate + + end subroutine BiochemVarInTransfer + +end module BiochemVarInTransferMod diff --git a/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/BiochemVarOutTransferMod.F90 b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/BiochemVarOutTransferMod.F90 new file mode 100644 index 000000000..b8e81b65f --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/BiochemVarOutTransferMod.F90 @@ -0,0 +1,54 @@ +module BiochemVarOutTransferMod + +!!! Transfer column (1-D) biochemistry variables to 2D NoahmpIO for output + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use Machine + use NoahmpIOVarType + use NoahmpVarType + + implicit none + +contains + +!=== Transfer model states to output ===== + + subroutine BiochemVarOutTransfer(noahmp, NoahmpIO) + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + type(NoahmpIO_type), intent(inout) :: NoahmpIO + +! --------------------------------------------------------------------- + associate( & + I => noahmp%config%domain%GridIndexI & + ) +! --------------------------------------------------------------------- + + ! biochem state variables + NoahmpIO%LFMASSXY(I) = noahmp%biochem%state%LeafMass + NoahmpIO%RTMASSXY(I) = noahmp%biochem%state%RootMass + NoahmpIO%STMASSXY(I) = noahmp%biochem%state%StemMass + NoahmpIO%WOODXY (I) = noahmp%biochem%state%WoodMass + NoahmpIO%STBLCPXY(I) = noahmp%biochem%state%CarbonMassDeepSoil + NoahmpIO%FASTCPXY(I) = noahmp%biochem%state%CarbonMassShallowSoil + NoahmpIO%GDDXY (I) = noahmp%biochem%state%GrowDegreeDay + NoahmpIO%PGSXY (I) = noahmp%biochem%state%PlantGrowStage + NoahmpIO%GRAINXY (I) = noahmp%biochem%state%GrainMass + + ! biochem flux variables + NoahmpIO%NEEXY (I) = noahmp%biochem%flux%NetEcoExchange + NoahmpIO%GPPXY (I) = noahmp%biochem%flux%GrossPriProduction + NoahmpIO%NPPXY (I) = noahmp%biochem%flux%NetPriProductionTot + NoahmpIO%PSNXY (I) = noahmp%biochem%flux%PhotosynTotal + + end associate + + end subroutine BiochemVarOutTransfer + +end module BiochemVarOutTransferMod diff --git a/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/ConfigVarInTransferMod.F90 b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/ConfigVarInTransferMod.F90 new file mode 100644 index 000000000..2de35ed9c --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/ConfigVarInTransferMod.F90 @@ -0,0 +1,170 @@ +module ConfigVarInTransferMod + +!!! Transfer input 2-D NoahmpIO Configuration variables to 1-D column variable +!!! 1-D variables should be first defined in /src/ConfigVarType.F90 +!!! 2-D variables should be first defined in NoahmpIOVarType.F90 + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use Machine + use NoahmpIOVarType + use NoahmpVarType + + implicit none + +contains + +!=== initialize with input/restart data or table values + + subroutine ConfigVarInTransfer(noahmp, NoahmpIO) + + implicit none + + type(NoahmpIO_type) , intent(inout) :: NoahmpIO + type(noahmp_type), intent(inout) :: noahmp + +! --------------------------------------------------------------------- + associate( & + I => NoahmpIO%I ,& + NumSnowLayerMax => NoahmpIO%NSNOW ,& + NumSoilLayer => NoahmpIO%NSOIL & + ) +! --------------------------------------------------------------------- + + ! config namelist variable + noahmp%config%nmlist%OptDynamicVeg = NoahmpIO%IOPT_DVEG + noahmp%config%nmlist%OptRainSnowPartition = NoahmpIO%IOPT_SNF + noahmp%config%nmlist%OptSoilWaterTranspiration = NoahmpIO%IOPT_BTR + noahmp%config%nmlist%OptGroundResistanceEvap = NoahmpIO%IOPT_RSF + noahmp%config%nmlist%OptSurfaceDrag = NoahmpIO%IOPT_SFC + noahmp%config%nmlist%OptStomataResistance = NoahmpIO%IOPT_CRS + noahmp%config%nmlist%OptSnowAlbedo = NoahmpIO%IOPT_ALB + noahmp%config%nmlist%OptCanopyRadiationTransfer = NoahmpIO%IOPT_RAD + noahmp%config%nmlist%OptSnowSoilTempTime = NoahmpIO%IOPT_STC + noahmp%config%nmlist%OptSnowThermConduct = NoahmpIO%IOPT_TKSNO + noahmp%config%nmlist%OptSoilTemperatureBottom = NoahmpIO%IOPT_TBOT + noahmp%config%nmlist%OptSoilSupercoolWater = NoahmpIO%IOPT_FRZ + noahmp%config%nmlist%OptSoilPermeabilityFrozen = NoahmpIO%IOPT_INF + noahmp%config%nmlist%OptDynVicInfiltration = NoahmpIO%IOPT_INFDV + noahmp%config%nmlist%OptTileDrainage = NoahmpIO%IOPT_TDRN + noahmp%config%nmlist%OptIrrigation = NoahmpIO%IOPT_IRR + noahmp%config%nmlist%OptIrrigationMethod = NoahmpIO%IOPT_IRRM + noahmp%config%nmlist%OptCropModel = NoahmpIO%IOPT_CROP + noahmp%config%nmlist%OptSoilProperty = NoahmpIO%IOPT_SOIL + noahmp%config%nmlist%OptPedotransfer = NoahmpIO%IOPT_PEDO + noahmp%config%nmlist%OptRunoffSurface = NoahmpIO%IOPT_RUNSRF + noahmp%config%nmlist%OptRunoffSubsurface = NoahmpIO%IOPT_RUNSUB + noahmp%config%nmlist%OptGlacierTreatment = NoahmpIO%IOPT_GLA + + ! config domain variable + noahmp%config%domain%SurfaceType = 1 + noahmp%config%domain%NumSwRadBand = 2 + noahmp%config%domain%SoilColor = 4 + noahmp%config%domain%NumCropGrowStage = 8 + noahmp%config%domain%FlagSoilProcess = NoahmpIO%calculate_soil + noahmp%config%domain%NumSoilTimeStep = NoahmpIO%soil_update_steps + noahmp%config%domain%NumSnowLayerMax = NoahmpIO%NSNOW + noahmp%config%domain%NumSnowLayerNeg = NoahmpIO%ISNOWXY(I) + noahmp%config%domain%NumSoilLayer = NoahmpIO%NSOIL + noahmp%config%domain%GridIndexI = NoahmpIO%I + noahmp%config%domain%GridIndexJ = NoahmpIO%J + noahmp%config%domain%MainTimeStep = NoahmpIO%DTBL + noahmp%config%domain%SoilTimeStep = NoahmpIO%DTBL * NoahmpIO%soil_update_steps + noahmp%config%domain%GridSize = NoahmpIO%DX + noahmp%config%domain%LandUseDataName = NoahmpIO%LLANDUSE + noahmp%config%domain%VegType = NoahmpIO%IVGTYP(I) + noahmp%config%domain%CropType = NoahmpIO%CROPCAT(I) + noahmp%config%domain%IndicatorIceSfc = NoahmpIO%ICE + noahmp%config%domain%DayJulianInYear = NoahmpIO%JULIAN + noahmp%config%domain%NumDayInYear = NoahmpIO%YEARLEN + noahmp%config%domain%Latitude = NoahmpIO%XLAT(I) + noahmp%config%domain%RefHeightAboveSfc = NoahmpIO%DZ8W(I,1)*0.5 + noahmp%config%domain%ThicknessAtmosBotLayer = NoahmpIO%DZ8W(I,1) + noahmp%config%domain%CosSolarZenithAngle = NoahmpIO%COSZEN(I) + noahmp%config%domain%IndexWaterPoint = NoahmpIO%ISWATER_TABLE + noahmp%config%domain%IndexBarrenPoint = NoahmpIO%ISBARREN_TABLE + noahmp%config%domain%IndexIcePoint = NoahmpIO%ISICE_TABLE + noahmp%config%domain%IndexCropPoint = NoahmpIO%ISCROP_TABLE + noahmp%config%domain%IndexEBLForest = NoahmpIO%EBLFOREST_TABLE + noahmp%config%domain%RunoffSlopeType = NoahmpIO%SLOPETYP + noahmp%config%domain%DepthSoilTempBottom = NoahmpIO%ZBOT_TABLE + + ! the following initialization cannot be done in ConfigVarInitMod + ! because the NumSoilLayer and NumSnowLayerMax are initialized with input values in this module + if ( .not. allocated(noahmp%config%domain%DepthSoilLayer) ) & + allocate( noahmp%config%domain%DepthSoilLayer(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%config%domain%ThicknessSoilLayer) ) & + allocate( noahmp%config%domain%ThicknessSoilLayer(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%config%domain%SoilType) ) & + allocate( noahmp%config%domain%SoilType(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%config%domain%ThicknessSnowSoilLayer) ) & + allocate( noahmp%config%domain%ThicknessSnowSoilLayer(-NumSnowLayerMax+1:NumSoilLayer) ) + if ( .not. allocated(noahmp%config%domain%DepthSnowSoilLayer) ) & + allocate( noahmp%config%domain%DepthSnowSoilLayer(-NumSnowLayerMax+1:NumSoilLayer) ) + + noahmp%config%domain%SoilType (:) = undefined_int + noahmp%config%domain%DepthSoilLayer (:) = undefined_real + noahmp%config%domain%ThicknessSoilLayer (:) = undefined_real + noahmp%config%domain%ThicknessSnowSoilLayer(:) = undefined_real + noahmp%config%domain%DepthSnowSoilLayer (:) = undefined_real + + if ( noahmp%config%nmlist%OptSoilProperty == 1 ) then + noahmp%config%domain%SoilType(1:NumSoilLayer) = NoahmpIO%ISLTYP(I) ! soil type same in all layers + elseif ( noahmp%config%nmlist%OptSoilProperty == 2 ) then + noahmp%config%domain%SoilType(1) = nint(NoahmpIO%SOILCL1(I)) ! soil type in layer1 + noahmp%config%domain%SoilType(2) = nint(NoahmpIO%SOILCL2(I)) ! soil type in layer2 + noahmp%config%domain%SoilType(3) = nint(NoahmpIO%SOILCL3(I)) ! soil type in layer3 + noahmp%config%domain%SoilType(4) = nint(NoahmpIO%SOILCL4(I)) ! soil type in layer4 + elseif ( noahmp%config%nmlist%OptSoilProperty == 3 ) then + noahmp%config%domain%SoilType(1:NumSoilLayer) = NoahmpIO%ISLTYP(I) ! to initialize with default + endif + + noahmp%config%domain%DepthSoilLayer(1:NumSoilLayer) = NoahmpIO%ZSOIL(1:NumSoilLayer) + noahmp%config%domain%DepthSnowSoilLayer(-NumSnowLayerMax+1:NumSoilLayer) = & + NoahmpIO%ZSNSOXY(I,-NumSnowLayerMax+1:NumSoilLayer) + + ! treatment for urban point + if ( (NoahmpIO%IVGTYP(I) == NoahmpIO%ISURBAN_TABLE) .or. (NoahmpIO%IVGTYP(I) > NoahmpIO%URBTYPE_beg) ) then + noahmp%config%domain%FlagUrban = .true. + if(NoahmpIO%SF_URBAN_PHYSICS == 0 ) then + noahmp%config%domain%VegType = NoahmpIO%ISURBAN_TABLE + else + noahmp%config%domain%VegType = NoahmpIO%NATURAL_TABLE ! set urban vegetation type based on table natural + NoahmpIO%GVFMAX(I) = 0.96 * 100.0 ! unit: % + endif + endif + + ! treatment for crop point + noahmp%config%domain%CropType = 0 + if ( (NoahmpIO%IOPT_CROP > 0) .and. (NoahmpIO%IVGTYP(I) == NoahmpIO%ISCROP_TABLE) ) & + noahmp%config%domain%CropType = NoahmpIO%DEFAULT_CROP_TABLE + + if ( (NoahmpIO%IOPT_CROP > 0) .and. (NoahmpIO%CROPCAT(I) > 0) ) then + noahmp%config%domain%CropType = NoahmpIO%CROPCAT(I) + noahmp%config%domain%VegType = NoahmpIO%ISCROP_TABLE + NoahmpIO%VEGFRA(I) = 0.95 * 100.0 ! unit: % + NoahmpIO%GVFMAX(I) = 0.95 * 100.0 ! unit: % + endif + + ! correct inconsistent soil type + if ( any(noahmp%config%domain%SoilType == 14) .and. (NoahmpIO%XICE(I) == 0.0) ) then + write(*,*) "SOIL TYPE FOUND TO BE WATER AT A LAND-POINT" + write(*,*) "RESET SOIL type to SANDY CLAY LOAM at grid = ", I + noahmp%config%domain%SoilType = 7 + endif + + ! set warning message for inconsistent surface and subsurface runoff option + ! for now, only the same options for surface and subsurface runoff have been tested + if ( noahmp%config%nmlist%OptRunoffSurface /= noahmp%config%nmlist%OptRunoffSubsurface ) then + write(*,*) "Warning: Surface and subsurface runoff options are inconsistent! They may be incompatible!" + write(*,*) "Warning: Currently only the same options for surface and subsurface runoff are tested." + endif + + end associate + + end subroutine ConfigVarInTransfer + +end module ConfigVarInTransferMod diff --git a/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/ConfigVarOutTransferMod.F90 b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/ConfigVarOutTransferMod.F90 new file mode 100644 index 000000000..d261f45b9 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/ConfigVarOutTransferMod.F90 @@ -0,0 +1,45 @@ +module ConfigVarOutTransferMod + +!!! To transfer 1D Noah-MP column Config variables to 2D NoahmpIO for output + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use Machine + use NoahmpIOVarType + use NoahmpVarType + + implicit none + +contains + +!=== Transfer model states to output===== + + subroutine ConfigVarOutTransfer(noahmp, NoahmpIO) + + implicit none + + type(NoahmpIO_type) , intent(inout) :: NoahmpIO + type(noahmp_type), intent(inout) :: noahmp + +! ---------------------------------------------------------------------- + associate( & + I => noahmp%config%domain%GridIndexI ,& + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& + NumSoilLayer => noahmp%config%domain%NumSoilLayer & + ) +! ---------------------------------------------------------------------- + + ! config domain variables + NoahmpIO%ISNOWXY(I) = noahmp%config%domain%NumSnowLayerNeg + NoahmpIO%ZSNSOXY(I,-NumSnowLayerMax+1:NumSoilLayer) = & + noahmp%config%domain%DepthSnowSoilLayer(-NumSnowLayerMax+1:NumSoilLayer) + NoahmpIO%FORCZLSM(I) = noahmp%config%domain%RefHeightAboveSfc + + end associate + + end subroutine ConfigVarOutTransfer + +end module ConfigVarOutTransferMod diff --git a/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/EnergyVarInTransferMod.F90 b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/EnergyVarInTransferMod.F90 new file mode 100644 index 000000000..f0a96a579 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/EnergyVarInTransferMod.F90 @@ -0,0 +1,154 @@ +module EnergyVarInTransferMod + +!!! Transfer input 2-D NoahmpIO Energy variables to 1-D column variable +!!! 1-D variables should be first defined in /src/EnergyVarType.F90 +!!! 2-D variables should be first defined in NoahmpIOVarType.F90 + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use Machine + use NoahmpIOVarType + use NoahmpVarType + + implicit none + +contains + +!=== initialize with input data or table values + + subroutine EnergyVarInTransfer(noahmp, NoahmpIO) + + implicit none + + type(NoahmpIO_type), intent(inout) :: NoahmpIO + type(noahmp_type), intent(inout) :: noahmp + + ! local loop index + integer :: SoilLayerIndex + +! ------------------------------------------------------------------------- + associate( & + I => noahmp%config%domain%GridIndexI ,& + VegType => noahmp%config%domain%VegType ,& + SoilType => noahmp%config%domain%SoilType ,& + CropType => noahmp%config%domain%CropType ,& + SoilColor => noahmp%config%domain%SoilColor ,& + FlagUrban => noahmp%config%domain%FlagUrban ,& + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& + NumSwRadBand => noahmp%config%domain%NumSwRadBand & + ) +! ------------------------------------------------------------------------- + + ! energy state variables + noahmp%energy%state%LeafAreaIndex = NoahmpIO%LAI (I) + noahmp%energy%state%StemAreaIndex = NoahmpIO%XSAIXY (I) + noahmp%energy%state%SpecHumiditySfcMean = NoahmpIO%QSFC (I) + noahmp%energy%state%TemperatureGrd = NoahmpIO%TGXY (I) + noahmp%energy%state%TemperatureCanopy = NoahmpIO%TVXY (I) + noahmp%energy%state%SnowAgeNondim = NoahmpIO%TAUSSXY (I) + noahmp%energy%state%AlbedoSnowPrev = NoahmpIO%ALBOLDXY(I) + noahmp%energy%state%PressureVaporCanAir = NoahmpIO%EAHXY (I) + noahmp%energy%state%TemperatureCanopyAir = NoahmpIO%TAHXY (I) + noahmp%energy%state%ExchCoeffShSfc = NoahmpIO%CHXY (I) + noahmp%energy%state%ExchCoeffMomSfc = NoahmpIO%CMXY (I) + noahmp%energy%state%TemperatureSoilSnow(-NumSnowLayerMax+1:0) = NoahmpIO%TSNOXY (I,-NumSnowLayerMax+1:0) + noahmp%energy%state%TemperatureSoilSnow(1:NumSoilLayer) = NoahmpIO%TSLB (I,1:NumSoilLayer) + noahmp%energy%state%PressureAtmosCO2 = NoahmpIO%CO2_TABLE * noahmp%forcing%PressureAirRefHeight + noahmp%energy%state%PressureAtmosO2 = NoahmpIO%O2_TABLE * noahmp%forcing%PressureAirRefHeight + ! vegetation treatment for USGS land types (playa, lava, sand to bare) + if ( (VegType == 25) .or. (VegType == 26) .or. (VegType == 27) ) then + noahmp%energy%state%VegFrac = 0.0 + noahmp%energy%state%LeafAreaIndex = 0.0 + endif + + ! energy flux variables + noahmp%energy%flux%HeatGroundTotAcc = NoahmpIO%ACC_SSOILXY(I) + + ! energy parameter variables + noahmp%energy%param%SoilHeatCapacity = NoahmpIO%CSOIL_TABLE + noahmp%energy%param%SnowAgeFacBats = NoahmpIO%TAU0_TABLE + noahmp%energy%param%SnowGrowVapFacBats = NoahmpIO%GRAIN_GROWTH_TABLE + noahmp%energy%param%SnowSootFacBats = NoahmpIO%DIRT_SOOT_TABLE + noahmp%energy%param%SnowGrowFrzFacBats = NoahmpIO%EXTRA_GROWTH_TABLE + noahmp%energy%param%SolarZenithAdjBats = NoahmpIO%BATS_COSZ_TABLE + noahmp%energy%param%FreshSnoAlbVisBats = NoahmpIO%BATS_VIS_NEW_TABLE + noahmp%energy%param%FreshSnoAlbNirBats = NoahmpIO%BATS_NIR_NEW_TABLE + noahmp%energy%param%SnoAgeFacDifVisBats = NoahmpIO%BATS_VIS_AGE_TABLE + noahmp%energy%param%SnoAgeFacDifNirBats = NoahmpIO%BATS_NIR_AGE_TABLE + noahmp%energy%param%SzaFacDirVisBats = NoahmpIO%BATS_VIS_DIR_TABLE + noahmp%energy%param%SzaFacDirNirBats = NoahmpIO%BATS_NIR_DIR_TABLE + noahmp%energy%param%SnowAlbRefClass = NoahmpIO%CLASS_ALB_REF_TABLE + noahmp%energy%param%SnowAgeFacClass = NoahmpIO%CLASS_SNO_AGE_TABLE + noahmp%energy%param%SnowAlbFreshClass = NoahmpIO%CLASS_ALB_NEW_TABLE + noahmp%energy%param%UpscatterCoeffSnowDir = NoahmpIO%BETADS_TABLE + noahmp%energy%param%UpscatterCoeffSnowDif = NoahmpIO%BETAIS_TABLE + noahmp%energy%param%ZilitinkevichCoeff = NoahmpIO%CZIL_TABLE + noahmp%energy%param%EmissivitySnow = NoahmpIO%SNOW_EMIS_TABLE + noahmp%energy%param%EmissivitySoilLake = NoahmpIO%EG_TABLE + noahmp%energy%param%AlbedoLandIce = NoahmpIO%ALBICE_TABLE + noahmp%energy%param%RoughLenMomSnow = NoahmpIO%Z0SNO_TABLE + noahmp%energy%param%RoughLenMomSoil = NoahmpIO%Z0SOIL_TABLE + noahmp%energy%param%RoughLenMomLake = NoahmpIO%Z0LAKE_TABLE + noahmp%energy%param%EmissivityIceSfc = NoahmpIO%EICE_TABLE + noahmp%energy%param%ResistanceSoilExp = NoahmpIO%RSURF_EXP_TABLE + noahmp%energy%param%ResistanceSnowSfc = NoahmpIO%RSURF_SNOW_TABLE + noahmp%energy%param%VegFracAnnMax = NoahmpIO%GVFMAX(I) / 100.0 + noahmp%energy%param%VegFracGreen = NoahmpIO%VEGFRA(I) / 100.0 + noahmp%energy%param%TreeCrownRadius = NoahmpIO%RC_TABLE (VegType) + noahmp%energy%param%HeightCanopyTop = NoahmpIO%HVT_TABLE (VegType) + noahmp%energy%param%HeightCanopyBot = NoahmpIO%HVB_TABLE (VegType) + noahmp%energy%param%RoughLenMomVeg = NoahmpIO%Z0MVT_TABLE (VegType) + noahmp%energy%param%CanopyWindExtFac = NoahmpIO%CWPVT_TABLE (VegType) + noahmp%energy%param%TreeDensity = NoahmpIO%DEN_TABLE (VegType) + noahmp%energy%param%CanopyOrientIndex = NoahmpIO%XL_TABLE (VegType) + noahmp%energy%param%ConductanceLeafMin = NoahmpIO%BP_TABLE (VegType) + noahmp%energy%param%Co2MmConst25C = NoahmpIO%KC25_TABLE (VegType) + noahmp%energy%param%O2MmConst25C = NoahmpIO%KO25_TABLE (VegType) + noahmp%energy%param%Co2MmConstQ10 = NoahmpIO%AKC_TABLE (VegType) + noahmp%energy%param%O2MmConstQ10 = NoahmpIO%AKO_TABLE (VegType) + noahmp%energy%param%RadiationStressFac = NoahmpIO%RGL_TABLE (VegType) + noahmp%energy%param%ResistanceStomataMin = NoahmpIO%RS_TABLE (VegType) + noahmp%energy%param%ResistanceStomataMax = NoahmpIO%RSMAX_TABLE (VegType) + noahmp%energy%param%AirTempOptimTransp = NoahmpIO%TOPT_TABLE (VegType) + noahmp%energy%param%VaporPresDeficitFac = NoahmpIO%HS_TABLE (VegType) + noahmp%energy%param%LeafDimLength = NoahmpIO%DLEAF_TABLE (VegType) + noahmp%energy%param%HeatCapacCanFac = NoahmpIO%CBIOM_TABLE (VegType) + noahmp%energy%param%LeafAreaIndexMon (1:12) = NoahmpIO%LAIM_TABLE (VegType,1:12) + noahmp%energy%param%StemAreaIndexMon (1:12) = NoahmpIO%SAIM_TABLE (VegType,1:12) + noahmp%energy%param%ReflectanceLeaf (1:NumSwRadBand) = NoahmpIO%RHOL_TABLE (VegType,1:NumSwRadBand) + noahmp%energy%param%ReflectanceStem (1:NumSwRadBand) = NoahmpIO%RHOS_TABLE (VegType,1:NumSwRadBand) + noahmp%energy%param%TransmittanceLeaf(1:NumSwRadBand) = NoahmpIO%TAUL_TABLE (VegType,1:NumSwRadBand) + noahmp%energy%param%TransmittanceStem(1:NumSwRadBand) = NoahmpIO%TAUS_TABLE (VegType,1:NumSwRadBand) + noahmp%energy%param%AlbedoSoilSat (1:NumSwRadBand) = NoahmpIO%ALBSAT_TABLE(SoilColor,1:NumSwRadBand) + noahmp%energy%param%AlbedoSoilDry (1:NumSwRadBand) = NoahmpIO%ALBDRY_TABLE(SoilColor,1:NumSwRadBand) + noahmp%energy%param%AlbedoLakeFrz (1:NumSwRadBand) = NoahmpIO%ALBLAK_TABLE(1:NumSwRadBand) + noahmp%energy%param%ScatterCoeffSnow (1:NumSwRadBand) = NoahmpIO%OMEGAS_TABLE(1:NumSwRadBand) + + do SoilLayerIndex = 1, size(SoilType) + noahmp%energy%param%SoilQuartzFrac(SoilLayerIndex) = NoahmpIO%QUARTZ_TABLE(SoilType(SoilLayerIndex)) + enddo + + ! spatial varying soil input + if ( noahmp%config%nmlist%OptSoilProperty == 4 ) then + noahmp%energy%param%SoilQuartzFrac(1:NumSoilLayer) = NoahmpIO%QUARTZ_3D(I,1:NumSoilLayer) + endif + + if ( FlagUrban .eqv. .true. ) noahmp%energy%param%SoilHeatCapacity = 3.0e6 + + if ( CropType > 0 ) then + noahmp%energy%param%ConductanceLeafMin = NoahmpIO%BPI_TABLE (CropType) + noahmp%energy%param%Co2MmConst25C = NoahmpIO%KC25I_TABLE(CropType) + noahmp%energy%param%O2MmConst25C = NoahmpIO%KO25I_TABLE(CropType) + noahmp%energy%param%Co2MmConstQ10 = NoahmpIO%AKCI_TABLE (CropType) + noahmp%energy%param%O2MmConstQ10 = NoahmpIO%AKOI_TABLE (CropType) + endif + + end associate + + end subroutine EnergyVarInTransfer + +end module EnergyVarInTransferMod diff --git a/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/EnergyVarOutTransferMod.F90 b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/EnergyVarOutTransferMod.F90 new file mode 100644 index 000000000..a3124b3a2 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/EnergyVarOutTransferMod.F90 @@ -0,0 +1,190 @@ +module EnergyVarOutTransferMod + +!!! Transfer column (1-D) Noah-MP Energy variables to 2D NoahmpIO for output + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use Machine + use NoahmpIOVarType + use NoahmpVarType + + implicit none + +contains + +!=== Transfer model states to output ===== + + subroutine EnergyVarOutTransfer(noahmp, NoahmpIO) + + implicit none + + type(NoahmpIO_type), intent(inout) :: NoahmpIO + type(noahmp_type), intent(inout) :: noahmp + + ! local variables + integer :: LoopInd ! snow/soil layer loop index + real(kind=kind_noahmp) :: LeafAreaIndSunlit ! sunlit leaf area index [m2/m2] + real(kind=kind_noahmp) :: LeafAreaIndShade ! shaded leaf area index [m2/m2] + real(kind=kind_noahmp) :: ResistanceLeafBoundary ! leaf boundary layer resistance [s/m] + real(kind=kind_noahmp) :: ThicknessSnowSoilLayer ! temporary snow/soil layer thickness [m] + +!----------------------------------------------------------------------- + associate( & + I => noahmp%config%domain%GridIndexI ,& + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& + IndicatorIceSfc => noahmp%config%domain%IndicatorIceSfc & + ) +!----------------------------------------------------------------------- + + ! special treatment for glacier point output + if ( IndicatorIceSfc == -1 ) then ! land ice point + noahmp%energy%state%VegFrac = 0.0 + noahmp%energy%state%RoughLenMomSfcToAtm = 0.002 + noahmp%energy%flux%RadSwAbsVeg = 0.0 + noahmp%energy%flux%RadLwNetCanopy = 0.0 + noahmp%energy%flux%RadLwNetVegGrd = 0.0 + noahmp%energy%flux%HeatSensibleCanopy = 0.0 + noahmp%energy%flux%HeatSensibleVegGrd = 0.0 + noahmp%energy%flux%HeatLatentVegGrd = 0.0 + noahmp%energy%flux%HeatGroundVegGrd = 0.0 + noahmp%energy%flux%HeatCanStorageChg = 0.0 + noahmp%energy%flux%HeatLatentCanTransp = 0.0 + noahmp%energy%flux%HeatLatentCanEvap = 0.0 + noahmp%energy%flux%HeatPrecipAdvCanopy = 0.0 + noahmp%energy%flux%HeatPrecipAdvVegGrd = 0.0 + noahmp%energy%flux%HeatLatentCanopy = 0.0 + noahmp%energy%flux%HeatLatentTransp = 0.0 + noahmp%energy%flux%RadLwNetBareGrd = noahmp%energy%flux%RadLwNetSfc + noahmp%energy%flux%HeatSensibleBareGrd = noahmp%energy%flux%HeatSensibleSfc + noahmp%energy%flux%HeatLatentBareGrd = noahmp%energy%flux%HeatLatentGrd + noahmp%energy%flux%HeatGroundBareGrd = noahmp%energy%flux%HeatGroundTot + noahmp%energy%state%TemperatureGrdBare = noahmp%energy%state%TemperatureGrd + noahmp%energy%state%ExchCoeffShBare = noahmp%energy%state%ExchCoeffShSfc + NoahmpIO%LH(I) = noahmp%energy%flux%HeatLatentGrd + endif + + if ( IndicatorIceSfc == 0 ) then ! land soil point + NoahmpIO%LH(I) = noahmp%energy%flux%HeatLatentGrd + noahmp%energy%flux%HeatLatentCanopy + & + noahmp%energy%flux%HeatLatentTransp + noahmp%energy%flux%HeatLatentIrriEvap + endif + + ! energy flux variables + NoahmpIO%HFX (I) = noahmp%energy%flux%HeatSensibleSfc + NoahmpIO%GRDFLX (I) = noahmp%energy%flux%HeatGroundTot + NoahmpIO%FSAXY (I) = noahmp%energy%flux%RadSwAbsSfc + NoahmpIO%FIRAXY (I) = noahmp%energy%flux%RadLwNetSfc + NoahmpIO%APARXY (I) = noahmp%energy%flux%RadPhotoActAbsCan + NoahmpIO%SAVXY (I) = noahmp%energy%flux%RadSwAbsVeg + NoahmpIO%SAGXY (I) = noahmp%energy%flux%RadSwAbsGrd + NoahmpIO%IRCXY (I) = noahmp%energy%flux%RadLwNetCanopy + NoahmpIO%IRGXY (I) = noahmp%energy%flux%RadLwNetVegGrd + NoahmpIO%SHCXY (I) = noahmp%energy%flux%HeatSensibleCanopy + NoahmpIO%SHGXY (I) = noahmp%energy%flux%HeatSensibleVegGrd + NoahmpIO%EVGXY (I) = noahmp%energy%flux%HeatLatentVegGrd + NoahmpIO%GHVXY (I) = noahmp%energy%flux%HeatGroundVegGrd + NoahmpIO%IRBXY (I) = noahmp%energy%flux%RadLwNetBareGrd + NoahmpIO%SHBXY (I) = noahmp%energy%flux%HeatSensibleBareGrd + NoahmpIO%EVBXY (I) = noahmp%energy%flux%HeatLatentBareGrd + NoahmpIO%GHBXY (I) = noahmp%energy%flux%HeatGroundBareGrd + NoahmpIO%TRXY (I) = noahmp%energy%flux%HeatLatentCanTransp + NoahmpIO%EVCXY (I) = noahmp%energy%flux%HeatLatentCanEvap + NoahmpIO%CANHSXY (I) = noahmp%energy%flux%HeatCanStorageChg + NoahmpIO%PAHXY (I) = noahmp%energy%flux%HeatPrecipAdvSfc + NoahmpIO%PAHGXY (I) = noahmp%energy%flux%HeatPrecipAdvVegGrd + NoahmpIO%PAHVXY (I) = noahmp%energy%flux%HeatPrecipAdvCanopy + NoahmpIO%PAHBXY (I) = noahmp%energy%flux%HeatPrecipAdvBareGrd + NoahmpIO%ACC_SSOILXY(I) = noahmp%energy%flux%HeatGroundTotAcc + NoahmpIO%EFLXBXY (I) = noahmp%energy%flux%HeatFromSoilBot + + ! energy state variables + NoahmpIO%TSK (I) = noahmp%energy%state%TemperatureRadSfc + NoahmpIO%EMISS (I) = noahmp%energy%state%EmissivitySfc + NoahmpIO%QSFC (I) = noahmp%energy%state%SpecHumiditySfcMean + NoahmpIO%TVXY (I) = noahmp%energy%state%TemperatureCanopy + NoahmpIO%TGXY (I) = noahmp%energy%state%TemperatureGrd + NoahmpIO%EAHXY (I) = noahmp%energy%state%PressureVaporCanAir + NoahmpIO%TAHXY (I) = noahmp%energy%state%TemperatureCanopyAir + NoahmpIO%CMXY (I) = noahmp%energy%state%ExchCoeffMomSfc + NoahmpIO%CHXY (I) = noahmp%energy%state%ExchCoeffShSfc + NoahmpIO%ALBOLDXY(I) = noahmp%energy%state%AlbedoSnowPrev + NoahmpIO%LAI (I) = noahmp%energy%state%LeafAreaIndex + NoahmpIO%XSAIXY (I) = noahmp%energy%state%StemAreaIndex + NoahmpIO%TAUSSXY (I) = noahmp%energy%state%SnowAgeNondim + NoahmpIO%Z0 (I) = noahmp%energy%state%RoughLenMomSfcToAtm + NoahmpIO%ZNT (I) = noahmp%energy%state%RoughLenMomSfcToAtm + NoahmpIO%T2MVXY (I) = noahmp%energy%state%TemperatureAir2mVeg + NoahmpIO%T2MBXY (I) = noahmp%energy%state%TemperatureAir2mBare + NoahmpIO%T2MXY (I) = noahmp%energy%state%TemperatureAir2m + NoahmpIO%TRADXY (I) = noahmp%energy%state%TemperatureRadSfc + NoahmpIO%FVEGXY (I) = noahmp%energy%state%VegFrac + NoahmpIO%RSSUNXY (I) = noahmp%energy%state%ResistanceStomataSunlit + NoahmpIO%RSSHAXY (I) = noahmp%energy%state%ResistanceStomataShade + NoahmpIO%BGAPXY (I) = noahmp%energy%state%GapBtwCanopy + NoahmpIO%WGAPXY (I) = noahmp%energy%state%GapInCanopy + NoahmpIO%TGVXY (I) = noahmp%energy%state%TemperatureGrdVeg + NoahmpIO%TGBXY (I) = noahmp%energy%state%TemperatureGrdBare + NoahmpIO%CHVXY (I) = noahmp%energy%state%ExchCoeffShAbvCan + NoahmpIO%CHBXY (I) = noahmp%energy%state%ExchCoeffShBare + NoahmpIO%CHLEAFXY(I) = noahmp%energy%state%ExchCoeffShLeaf + NoahmpIO%CHUCXY (I) = noahmp%energy%state%ExchCoeffShUndCan + NoahmpIO%CHV2XY (I) = noahmp%energy%state%ExchCoeffSh2mVeg + NoahmpIO%CHB2XY (I) = noahmp%energy%state%ExchCoeffSh2mBare + NoahmpIO%Q2MVXY (I) = noahmp%energy%state%SpecHumidity2mVeg /(1.0-noahmp%energy%state%SpecHumidity2mVeg) ! spec humidity to mixing ratio + NoahmpIO%Q2MBXY (I) = noahmp%energy%state%SpecHumidity2mBare/(1.0-noahmp%energy%state%SpecHumidity2mBare) + NoahmpIO%Q2MXY (I) = noahmp%energy%state%SpecHumidity2m/(1.0-noahmp%energy%state%SpecHumidity2m) + NoahmpIO%IRRSPLH (I) = NoahmpIO%IRRSPLH(I) + & + (noahmp%energy%flux%HeatLatentIrriEvap * noahmp%config%domain%MainTimeStep) + NoahmpIO%TSLB (I,1:NumSoilLayer) = noahmp%energy%state%TemperatureSoilSnow(1:NumSoilLayer) + NoahmpIO%TSNOXY (I,-NumSnowLayerMax+1:0) = noahmp%energy%state%TemperatureSoilSnow(-NumSnowLayerMax+1:0) + if ( noahmp%energy%state%AlbedoSfc > -999 ) then + NoahmpIO%ALBEDO(I) = noahmp%energy%state%AlbedoSfc + endif + + ! New Calculation of total Canopy/Stomatal Conductance Based on Bonan et al. (2011), Inverse of Canopy Resistance (below) + LeafAreaIndSunlit = max(noahmp%energy%state%LeafAreaIndSunlit, 0.0) + LeafAreaIndShade = max(noahmp%energy%state%LeafAreaIndShade, 0.0) + ResistanceLeafBoundary = max(noahmp%energy%state%ResistanceLeafBoundary, 0.0) + if ( (noahmp%energy%state%ResistanceStomataSunlit <= 0.0) .or. (noahmp%energy%state%ResistanceStomataShade <= 0.0) .or. & + (LeafAreaIndSunlit == 0.0) .or. (LeafAreaIndShade == 0.0) .or. & + (noahmp%energy%state%ResistanceStomataSunlit == undefined_real) .or. & + (noahmp%energy%state%ResistanceStomataShade == undefined_real) ) then + NoahmpIO%RS (I) = 0.0 + else + NoahmpIO%RS (I) = ((1.0 / (noahmp%energy%state%ResistanceStomataSunlit + ResistanceLeafBoundary) * & + noahmp%energy%state%LeafAreaIndSunlit) + & + ((1.0 / (noahmp%energy%state%ResistanceStomataShade + ResistanceLeafBoundary)) * & + noahmp%energy%state%LeafAreaIndShade)) + NoahmpIO%RS (I) = 1.0 / NoahmpIO%RS (I) ! Resistance + endif + + ! calculation of snow and soil energy storage + NoahmpIO%SNOWENERGY(I) = 0.0 + NoahmpIO%SOILENERGY(I) = 0.0 + do LoopInd = NumSnowLayerNeg+1, NumSoilLayer + if ( LoopInd == NumSnowLayerNeg+1 ) then + ThicknessSnowSoilLayer = -noahmp%config%domain%DepthSnowSoilLayer(LoopInd) + else + ThicknessSnowSoilLayer = noahmp%config%domain%DepthSnowSoilLayer(LoopInd-1) - & + noahmp%config%domain%DepthSnowSoilLayer(LoopInd) + endif + if ( LoopInd >= 1 ) then + NoahmpIO%SOILENERGY(I) = NoahmpIO%SOILENERGY(I) + ThicknessSnowSoilLayer * & + noahmp%energy%state%HeatCapacSoilSnow(LoopInd) * & + (noahmp%energy%state%TemperatureSoilSnow(LoopInd) - 273.16) * 0.001 + else + NoahmpIO%SNOWENERGY(I) = NoahmpIO%SNOWENERGY(I) + ThicknessSnowSoilLayer * & + noahmp%energy%state%HeatCapacSoilSnow(LoopInd) * & + (noahmp%energy%state%TemperatureSoilSnow(LoopInd) - 273.16) * 0.001 + endif + enddo + + end associate + + end subroutine EnergyVarOutTransfer + +end module EnergyVarOutTransferMod diff --git a/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/ForcingVarInTransferMod.F90 b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/ForcingVarInTransferMod.F90 new file mode 100644 index 000000000..6ebf049f4 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/ForcingVarInTransferMod.F90 @@ -0,0 +1,68 @@ +module ForcingVarInTransferMod + +!!! Transfer input 2-D NoahmpIO Forcing variables to 1-D column variable +!!! 1-D variables should be first defined in /src/ForcingVarType.F90 +!!! 2-D variables should be first defined in NoahmpIOVarType.F90 + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use Machine + use NoahmpIOVarType + use NoahmpVarType + + implicit none + +contains + +!=== initialize with input data or table values + + subroutine ForcingVarInTransfer(noahmp, NoahmpIO) + + implicit none + + type(NoahmpIO_type), intent(inout) :: NoahmpIO + type(noahmp_type), intent(inout) :: noahmp + + ! local variables + real(kind=kind_noahmp) :: PrecipOtherRefHeight ! other precipitation, e.g. fog [mm/s] at reference height + real(kind=kind_noahmp) :: PrecipTotalRefHeight ! total precipitation [mm/s] at reference height + +! --------------------------------------------------------------- + associate( & + I => noahmp%config%domain%GridIndexI & + ) +! --------------------------------------------------------------- + + noahmp%forcing%TemperatureAirRefHeight = NoahmpIO%T_PHY(I,1) + noahmp%forcing%WindEastwardRefHeight = NoahmpIO%U_PHY(I,1) + noahmp%forcing%WindNorthwardRefHeight = NoahmpIO%V_PHY(I,1) + noahmp%forcing%SpecHumidityRefHeight = NoahmpIO%QV_CURR(I,1)/(1.0+NoahmpIO%QV_CURR(I,1)) ! convert from mixing ratio to specific humidity + noahmp%forcing%PressureAirRefHeight = (NoahmpIO%P8W(I,1) + NoahmpIO%P8W(I,2)) * 0.5 ! air pressure at middle point of lowest atmos model layer + noahmp%forcing%PressureAirSurface = NoahmpIO%P8W (I,1) + noahmp%forcing%RadLwDownRefHeight = NoahmpIO%GLW (I) + noahmp%forcing%RadSwDownRefHeight = NoahmpIO%SWDOWN (I) + noahmp%forcing%TemperatureSoilBottom = NoahmpIO%TMN (I) + + ! treat different precipitation types + PrecipTotalRefHeight = NoahmpIO%RAINBL (I) / NoahmpIO%DTBL ! convert precip unit from mm/timestep to mm/s + noahmp%forcing%PrecipConvRefHeight = NoahmpIO%MP_RAINC (I) / NoahmpIO%DTBL + noahmp%forcing%PrecipNonConvRefHeight = NoahmpIO%MP_RAINNC(I) / NoahmpIO%DTBL + noahmp%forcing%PrecipShConvRefHeight = NoahmpIO%MP_SHCV (I) / NoahmpIO%DTBL + noahmp%forcing%PrecipSnowRefHeight = NoahmpIO%MP_SNOW (I) / NoahmpIO%DTBL + noahmp%forcing%PrecipGraupelRefHeight = NoahmpIO%MP_GRAUP (I) / NoahmpIO%DTBL + noahmp%forcing%PrecipHailRefHeight = NoahmpIO%MP_HAIL (I) / NoahmpIO%DTBL + ! treat other precipitation (e.g. fog) contained in total precipitation + PrecipOtherRefHeight = PrecipTotalRefHeight - noahmp%forcing%PrecipConvRefHeight - & + noahmp%forcing%PrecipNonConvRefHeight - noahmp%forcing%PrecipShConvRefHeight + PrecipOtherRefHeight = max(0.0, PrecipOtherRefHeight) + noahmp%forcing%PrecipNonConvRefHeight = noahmp%forcing%PrecipNonConvRefHeight + PrecipOtherRefHeight + noahmp%forcing%PrecipSnowRefHeight = noahmp%forcing%PrecipSnowRefHeight + PrecipOtherRefHeight * NoahmpIO%SR(I) + + end associate + + end subroutine ForcingVarInTransfer + +end module ForcingVarInTransferMod diff --git a/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/ForcingVarOutTransferMod.F90 b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/ForcingVarOutTransferMod.F90 new file mode 100644 index 000000000..2b5bd23fa --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/ForcingVarOutTransferMod.F90 @@ -0,0 +1,43 @@ +module ForcingVarOutTransferMod + +!!! Transfer column (1-D) Noah-MP forcing variables to 2D NoahmpIO for output + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use Machine + use NoahmpIOVarType + use NoahmpVarType + + implicit none + +contains + +!=== Transfer model states to output ===== + + subroutine ForcingVarOutTransfer(noahmp, NoahmpIO) + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + type(NoahmpIO_type), intent(inout) :: NoahmpIO + +! ------------------------------------------------------------------------- + associate( & + I => noahmp%config%domain%GridIndexI & + ) +! ------------------------------------------------------------------------- + + NoahmpIO%FORCTLSM (I) = noahmp%forcing%TemperatureAirRefHeight + NoahmpIO%FORCQLSM (I) = noahmp%forcing%SpecHumidityRefHeight + NoahmpIO%FORCPLSM (I) = noahmp%forcing%PressureAirRefHeight + NoahmpIO%FORCWLSM (I) = sqrt(noahmp%forcing%WindEastwardRefHeight**2 + & + noahmp%forcing%WindNorthwardRefHeight**2) + + end associate + + end subroutine ForcingVarOutTransfer + +end module ForcingVarOutTransferMod diff --git a/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/Makefile b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/Makefile new file mode 100644 index 000000000..5f816fff4 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/Makefile @@ -0,0 +1,74 @@ +.SUFFIXES: .o .F90 + +.PHONY: driver driver_lib + +all: dummy driver + +dummy: + echo "****** compiling physics_noahmp/drivers ******" + +OBJS = NoahmpSnowInitMod.o \ + NoahmpInitMainMod.o \ + NoahmpDriverMainMod.o \ + NoahmpIOVarType.o \ + NoahmpIOVarInitMod.o \ + NoahmpIOVarFinalizeMod.o \ + NoahmpReadTableMod.o \ + NoahmpReadNamelistMod.o \ + ConfigVarOutTransferMod.o \ + ForcingVarOutTransferMod.o \ + EnergyVarOutTransferMod.o \ + WaterVarOutTransferMod.o \ + BiochemVarOutTransferMod.o \ + ConfigVarInTransferMod.o \ + ForcingVarInTransferMod.o \ + EnergyVarInTransferMod.o \ + WaterVarInTransferMod.o \ + BiochemVarInTransferMod.o \ + PedoTransferSR2006Mod.o + +driver: $(OBJS) + +driver_lib: + ar -ru ./../../../libphys.a $(OBJS) + +# DEPENDENCIES: + +NoahmpIOVarType.o: ../../utility/Machine.o +NoahmpIOVarInitMod.o: ../../utility/Machine.o NoahmpIOVarType.o +NoahmpIOVarFinalizeMod.o: ../../utility/Machine.o NoahmpIOVarType.o +NoahmpReadTableMod.o: ../../utility/Machine.o NoahmpIOVarType.o +NoahmpReadNamelistMod.o: ../../utility/Machine.o NoahmpIOVarType.o +PedoTransferSR2006Mod.o: ../../utility/Machine.o NoahmpIOVarType.o +ConfigVarOutTransferMod.o: ../../utility/Machine.o NoahmpIOVarType.o ../../src/NoahmpVarType.o +ForcingVarOutTransferMod.o: ../../utility/Machine.o NoahmpIOVarType.o ../../src/NoahmpVarType.o +EnergyVarOutTransferMod.o: ../../utility/Machine.o NoahmpIOVarType.o ../../src/NoahmpVarType.o +WaterVarOutTransferMod.o: ../../utility/Machine.o NoahmpIOVarType.o ../../src/NoahmpVarType.o +BiochemVarOutTransferMod.o: ../../utility/Machine.o NoahmpIOVarType.o ../../src/NoahmpVarType.o +ConfigVarInTransferMod.o: ../../utility/Machine.o NoahmpIOVarType.o ../../src/NoahmpVarType.o +ForcingVarInTransferMod.o: ../../utility/Machine.o NoahmpIOVarType.o ../../src/NoahmpVarType.o +EnergyVarInTransferMod.o: ../../utility/Machine.o NoahmpIOVarType.o ../../src/NoahmpVarType.o +BiochemVarInTransferMod.o: ../../utility/Machine.o NoahmpIOVarType.o ../../src/NoahmpVarType.o +WaterVarInTransferMod.o: ../../utility/Machine.o NoahmpIOVarType.o ../../src/NoahmpVarType.o PedoTransferSR2006Mod.o +NoahmpSnowInitMod.o: ../../utility/Machine.o NoahmpIOVarType.o +NoahmpInitMainMod.o: ../../utility/Machine.o NoahmpIOVarType.o NoahmpSnowInitMod.o +NoahmpDriverMainMod.o: ../../utility/Machine.o ../../src/NoahmpVarType.o NoahmpIOVarType.o \ + ../../src/ConfigVarInitMod.o \ + ../../src/EnergyVarInitMod.o ../../src/ForcingVarInitMod.o \ + ../../src/WaterVarInitMod.o ../../src/BiochemVarInitMod.o \ + ../../src/NoahmpMainMod.o ../../src/NoahmpMainGlacierMod.o \ + ConfigVarOutTransferMod.o EnergyVarOutTransferMod.o \ + WaterVarOutTransferMod.o BiochemVarOutTransferMod.o \ + ForcingVarOutTransferMod.o ConfigVarInTransferMod.o \ + ForcingVarInTransferMod.o EnergyVarInTransferMod.o \ + WaterVarInTransferMod.o BiochemVarInTransferMod.o + +clean: + $(RM) *.f90 *.o *.mod + @# Certain systems with intel compilers generate *.i files + @# This removes them during the clean process + $(RM) *.i + +.F90.o: + $(FC) $(CPPFLAGS) $(COREDEF) $(FFLAGS) -c $*.F90 $(CPPINCLUDES) $(FCINCLUDES) -I. -I../../utility -I../../src -I../../../../../framework -I../../../../../external/esmf_time_f90 + diff --git a/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpDriverMainMod.F90 b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpDriverMainMod.F90 new file mode 100644 index 000000000..2cbeb3bd2 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpDriverMainMod.F90 @@ -0,0 +1,231 @@ + module NoahmpDriverMainMod + + use Machine + use NoahmpVarType + use NoahmpIOVarType + use ConfigVarInitMod + use EnergyVarInitMod + use ForcingVarInitMod + use WaterVarInitMod + use BiochemVarInitMod + use ConfigVarInTransferMod + use EnergyVarInTransferMod + use ForcingVarInTransferMod + use WaterVarInTransferMod + use BiochemVarInTransferMod + use ConfigVarOutTransferMod + use ForcingVarOutTransferMod + use EnergyVarOutTransferMod + use WaterVarOutTransferMod + use BiochemVarOutTransferMod + use NoahmpMainMod + use NoahmpMainGlacierMod + + use mpas_log + + implicit none + + contains + + subroutine NoahmpDriverMain(NoahmpIO) + +! ------------------------ Code history ------------------------------------- +! Original Noah-MP subroutine: noahmplsm +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! --------------------------------------------------------------------------- + + implicit none + + type(NoahmpIO_type), intent(inout) :: NoahmpIO + +! local variables + type(noahmp_type) :: noahmp + integer :: i,k + integer :: jmonth,jday + real(kind=kind_noahmp) :: solar_time + real(kind=kind_noahmp), dimension( 1:NoahmpIO%nsoil ) :: sand + real(kind=kind_noahmp), dimension( 1:NoahmpIO%nsoil ) :: clay + real(kind=kind_noahmp), dimension( 1:NoahmpIO%nsoil ) :: orgm +! --------------------------------------------------------------------------- +!call mpas_log_write(' ') +!call mpas_log_write('--- enter subroutine NoahmpDriverMain:') + +!--------------------------------------------------------------------- +! Treatment of Noah-MP soil timestep +!--------------------------------------------------------------------- + NoahmpIO%calculate_soil = .false. + NoahmpIO%soil_update_steps = nint(NoahmpIO%soiltstep / NoahmpIO%dtbl) + NoahmpIO%soil_update_steps = max(NoahmpIO%soil_update_steps,1) + + if ( NoahmpIO%soil_update_steps == 1 ) then + NoahmpIO%acc_ssoilxy = 0.0 + NoahmpIO%acc_qinsurxy = 0.0 + NoahmpIO%acc_qsevaxy = 0.0 + NoahmpIO%acc_etranixy = 0.0 + NoahmpIO%acc_dwaterxy = 0.0 + NoahmpIO%acc_prcpxy = 0.0 + NoahmpIO%acc_ecanxy = 0.0 + NoahmpIO%acc_etranxy = 0.0 + NoahmpIO%acc_edirxy = 0.0 + endif + + if ( NoahmpIO%soil_update_steps > 1 ) then + if ( mod(NoahmpIO%itimestep, NoahmpIO%soil_update_steps) == 1 ) then + NoahmpIO%acc_ssoilxy = 0.0 + NoahmpIO%acc_qinsurxy = 0.0 + NoahmpIO%acc_qsevaxy = 0.0 + NoahmpIO%acc_etranixy = 0.0 + NoahmpIO%acc_dwaterxy = 0.0 + NoahmpIO%acc_prcpxy = 0.0 + NoahmpIO%acc_ecanxy = 0.0 + NoahmpIO%acc_etranxy = 0.0 + NoahmpIO%acc_edirxy = 0.0 + end if + endif + + if ( mod(NoahmpIO%itimestep, NoahmpIO%soil_update_steps) == 0 ) NoahmpIO%calculate_soil = .true. +!call mpas_log_write(' ') +!call mpas_log_write('--- enter subroutine noahmpdrivermain:') +!call mpas_log_write('--- NoahmpIO%itimestep = $i',intArgs=(/NoahmpIO%itimestep/)) +!call mpas_log_write('--- NoahmpIO%soiltstep = $r',realArgs=(/NoahmpIO%soiltstep/)) +!call mpas_log_write('--- NoahmpIO%dtbl = $r',realArgs=(/NoahmpIO%dtbl/)) +!call mpas_log_write('--- NoahmpIO%soil_update_steps = $i',intArgs=(/NoahmpIO%soil_update_steps/)) +!call mpas_log_write('--- NoahmpIO%calculate_soil = $l',logicArgs=(/NoahmpIO%calculate_soil/)) +!call mpas_log_write(' ') +!call mpas_log_write('--- NoahmpIO%isurban_table = $i',intArgs=(/NoahmpIO%isurban_table/)) +!call mpas_log_write('--- NoahmpIO%urbtype_beg = $i',intArgs=(/NoahmpIO%urbtype_beg/)) +!call mpas_log_write('--- NoahmpIO%sf_urban_physics = $i',intArgs=(/NoahmpIO%sf_urban_physics/)) +!call mpas_log_write('--- NoahmpIO%iri_urban = $i',intArgs=(/NoahmpIO%iri_urban/)) +!call mpas_log_write(' ') + +!--------------------------------------------------------------------- +! Prepare Noah-MP driver +!--------------------------------------------------------------------- + +! find length of year for phenology (also S Hemisphere): + NoahmpIO%yearlen = 365 + if (mod(NoahmpIO%yr,4) == 0)then + NoahmpIO%yearlen = 366 + if (mod(NoahmpIO%yr,100) == 0)then + NoahmpIO%yearlen = 365 + if (mod(NoahmpIO%yr,400) == 0)then + NoahmpIO%yearlen = 366 + endif + endif + endif + +! initialize jmonth and jday: + jmonth = NoahmpIO%month + jday = NoahmpIO%day +!call mpas_log_write('--- NoahmpIO%yearlen = $i',intargs=(/NoahmpIO%yearlen/)) +!call mpas_log_write('--- NoahmpIO%yr = $i',intargs=(/NoahmpIO%yr/)) +!call mpas_log_write('--- NoahmpIO%month = $i',intargs=(/jmonth/)) +!call mpas_log_write('--- NoahmpIO%day = $i',intargs=(/jday/)) +!call mpas_log_write('--- NoahmpIO%julian = $r',realargs=(/NoahmpIO%julian/)) +!call mpas_log_write('--- NoahmpIO%xice_threshold = $r',realargs=(/NoahmpIO%xice_threshold/)) +!call mpas_log_write(' ') + +! depth to soil interfaces (<0) [m] + NoahmpIO%zsoil(1) = -NoahmpIO%dzs(1) + do k = 2, NoahmpIO%nsoil + NoahmpIO%zsoil(k) = -NoahmpIO%dzs(k) + NoahmpIO%zsoil(k-1) + enddo + + if ( NoahmpIO%itimestep == 1 ) then + do i = NoahmpIO%its, NoahmpIO%ite + if ( (NoahmpIO%xland(i)-1.5) >= 0.0 ) then ! open water point + if ( NoahmpIO%xice(i) == 1.0 ) print*,' sea-ice at water point, i=',i + NoahmpIO%smstav(i) = 1.0 + NoahmpIO%smstot(i) = 1.0 + do k = 1, NoahmpIO%nsoil + NoahmpIO%smois(i,k) = 1.0 + NoahmpIO%tslb(i,k) = 273.16 + enddo + else + if ( NoahmpIO%xice(i) == 1.0 ) then ! sea-ice case + NoahmpIO%smstav(i) = 1.0 + NoahmpIO%smstot(i) = 1.0 + do k = 1, NoahmpIO%nsoil + NoahmpIO%smois(i,k) = 1.0 + enddo + endif + endif + enddo + endif ! end of initialization over ocean + + iloop : do i = NoahmpIO%its, NoahmpIO%ite + + NoahmpIO%j = 1 + NoahmpIO%i = i + if ( NoahmpIO%xice(i) >= NoahmpIO%xice_threshold ) then ! sea-ice point + NoahmpIO%ice = 1 + NoahmpIO%sh2o(i,1:NoahmpIO%nsoil) = 1.0 + NoahmpIO%lai (i) = 0.01 + cycle iloop ! skip any sea-ice points + else + if ( (NoahmpIO%xland(i)-1.5) >= 0.0 ) cycle ILOOP ! skip any open water points + !------------------------------------------------------------------------------------ + ! initialize Data Types and transfer all the inputs from 2-D to 1-D column variables + !------------------------------------------------------------------------------------ + call ConfigVarInitDefault (noahmp) + call ConfigVarInTransfer (noahmp, NoahmpIO) + call ForcingVarInitDefault (noahmp) + call ForcingVarInTransfer (noahmp, NoahmpIO) + call EnergyVarInitDefault (noahmp) + call EnergyVarInTransfer (noahmp, NoahmpIO) + call WaterVarInitDefault (noahmp) + call WaterVarInTransfer (noahmp, NoahmpIO) + call BiochemVarInitDefault (noahmp) + call BiochemVarInTransfer (noahmp, NoahmpIO) + + !---------------------------------------------------------------------- + ! hydrological processes for vegetation in urban model + ! irrigate vegetation only in urban area, MAY-SEP, 9-11pm + ! need to be separated from Noah-MP into outside urban specific module + !---------------------------------------------------------------------- + if ( (NoahmpIO%ivgtyp(i) == NoahmpIO%isurban_table) .or. & + (NoahmpIO%ivgtyp(i) > NoahmpIO%urbtype_beg) ) then + if ( (NoahmpIO%sf_urban_physics > 0) .and. (NoahmpIO%iri_urban == 1) ) then + solar_time = (NoahmpIO%julian - int(NoahmpIO%julian))*24 + NoahmpIO%xlong(i)/15.0 + if ( solar_time < 0.0 ) solar_time = solar_time + 24.0 + if ( (solar_time >= 21.0) .and. (solar_time <= 23.0) .and. & + (jmonth >= 5) .and. (jmonth <= 9) ) then + noahmp%water%state%SoilMoisture(1) = & + max(noahmp%water%state%SoilMoisture(1),noahmp%water%param%SoilMoistureFieldCap(1)) + noahmp%water%state%SoilMoisture(2) = & + max(noahmp%water%state%SoilMoisture(2),noahmp%water%param%SoilMoistureFieldCap(2)) + endif + endif + endif + + !------------------------------------------------------------------------ + ! Call 1D Noah-MP LSM + !------------------------------------------------------------------------ + + if (noahmp%config%domain%VegType == noahmp%config%domain%IndexIcePoint ) then + noahmp%config%domain%IndicatorIceSfc = -1 ! Land-ice point + noahmp%forcing%TemperatureSoilBottom = min(noahmp%forcing%TemperatureSoilBottom,263.15) ! set deep glacier temp to >= -10C + call NoahmpMainGlacier(noahmp) + ! non-glacier land + else + noahmp%config%domain%IndicatorIceSfc = 0 ! land soil point. + call NoahmpMain(noahmp) + endif ! glacial split ends + + !--------------------------------------------------------------------- + ! Transfer 1-D Noah-MP column variables to 2-D output variables + !--------------------------------------------------------------------- + call ConfigVarOutTransfer (noahmp, NoahmpIO) + call ForcingVarOutTransfer(noahmp, NoahmpIO) + call EnergyVarOutTransfer (noahmp, NoahmpIO) + call WaterVarOutTransfer (noahmp, NoahmpIO) + call BiochemVarOutTransfer(noahmp, NoahmpIO) + + endif ! land-sea split ends + + enddo iloop ! i loop + + end subroutine NoahmpDriverMain + + end module NoahmpDriverMainMod diff --git a/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpGroundwaterInitMod.F90 b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpGroundwaterInitMod.F90 new file mode 100644 index 000000000..7bbf8c3fd --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpGroundwaterInitMod.F90 @@ -0,0 +1,326 @@ +module NoahmpGroundwaterInitMod + +!!! Module to initialize Noah-MP Groundwater (GW) variables for MMF GW scheme + + use Machine + use NoahmpIOVarType + + implicit none + +contains + + subroutine NoahmpGroundwaterInitMain(grid, NoahmpIO) + +! ------------------------ Code history ------------------------------------- +! Original Noah-MP subroutine: GROUNDWATER_INIT +! Original code: Miguez-Macho, Fan et al. (2007) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! --------------------------------------------------------------------------- + + use GroundWaterMmfMod, only : LATERALFLOW + use module_domain, only : domain + +#if (EM_CORE == 1) +#ifdef DM_PARALLEL + use module_dm , only : ntasks_x,ntasks_y,local_communicator,mytask,ntasks + use module_comm_dm, only : halo_em_hydro_noahmp_sub +#endif +#endif + + implicit none + + type(NoahmpIO_type), intent(inout) :: NoahmpIO + type(domain), target :: grid + + ! local variables + logical :: urbanpt_flag ! added to identify urban pixels + integer :: I,J,K,ITER,itf,jtf,NITER,NCOUNT,NS + real(kind=kind_noahmp) :: BEXP,SMCMAX,PSISAT,SMCWLT,DWSAT,DKSAT + real(kind=kind_noahmp) :: FRLIQ,SMCEQDEEP + real(kind=kind_noahmp) :: DELTAT,RCOND,TOTWATER + real(kind=kind_noahmp) :: AA,BBB,CC,DD,DX,FUNC,DFUNC,DDZ,EXPON,SMC,FLUX + real(kind=kind_noahmp), dimension(1:NoahmpIO%NSOIL) :: SMCEQ,ZSOIL + real(kind=kind_noahmp), dimension(NoahmpIO%ims:NoahmpIO%ime, NoahmpIO%jms:NoahmpIO%jme) :: QLAT, QRF + ! landmask: -1 for water (ice or no ice) and glacial areas, 1 for land where the LSM does its soil moisture calculations + integer, dimension(NoahmpIO%ims:NoahmpIO%ime, NoahmpIO%jms:NoahmpIO%jme) :: LANDMASK + +! -------------------------------------------------------------------------------- + associate( & + ids => NoahmpIO%ids ,& + ide => NoahmpIO%ide ,& + jds => NoahmpIO%jds ,& + jde => NoahmpIO%jde ,& + kds => NoahmpIO%kds ,& + kde => NoahmpIO%kde ,& + ims => NoahmpIO%ims ,& + ime => NoahmpIO%ime ,& + jms => NoahmpIO%jms ,& + jme => NoahmpIO%jme ,& + kms => NoahmpIO%kms ,& + kme => NoahmpIO%kme ,& + ips => NoahmpIO%ims ,& + ipe => NoahmpIO%ime ,& + jps => NoahmpIO%jms ,& + jpe => NoahmpIO%jme ,& + kps => NoahmpIO%kms ,& + kpe => NoahmpIO%kme ,& + its => NoahmpIO%its ,& + ite => NoahmpIO%ite ,& + jts => NoahmpIO%jts ,& + jte => NoahmpIO%jte ,& + kts => NoahmpIO%kts ,& + kte => NoahmpIO%kte & + ) +! -------------------------------------------------------------------------------- + + ! Given the soil layer thicknesses (in DZS), calculate the soil layer depths from the surface. + ZSOIL(1) = -NoahmpIO%DZS(1) ! negative + do NS = 2, NoahmpIO%NSOIL + ZSOIL(NS) = ZSOIL(NS-1) - NoahmpIO%DZS(NS) + enddo + + ! initialize grid index + itf = min0(ite,(ide+1)-1) + jtf = min0(jte,(jde+1)-1) + + ! initialize land mask + where ( (NoahmpIO%IVGTYP /= NoahmpIO%ISWATER_TABLE) .and. (NoahmpIO%IVGTYP /= NoahmpIO%ISICE_TABLE) ) + LANDMASK = 1 + elsewhere + LANDMASK = -1 + endwhere + + NoahmpIO%PEXPXY = 1.0 + DELTAT = 365.0*24*3600.0 ! 1 year + + ! read just the raw aggregated water table from hi-res map, so that it is better compatible with topography + ! use WTD here, to use the lateral communication routine + NoahmpIO%ZWTXY = NoahmpIO%EQZWT + NCOUNT = 0 + + do NITER = 1, 500 +#if (EM_CORE == 1) +#ifdef DM_PARALLEL +# include "HALO_EM_HYDRO_NOAHMP.inc" +#endif +#endif + ! Calculate lateral flow + if ( (NCOUNT > 0) .or. (NITER == 1) ) then + QLAT = 0.0 + call LATERALFLOW(NoahmpIO,NoahmpIO%ISLTYP,NoahmpIO%ZWTXY,QLAT,NoahmpIO%FDEPTHXY,& + NoahmpIO%TERRAIN,LANDMASK,DELTAT,NoahmpIO%AREAXY, & + ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme, & + its,ite,jts,jte,kts,kte ) + NCOUNT = 0 + do J = jts, jtf + do I = its, itf + if ( LANDMASK(I,J) > 0 ) then + if ( QLAT(i,j) > 1.0e-2 ) then + NCOUNT = NCOUNT + 1 + NoahmpIO%ZWTXY(I,J) = min(NoahmpIO%ZWTXY(I,J)+0.25, 0.0) + endif + endif + enddo + enddo + + endif + enddo !NITER + +#if (EM_CORE == 1) +#ifdef DM_PARALLEL +# include "HALO_EM_HYDRO_NOAHMP.inc" +#endif +#endif + + NoahmpIO%EQZWT=NoahmpIO%ZWTXY + + ! after adjusting, where qlat > 1cm/year now wtd is at the surface. + ! it may still happen that qlat + rech > 0 and eqwtd-rbed <0. There the wtd can + ! rise to the surface (poor drainage) but the et will then increase. + + ! now, calculate river conductivity + do J = jts, jtf + do I = its, itf + DDZ = NoahmpIO%EQZWT(I,J) - (NoahmpIO%RIVERBEDXY(I,J) - NoahmpIO%TERRAIN(I,J)) + ! dont allow riverbed above water table + if ( DDZ < 0.0 ) then + NoahmpIO%RIVERBEDXY(I,J) = NoahmpIO%TERRAIN(I,J) + NoahmpIO%EQZWT(I,J) + DDZ = 0.0 + endif + TOTWATER = NoahmpIO%AREAXY(I,J) * (QLAT(I,J) + NoahmpIO%RECHCLIM(I,J)*0.001) / DELTAT + if ( TOTWATER > 0 ) then + NoahmpIO%RIVERCONDXY(I,J) = TOTWATER / max(DDZ,0.05) + else + NoahmpIO%RIVERCONDXY(I,J) = 0.01 + ! make riverbed equal to eqwtd, otherwise qrf might be too big... + NoahmpIO%RIVERBEDXY(I,J) = NoahmpIO%TERRAIN(I,J) + NoahmpIO%EQZWT(I,J) + endif + enddo + enddo + + ! make riverbed to be height down from the surface instead of above sea level + NoahmpIO%RIVERBEDXY = min(NoahmpIO%RIVERBEDXY-NoahmpIO%TERRAIN, 0.0) + + ! now recompute lateral flow and flow to rivers to initialize deep soil moisture + DELTAT = NoahmpIO%WTDDT * 60.0 !timestep in seconds for this calculation + QLAT = 0.0 + call LATERALFLOW(NoahmpIO,NoahmpIO%ISLTYP,NoahmpIO%ZWTXY,QLAT,NoahmpIO%FDEPTHXY,& + NoahmpIO%TERRAIN,LANDMASK,DELTAT,NoahmpIO%AREAXY, & + ids,ide,jds,jde,kds,kde,ims,ime,jms,jme,kms,kme, & + its,ite,jts,jte,kts,kte ) + + ! compute flux from grounwater to rivers in the cell + do J = jts, jtf + do I = its, itf + if ( LANDMASK(I,J) > 0 ) then + if ( (NoahmpIO%ZWTXY(I,J) > NoahmpIO%RIVERBEDXY(I,J)) .and. & + (NoahmpIO%EQZWT(I,J) > NoahmpIO%RIVERBEDXY(I,J)) ) then + RCOND = NoahmpIO%RIVERCONDXY(I,J) * exp(NoahmpIO%PEXPXY(I,J)*(NoahmpIO%ZWTXY(I,J)-NoahmpIO%EQZWT(I,J))) + else + RCOND = NoahmpIO%RIVERCONDXY(I,J) + endif + QRF(I,J) = RCOND * (NoahmpIO%ZWTXY(I,J)-NoahmpIO%RIVERBEDXY(I,J)) * DELTAT / NoahmpIO%AREAXY(I,J) + ! for now, dont allow it to go from river to groundwater + QRF(I,J) = max(QRF(I,J), 0.0) + else + QRF(I,J) = 0.0 + endif + enddo + enddo + + ! now compute eq. soil moisture, change soil moisture to be compatible with the water table and compute deep soil moisture + do J = jts, jtf + do I = its, itf + + BEXP = NoahmpIO%BEXP_TABLE(NoahmpIO%ISLTYP(I,J)) + SMCMAX = NoahmpIO%SMCMAX_TABLE(NoahmpIO%ISLTYP(I,J)) + SMCWLT = NoahmpIO%SMCWLT_TABLE(NoahmpIO%ISLTYP(I,J)) + ! add urban flag + urbanpt_flag = .false. + if ( (NoahmpIO%IVGTYP(I,J) == NoahmpIO%ISURBAN_TABLE) .or. & + (NoahmpIO%IVGTYP(I,J) > NoahmpIO%URBTYPE_beg) ) urbanpt_flag = .true. + if ( urbanpt_flag .eqv. .true. ) then + SMCMAX = 0.45 + SMCWLT = 0.40 + endif + DWSAT = NoahmpIO%DWSAT_TABLE(NoahmpIO%ISLTYP(I,J)) + DKSAT = NoahmpIO%DKSAT_TABLE(NoahmpIO%ISLTYP(I,J)) + PSISAT = -NoahmpIO%PSISAT_TABLE(NoahmpIO%ISLTYP(I,J)) + if ( (BEXP > 0.0) .and. (SMCMAX > 0.0) .and. (-PSISAT > 0.0) ) then + ! initialize equilibrium soil moisture for water table diagnostic + call EquilibriumSoilMoisture(NoahmpIO%NSOIL, ZSOIL, SMCMAX, SMCWLT, DWSAT, DKSAT, BEXP, SMCEQ) + NoahmpIO%SMOISEQ(I,1:NoahmpIO%NSOIL,J) = SMCEQ(1:NoahmpIO%NSOIL) + + ! make sure that below the water table the layers are saturated and + ! initialize the deep soil moisture + if ( NoahmpIO%ZWTXY(I,J) < (ZSOIL(NoahmpIO%NSOIL)-NoahmpIO%DZS(NoahmpIO%NSOIL)) ) then + ! initialize deep soil moisture so that the flux compensates qlat+qrf + ! use Newton-Raphson method to find soil moisture + EXPON = 2.0 * BEXP + 3.0 + DDZ = ZSOIL(NoahmpIO%NSOIL) - NoahmpIO%ZWTXY(I,J) + CC = PSISAT / DDZ + FLUX = (QLAT(I,J) - QRF(I,J)) / DELTAT + SMC = 0.5 * SMCMAX + do ITER = 1, 100 + DD = (SMC + SMCMAX) / (2.0*SMCMAX) + AA = -DKSAT * DD ** EXPON + BBB = CC * ((SMCMAX / SMC)**BEXP - 1.0) + 1.0 + FUNC = AA * BBB - FLUX + DFUNC = -DKSAT * (EXPON / (2.0*SMCMAX)) * DD ** (EXPON - 1.0) * BBB & + + AA * CC * (-BEXP) * SMCMAX ** BEXP * SMC ** (-BEXP-1.0) + DX = FUNC / DFUNC + SMC = SMC - DX + if ( abs(DX) < 1.0e-6 ) exit + enddo + NoahmpIO%SMCWTDXY(I,J) = max(SMC, 1.0e-4) + elseif ( NoahmpIO%ZWTXY(I,J) < ZSOIL(NoahmpIO%NSOIL) ) then + SMCEQDEEP = SMCMAX * (PSISAT / (PSISAT - NoahmpIO%DZS(NoahmpIO%NSOIL))) ** (1.0/BEXP) + !SMCEQDEEP = MAX(SMCEQDEEP,SMCWLT) + SMCEQDEEP = max(SMCEQDEEP, 1.0e-4) + NoahmpIO%SMCWTDXY(I,J) = SMCMAX * (NoahmpIO%ZWTXY(I,J)-(ZSOIL(NoahmpIO%NSOIL)-NoahmpIO%DZS(NoahmpIO%NSOIL))) + & + SMCEQDEEP * (ZSOIL(NoahmpIO%NSOIL) - NoahmpIO%ZWTXY(I,J)) + else !water table within the resolved layers + NoahmpIO%SMCWTDXY(I,J) = SMCMAX + do K = NoahmpIO%NSOIL, 2, -1 + if ( NoahmpIO%ZWTXY(I,J) >= ZSOIL(K-1) ) then + FRLIQ = NoahmpIO%SH2O(I,K,J) / NoahmpIO%SMOIS(I,K,J) + NoahmpIO%SMOIS(I,K,J) = SMCMAX + NoahmpIO%SH2O(I,K,J) = SMCMAX * FRLIQ + else + if ( NoahmpIO%SMOIS(I,K,J) < SMCEQ(K) ) then + NoahmpIO%ZWTXY(I,J) = ZSOIL(K) + else + NoahmpIO%ZWTXY(I,J) = (NoahmpIO%SMOIS(I,K,J)*NoahmpIO%DZS(K) - SMCEQ(K)*ZSOIL(K-1) + & + SMCMAX*ZSOIL(K)) / (SMCMAX - SMCEQ(K)) + endif + exit + endif + enddo + endif + else + NoahmpIO%SMOISEQ (I,1:NoahmpIO%NSOIL,J) = SMCMAX + NoahmpIO%SMCWTDXY(I,J) = SMCMAX + NoahmpIO%ZWTXY(I,J) = 0.0 + endif + + ! zero out some arrays + NoahmpIO%QLATXY(I,J) = 0.0 + NoahmpIO%QSLATXY(I,J) = 0.0 + NoahmpIO%QRFXY(I,J) = 0.0 + NoahmpIO%QRFSXY(I,J) = 0.0 + NoahmpIO%DEEPRECHXY(I,J) = 0.0 + NoahmpIO%RECHXY(I,J) = 0.0 + NoahmpIO%QSPRINGXY(I,J) = 0.0 + NoahmpIO%QSPRINGSXY(I,J) = 0.0 + + enddo + enddo + + end associate + + end subroutine NoahmpGroundwaterInitMain + + subroutine EquilibriumSoilMoisture(NSOIL, ZSOIL, SMCMAX, SMCWLT, DWSAT, DKSAT, BEXP, SMCEQ) + + implicit none + + integer, intent(in) :: NSOIL !no. of soil layers + real(kind=kind_noahmp), intent(in) :: SMCMAX , SMCWLT, BEXP , DWSAT, DKSAT + real(kind=kind_noahmp), dimension(1:NSOIL), intent(in) :: ZSOIL !depth of soil layer-bottom [m] + real(kind=kind_noahmp), dimension(1:NSOIL), intent(out) :: SMCEQ !equilibrium soil water content [m3/m3] + + ! local variables + integer :: K, ITER + real(kind=kind_noahmp) :: DDZ, SMC, FUNC, DFUNC, AA, BB, EXPON, DX + ! -------------------------------------------------------------------------------- + + ! gmm compute equilibrium soil moisture content for the layer when wtd=zsoil(k) + do K = 1, NSOIL + if ( K == 1 ) then + DDZ = -ZSOIL(K+1) * 0.5 + elseif ( K < NSOIL ) then + DDZ = ( ZSOIL(K-1) - ZSOIL(K+1) ) * 0.5 + else + DDZ = ZSOIL(K-1) - ZSOIL(K) + endif + + ! use Newton-Raphson method to find eq soil moisture + EXPON = BEXP + 1.0 + AA = DWSAT / DDZ + BB = DKSAT / SMCMAX ** EXPON + SMC = 0.5 * SMCMAX + do ITER = 1, 100 + FUNC = (SMC - SMCMAX) * AA + BB * SMC ** EXPON + DFUNC = AA + BB * EXPON * SMC ** BEXP + DX = FUNC / DFUNC + SMC = SMC - DX + if ( abs(DX) < 1.0e-6 ) exit + enddo + +! SMCEQ(K) = min(max(SMC,SMCWLT),SMCMAX*0.99) + SMCEQ(K) = min(max(SMC,1.0e-4), SMCMAX*0.99) + enddo + + end subroutine EquilibriumSoilMoisture + +end module NoahmpGroundwaterInitMod diff --git a/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpIOVarFinalizeMod.F90 b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpIOVarFinalizeMod.F90 new file mode 100644 index 000000000..66458d638 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpIOVarFinalizeMod.F90 @@ -0,0 +1,465 @@ +module NoahmpIOVarFinalizeMod + +!!! Initialize Noah-MP input/output variables +!!! Input/Output variables should be first defined in NoahmpIOVarType.F90 + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use Machine + use NoahmpIOVarType + + implicit none + +contains + +!=== initialize with default values + + subroutine NoahmpIOVarFinalizeDefault(NoahmpIO) + + implicit none + + type(NoahmpIO_type), intent(inout) :: NoahmpIO + +! ------------------------------------------------- + associate( & + nsoil => NoahmpIO%nsoil ,& + nsnow => NoahmpIO%nsnow & + ) +! ------------------------------------------------- + + ! Input variables + if ( allocated (NoahmpIO%coszen) ) deallocate ( NoahmpIO%coszen ) ! cosine zenith angle + if ( allocated (NoahmpIO%xlat) ) deallocate ( NoahmpIO%xlat ) ! latitude [radians] + if ( allocated (NoahmpIO%dzs) ) deallocate ( NoahmpIO%dzs ) ! thickness of soil layers [m] + if ( allocated (NoahmpIO%zsoil) ) deallocate ( NoahmpIO%zsoil ) ! depth to soil interfaces [m] + if ( allocated (NoahmpIO%ivgtyp) ) deallocate ( NoahmpIO%ivgtyp ) ! vegetation type + if ( allocated (NoahmpIO%isltyp) ) deallocate ( NoahmpIO%isltyp ) ! soil type + if ( allocated (NoahmpIO%vegfra) ) deallocate ( NoahmpIO%vegfra ) ! vegetation fraction [] + if ( allocated (NoahmpIO%tmn) ) deallocate ( NoahmpIO%tmn ) ! deep soil temperature [K] + if ( allocated (NoahmpIO%xland) ) deallocate ( NoahmpIO%xland ) ! =2 ocean; =1 land/seaice + if ( allocated (NoahmpIO%xice) ) deallocate ( NoahmpIO%xice ) ! fraction of grid that is seaice + if ( allocated (NoahmpIO%swdown) ) deallocate ( NoahmpIO%swdown ) ! solar down at surface [W m-2] + if ( allocated (NoahmpIO%swddir) ) deallocate ( NoahmpIO%swddir ) ! solar down at surface [W m-2] for new urban solar panel + if ( allocated (NoahmpIO%swddif) ) deallocate ( NoahmpIO%swddif ) ! solar down at surface [W m-2] for new urban solar panel + if ( allocated (NoahmpIO%glw) ) deallocate ( NoahmpIO%glw ) ! longwave down at surface [W m-2] + if ( allocated (NoahmpIO%rainbl) ) deallocate ( NoahmpIO%rainbl ) ! total precipitation entering land model [mm] per time step + if ( allocated (NoahmpIO%snowbl) ) deallocate ( NoahmpIO%snowbl ) ! snow entering land model [mm] per time step + if ( allocated (NoahmpIO%sr) ) deallocate ( NoahmpIO%sr ) ! frozen precip ratio entering land model [-] + if ( allocated (NoahmpIO%raincv) ) deallocate ( NoahmpIO%raincv ) ! convective precip forcing [mm] + if ( allocated (NoahmpIO%rainncv) ) deallocate ( NoahmpIO%rainncv ) ! non-convective precip forcing [mm] + if ( allocated (NoahmpIO%rainshv) ) deallocate ( NoahmpIO%rainshv ) ! shallow conv. precip forcing [mm] + if ( allocated (NoahmpIO%snowncv) ) deallocate ( NoahmpIO%snowncv ) ! non-covective snow forcing (subset of rainncv) [mm] + if ( allocated (NoahmpIO%graupelncv)) deallocate ( NoahmpIO%graupelncv ) ! non-convective graupel forcing (subset of rainncv) [mm] + if ( allocated (NoahmpIO%hailncv) ) deallocate ( NoahmpIO%hailncv ) ! non-convective hail forcing (subset of rainncv) [mm] + if ( allocated (NoahmpIO%mp_rainc) ) deallocate ( NoahmpIO%mp_rainc ) ! convective precip forcing [mm] + if ( allocated (NoahmpIO%mp_rainnc) ) deallocate ( NoahmpIO%mp_rainnc ) ! non-convective precip forcing [mm] + if ( allocated (NoahmpIO%mp_shcv) ) deallocate ( NoahmpIO%mp_shcv ) ! shallow conv. precip forcing [mm] + if ( allocated (NoahmpIO%mp_snow) ) deallocate ( NoahmpIO%mp_snow ) ! non-covective snow (subset of rainnc) [mm] + if ( allocated (NoahmpIO%mp_graup) ) deallocate ( NoahmpIO%mp_graup ) ! non-convective graupel (subset of rainnc) [mm] + if ( allocated (NoahmpIO%mp_hail) ) deallocate ( NoahmpIO%mp_hail ) ! non-convective hail (subset of rainnc) [mm] + if ( allocated (NoahmpIO%seaice) ) deallocate ( NoahmpIO%seaice ) ! seaice fraction + if ( allocated (NoahmpIO%dz8w) ) deallocate ( NoahmpIO%dz8w ) ! thickness of atmo layers [m] + if ( allocated (NoahmpIO%t_phy) ) deallocate ( NoahmpIO%t_phy ) ! 3d atmospheric temperature valid at mid-levels [K] + if ( allocated (NoahmpIO%qv_curr) ) deallocate ( NoahmpIO%qv_curr ) ! 3d water vapor mixing ratio [kg/kg_dry] + if ( allocated (NoahmpIO%u_phy) ) deallocate ( NoahmpIO%u_phy ) ! 3d u wind component [m/s] + if ( allocated (NoahmpIO%v_phy) ) deallocate ( NoahmpIO%v_phy ) ! 3d v wind component [m/s] + if ( allocated (NoahmpIO%p8w) ) deallocate ( NoahmpIO%p8w ) ! 3d pressure, valid at interface [Pa] + + ! spatial varying parameter map + if ( NoahmpIO%iopt_soil > 1 ) then + if ( allocated (NoahmpIO%soilcomp)) deallocate ( NoahmpIO%soilcomp ) ! soil sand and clay content [fraction] + if ( allocated (NoahmpIO%soilcl1) ) deallocate ( NoahmpIO%soilcl1 ) ! soil texture class with depth + if ( allocated (NoahmpIO%soilcl2) ) deallocate ( NoahmpIO%soilcl2 ) ! soil texture class with depth + if ( allocated (NoahmpIO%soilcl3) ) deallocate ( NoahmpIO%soilcl3 ) ! soil texture class with depth + if ( allocated (NoahmpIO%soilcl4) ) deallocate ( NoahmpIO%soilcl4 ) ! soil texture class with depth + endif + if ( NoahmpIO%iopt_soil == 4 ) then + if ( allocated (NoahmpIO%bexp_3d) ) deallocate ( NoahmpIO%bexp_3d ) ! c-h b exponent + if ( allocated (NoahmpIO%smcdry_3d) ) deallocate ( NoahmpIO%smcdry_3d ) ! soil moisture limit: dry + if ( allocated (NoahmpIO%smcwlt_3d) ) deallocate ( NoahmpIO%smcwlt_3d ) ! soil moisture limit: wilt + if ( allocated (NoahmpIO%smcref_3d) ) deallocate ( NoahmpIO%smcref_3d ) ! soil moisture limit: reference + if ( allocated (NoahmpIO%smcmax_3d) ) deallocate ( NoahmpIO%smcmax_3d ) ! soil moisture limit: max + if ( allocated (NoahmpIO%dksat_3d) ) deallocate ( NoahmpIO%dksat_3d ) ! saturated soil conductivity + if ( allocated (NoahmpIO%dwsat_3d) ) deallocate ( NoahmpIO%dwsat_3d ) ! saturated soil diffusivity + if ( allocated (NoahmpIO%psisat_3d) ) deallocate ( NoahmpIO%psisat_3d ) ! saturated matric potential + if ( allocated (NoahmpIO%quartz_3d) ) deallocate ( NoahmpIO%quartz_3d ) ! soil quartz content + if ( allocated (NoahmpIO%refdk_2d) ) deallocate ( NoahmpIO%refdk_2d ) ! reference soil conductivity + if ( allocated (NoahmpIO%refkdt_2d) ) deallocate ( NoahmpIO%refkdt_2d ) ! soil infiltration parameter + if ( allocated (NoahmpIO%irr_frac_2d) ) deallocate ( NoahmpIO%irr_frac_2d ) ! irrigation fraction + if ( allocated (NoahmpIO%irr_har_2d) ) deallocate ( NoahmpIO%irr_har_2d ) ! number of days before harvest date to stop irrigation + if ( allocated (NoahmpIO%irr_lai_2d) ) deallocate ( NoahmpIO%irr_lai_2d ) ! minimum lai to trigger irrigation + if ( allocated (NoahmpIO%irr_mad_2d) ) deallocate ( NoahmpIO%irr_mad_2d ) ! management allowable deficit (0-1) + if ( allocated (NoahmpIO%filoss_2d) ) deallocate ( NoahmpIO%filoss_2d ) ! fraction of flood irrigation loss (0-1) + if ( allocated (NoahmpIO%sprir_rate_2d)) deallocate ( NoahmpIO%sprir_rate_2d ) ! mm/h, sprinkler irrigation rate + if ( allocated (NoahmpIO%micir_rate_2d)) deallocate ( NoahmpIO%micir_rate_2d ) ! mm/h, micro irrigation rate + if ( allocated (NoahmpIO%firtfac_2d) ) deallocate ( NoahmpIO%firtfac_2d ) ! flood application rate factor + if ( allocated (NoahmpIO%ir_rain_2d) ) deallocate ( NoahmpIO%ir_rain_2d ) ! maximum precipitation to stop irrigation trigger + if ( allocated (NoahmpIO%bvic_2d) ) deallocate ( NoahmpIO%bvic_2d ) ! VIC model infiltration parameter [-] + if ( allocated (NoahmpIO%axaj_2d) ) deallocate ( NoahmpIO%axaj_2d ) ! tension water distribution inflection parameter [-] + if ( allocated (NoahmpIO%bxaj_2d) ) deallocate ( NoahmpIO%bxaj_2d ) ! tension water distribution shape parameter [-] + if ( allocated (NoahmpIO%xxaj_2d) ) deallocate ( NoahmpIO%xxaj_2d ) ! free water distribution shape parameter [-] + if ( allocated (NoahmpIO%bdvic_2d) ) deallocate ( NoahmpIO%bdvic_2d ) ! DVIC model infiltration parameter [-] + if ( allocated (NoahmpIO%gdvic_2d) ) deallocate ( NoahmpIO%gdvic_2d ) ! mean capillary drive (m) for infiltration models + if ( allocated (NoahmpIO%bbvic_2d) ) deallocate ( NoahmpIO%bbvic_2d ) ! dvic heterogeniety parameter for infiltration [-] + if ( allocated (NoahmpIO%klat_fac) ) deallocate ( NoahmpIO%klat_fac ) ! factor multiplier to hydraulic conductivity + if ( allocated (NoahmpIO%tdsmc_fac) ) deallocate ( NoahmpIO%tdsmc_fac ) ! factor multiplier to field capacity + if ( allocated (NoahmpIO%td_dc) ) deallocate ( NoahmpIO%td_dc ) ! drainage coefficient for simple + if ( allocated (NoahmpIO%td_dcoef) ) deallocate ( NoahmpIO%td_dcoef ) ! drainage coefficient for Hooghoudt + if ( allocated (NoahmpIO%td_ddrain) ) deallocate ( NoahmpIO%td_ddrain ) ! depth of drain + if ( allocated (NoahmpIO%td_radi) ) deallocate ( NoahmpIO%td_radi ) ! tile radius + if ( allocated (NoahmpIO%td_spac) ) deallocate ( NoahmpIO%td_spac ) ! tile spacing + endif + + ! INOUT (with generic LSM equivalent) (as defined in WRF) + if ( allocated (NoahmpIO%tsk) ) deallocate ( NoahmpIO%tsk ) ! surface radiative temperature [K] + if ( allocated (NoahmpIO%hfx) ) deallocate ( NoahmpIO%hfx ) ! sensible heat flux [W m-2] + if ( allocated (NoahmpIO%qfx) ) deallocate ( NoahmpIO%qfx ) ! latent heat flux [kg s-1 m-2] + if ( allocated (NoahmpIO%lh) ) deallocate ( NoahmpIO%lh ) ! latent heat flux [W m-2] + if ( allocated (NoahmpIO%grdflx) ) deallocate ( NoahmpIO%grdflx ) ! ground/snow heat flux [W m-2] + if ( allocated (NoahmpIO%smstav) ) deallocate ( NoahmpIO%smstav ) ! soil moisture avail. [not used] + if ( allocated (NoahmpIO%smstot) ) deallocate ( NoahmpIO%smstot ) ! total soil water [mm][not used] + if ( allocated (NoahmpIO%sfcrunoff)) deallocate ( NoahmpIO%sfcrunoff ) ! accumulated surface runoff [m] + if ( allocated (NoahmpIO%udrunoff) ) deallocate ( NoahmpIO%udrunoff ) ! accumulated sub-surface runoff [m] + if ( allocated (NoahmpIO%albedo) ) deallocate ( NoahmpIO%albedo ) ! total grid albedo [] + if ( allocated (NoahmpIO%snowc) ) deallocate ( NoahmpIO%snowc ) ! snow cover fraction [] + if ( allocated (NoahmpIO%snow) ) deallocate ( NoahmpIO%snow ) ! snow water equivalent [mm] + if ( allocated (NoahmpIO%snowh) ) deallocate ( NoahmpIO%snowh ) ! physical snow depth [m] + if ( allocated (NoahmpIO%canwat) ) deallocate ( NoahmpIO%canwat ) ! total canopy water + ice [mm] + if ( allocated (NoahmpIO%acsnom) ) deallocate ( NoahmpIO%acsnom ) ! accumulated snow melt leaving pack + if ( allocated (NoahmpIO%acsnow) ) deallocate ( NoahmpIO%acsnow ) ! accumulated snow on grid + if ( allocated (NoahmpIO%emiss) ) deallocate ( NoahmpIO%emiss ) ! surface bulk emissivity + if ( allocated (NoahmpIO%qsfc) ) deallocate ( NoahmpIO%qsfc ) ! bulk surface specific humidity + if ( allocated (NoahmpIO%smoiseq) ) deallocate ( NoahmpIO%smoiseq ) ! equilibrium volumetric soil moisture [m3/m3] + if ( allocated (NoahmpIO%smois) ) deallocate ( NoahmpIO%smois ) ! volumetric soil moisture [m3/m3] + if ( allocated (NoahmpIO%sh2o) ) deallocate ( NoahmpIO%sh2o ) ! volumetric liquid soil moisture [m3/m3] + if ( allocated (NoahmpIO%tslb) ) deallocate ( NoahmpIO%tslb ) ! soil temperature [K] + + ! INOUT (with no Noah LSM equivalent) (as defined in WRF) + if ( allocated (NoahmpIO%isnowxy) ) deallocate ( NoahmpIO%isnowxy ) ! actual no. of snow layers + if ( allocated (NoahmpIO%tvxy) ) deallocate ( NoahmpIO%tvxy ) ! vegetation leaf temperature + if ( allocated (NoahmpIO%tgxy) ) deallocate ( NoahmpIO%tgxy ) ! bulk ground surface temperature + if ( allocated (NoahmpIO%canicexy) ) deallocate ( NoahmpIO%canicexy ) ! canopy-intercepted ice (mm) + if ( allocated (NoahmpIO%canliqxy) ) deallocate ( NoahmpIO%canliqxy ) ! canopy-intercepted liquid water (mm) + if ( allocated (NoahmpIO%eahxy) ) deallocate ( NoahmpIO%eahxy ) ! canopy air vapor pressure (Pa) + if ( allocated (NoahmpIO%tahxy) ) deallocate ( NoahmpIO%tahxy ) ! canopy air temperature (K) + if ( allocated (NoahmpIO%cmxy) ) deallocate ( NoahmpIO%cmxy ) ! bulk momentum drag coefficient + if ( allocated (NoahmpIO%chxy) ) deallocate ( NoahmpIO%chxy ) ! bulk sensible heat exchange coefficient + if ( allocated (NoahmpIO%fwetxy) ) deallocate ( NoahmpIO%fwetxy ) ! wetted or snowed fraction of the canopy (-) + if ( allocated (NoahmpIO%sneqvoxy) ) deallocate ( NoahmpIO%sneqvoxy ) ! snow mass at last time step(mm H2O) + if ( allocated (NoahmpIO%alboldxy) ) deallocate ( NoahmpIO%alboldxy ) ! snow albedo at last time step (-) + if ( allocated (NoahmpIO%qsnowxy) ) deallocate ( NoahmpIO%qsnowxy ) ! snowfall on the ground [mm/s] + if ( allocated (NoahmpIO%qrainxy) ) deallocate ( NoahmpIO%qrainxy ) ! rainfall on the ground [mm/s] + if ( allocated (NoahmpIO%wslakexy) ) deallocate ( NoahmpIO%wslakexy ) ! lake water storage [mm] + if ( allocated (NoahmpIO%zwtxy) ) deallocate ( NoahmpIO%zwtxy ) ! water table depth [m] + if ( allocated (NoahmpIO%waxy) ) deallocate ( NoahmpIO%waxy ) ! water in the "aquifer" [mm] + if ( allocated (NoahmpIO%wtxy) ) deallocate ( NoahmpIO%wtxy ) ! groundwater storage [mm] + if ( allocated (NoahmpIO%smcwtdxy) ) deallocate ( NoahmpIO%smcwtdxy ) ! soil moisture below the bottom of the column (m3 m-3) + if ( allocated (NoahmpIO%deeprechxy)) deallocate ( NoahmpIO%deeprechxy ) ! recharge to the water table when deep (m) + if ( allocated (NoahmpIO%rechxy) ) deallocate ( NoahmpIO%rechxy ) ! recharge to the water table (diagnostic) (m) + if ( allocated (NoahmpIO%lfmassxy) ) deallocate ( NoahmpIO%lfmassxy ) ! leaf mass [g/m2] + if ( allocated (NoahmpIO%rtmassxy) ) deallocate ( NoahmpIO%rtmassxy ) ! mass of fine roots [g/m2] + if ( allocated (NoahmpIO%stmassxy) ) deallocate ( NoahmpIO%stmassxy ) ! stem mass [g/m2] + if ( allocated (NoahmpIO%woodxy) ) deallocate ( NoahmpIO%woodxy ) ! mass of wood (incl. woody roots) [g/m2] + if ( allocated (NoahmpIO%grainxy) ) deallocate ( NoahmpIO%grainxy ) ! mass of grain xing [g/m2] + if ( allocated (NoahmpIO%gddxy) ) deallocate ( NoahmpIO%gddxy ) ! growing degree days xing four + if ( allocated (NoahmpIO%stblcpxy) ) deallocate ( NoahmpIO%stblcpxy ) ! stable carbon in deep soil [g/m2] + if ( allocated (NoahmpIO%fastcpxy) ) deallocate ( NoahmpIO%fastcpxy ) ! short-lived carbon, shallow soil [g/m2] + if ( allocated (NoahmpIO%lai) ) deallocate ( NoahmpIO%lai ) ! leaf area index + if ( allocated (NoahmpIO%xsaixy) ) deallocate ( NoahmpIO%xsaixy ) ! stem area index + if ( allocated (NoahmpIO%taussxy) ) deallocate ( NoahmpIO%taussxy ) ! snow age factor + if ( allocated (NoahmpIO%tsnoxy) ) deallocate ( NoahmpIO%tsnoxy ) ! snow temperature [K] + if ( allocated (NoahmpIO%zsnsoxy) ) deallocate ( NoahmpIO%zsnsoxy ) ! snow layer depth [m] + if ( allocated (NoahmpIO%snicexy) ) deallocate ( NoahmpIO%snicexy ) ! snow layer ice [mm] + if ( allocated (NoahmpIO%snliqxy) ) deallocate ( NoahmpIO%snliqxy ) ! snow layer liquid water [mm] + + ! irrigation + if ( allocated (NoahmpIO%irfract) ) deallocate ( NoahmpIO%irfract ) ! irrigation fraction + if ( allocated (NoahmpIO%sifract) ) deallocate ( NoahmpIO%sifract ) ! sprinkler irrigation fraction + if ( allocated (NoahmpIO%mifract) ) deallocate ( NoahmpIO%mifract ) ! micro irrigation fraction + if ( allocated (NoahmpIO%fifract) ) deallocate ( NoahmpIO%fifract ) ! flood irrigation fraction + if ( allocated (NoahmpIO%irnumsi) ) deallocate ( NoahmpIO%irnumsi ) ! irrigation event number, sprinkler + if ( allocated (NoahmpIO%irnummi) ) deallocate ( NoahmpIO%irnummi ) ! irrigation event number, micro + if ( allocated (NoahmpIO%irnumfi) ) deallocate ( NoahmpIO%irnumfi ) ! irrigation event number, flood + if ( allocated (NoahmpIO%irwatsi) ) deallocate ( NoahmpIO%irwatsi ) ! irrigation water amount [m] to be applied, sprinkler + if ( allocated (NoahmpIO%irwatmi) ) deallocate ( NoahmpIO%irwatmi ) ! irrigation water amount [m] to be applied, micro + if ( allocated (NoahmpIO%irwatfi) ) deallocate ( NoahmpIO%irwatfi ) ! irrigation water amount [m] to be applied, flood + if ( allocated (NoahmpIO%ireloss) ) deallocate ( NoahmpIO%ireloss ) ! loss of irrigation water to evaporation,sprinkler [mm] + if ( allocated (NoahmpIO%irsivol) ) deallocate ( NoahmpIO%irsivol ) ! amount of irrigation by sprinkler (mm) + if ( allocated (NoahmpIO%irmivol) ) deallocate ( NoahmpIO%irmivol ) ! amount of irrigation by micro (mm) + if ( allocated (NoahmpIO%irfivol) ) deallocate ( NoahmpIO%irfivol ) ! amount of irrigation by micro (mm) + if ( allocated (NoahmpIO%irrsplh) ) deallocate ( NoahmpIO%irrsplh ) ! latent heating from sprinkler evaporation (W/m2) + if ( allocated (NoahmpIO%loctim) ) deallocate ( NoahmpIO%loctim ) ! local time + + ! OUT (with no Noah LSM equivalent) (as defined in WRF) + if ( allocated (NoahmpIO%t2mvxy) ) deallocate ( NoahmpIO%t2mvxy ) ! 2m temperature of vegetation part + if ( allocated (NoahmpIO%t2mbxy) ) deallocate ( NoahmpIO%t2mbxy ) ! 2m temperature of bare ground part + if ( allocated (NoahmpIO%t2mxy) ) deallocate ( NoahmpIO%t2mxy ) ! 2m grid-mean temperature + if ( allocated (NoahmpIO%q2mvxy) ) deallocate ( NoahmpIO%q2mvxy ) ! 2m mixing ratio of vegetation part + if ( allocated (NoahmpIO%q2mbxy) ) deallocate ( NoahmpIO%q2mbxy ) ! 2m mixing ratio of bare ground part + if ( allocated (NoahmpIO%q2mxy) ) deallocate ( NoahmpIO%q2mxy ) ! 2m grid-mean mixing ratio + if ( allocated (NoahmpIO%tradxy) ) deallocate ( NoahmpIO%tradxy ) ! surface radiative temperature (K) + if ( allocated (NoahmpIO%neexy) ) deallocate ( NoahmpIO%neexy ) ! net ecosys exchange (g/m2/s CO2) + if ( allocated (NoahmpIO%gppxy) ) deallocate ( NoahmpIO%gppxy ) ! gross primary assimilation [g/m2/s C] + if ( allocated (NoahmpIO%nppxy) ) deallocate ( NoahmpIO%nppxy ) ! net primary productivity [g/m2/s C] + if ( allocated (NoahmpIO%fvegxy) ) deallocate ( NoahmpIO%fvegxy ) ! noah-mp vegetation fraction [-] + if ( allocated (NoahmpIO%runsfxy) ) deallocate ( NoahmpIO%runsfxy ) ! surface runoff [mm per soil timestep] + if ( allocated (NoahmpIO%runsbxy) ) deallocate ( NoahmpIO%runsbxy ) ! subsurface runoff [mm per soil timestep] + if ( allocated (NoahmpIO%ecanxy) ) deallocate ( NoahmpIO%ecanxy ) ! evaporation of intercepted water (mm/s) + if ( allocated (NoahmpIO%edirxy) ) deallocate ( NoahmpIO%edirxy ) ! soil surface evaporation rate (mm/s] + if ( allocated (NoahmpIO%etranxy) ) deallocate ( NoahmpIO%etranxy ) ! transpiration rate (mm/s) + if ( allocated (NoahmpIO%fsaxy) ) deallocate ( NoahmpIO%fsaxy ) ! total absorbed solar radiation (W/m2) + if ( allocated (NoahmpIO%firaxy) ) deallocate ( NoahmpIO%firaxy ) ! total net longwave rad (W/m2) [+ to atm] + if ( allocated (NoahmpIO%aparxy) ) deallocate ( NoahmpIO%aparxy ) ! photosyn active energy by canopy (W/m2) + if ( allocated (NoahmpIO%psnxy) ) deallocate ( NoahmpIO%psnxy ) ! total photosynthesis (umol CO2/m2/s) [+] + if ( allocated (NoahmpIO%savxy) ) deallocate ( NoahmpIO%savxy ) ! solar rad absorbed by veg. (W/m2) + if ( allocated (NoahmpIO%sagxy) ) deallocate ( NoahmpIO%sagxy ) ! solar rad absorbed by ground (W/m2) + if ( allocated (NoahmpIO%rssunxy) ) deallocate ( NoahmpIO%rssunxy ) ! sunlit leaf stomatal resistance (s/m) + if ( allocated (NoahmpIO%rsshaxy) ) deallocate ( NoahmpIO%rsshaxy ) ! shaded leaf stomatal resistance (s/m) + if ( allocated (NoahmpIO%bgapxy) ) deallocate ( NoahmpIO%bgapxy ) ! between gap fraction + if ( allocated (NoahmpIO%wgapxy) ) deallocate ( NoahmpIO%wgapxy ) ! within gap fraction + if ( allocated (NoahmpIO%tgvxy) ) deallocate ( NoahmpIO%tgvxy ) ! under canopy ground temperature[K] + if ( allocated (NoahmpIO%tgbxy) ) deallocate ( NoahmpIO%tgbxy ) ! bare ground temperature [K] + if ( allocated (NoahmpIO%chvxy) ) deallocate ( NoahmpIO%chvxy ) ! sensible heat exchange coefficient vegetated + if ( allocated (NoahmpIO%chbxy) ) deallocate ( NoahmpIO%chbxy ) ! sensible heat exchange coefficient bare-ground + if ( allocated (NoahmpIO%shgxy) ) deallocate ( NoahmpIO%shgxy ) ! veg ground sen. heat [W/m2] [+ to atm] + if ( allocated (NoahmpIO%shcxy) ) deallocate ( NoahmpIO%shcxy ) ! canopy sen. heat [W/m2] [+ to atm] + if ( allocated (NoahmpIO%shbxy) ) deallocate ( NoahmpIO%shbxy ) ! bare sensible heat [W/m2] [+ to atm] + if ( allocated (NoahmpIO%evgxy) ) deallocate ( NoahmpIO%evgxy ) ! veg ground evap. heat [W/m2] [+ to atm] + if ( allocated (NoahmpIO%evbxy) ) deallocate ( NoahmpIO%evbxy ) ! bare soil evaporation [W/m2] [+ to atm] + if ( allocated (NoahmpIO%ghvxy) ) deallocate ( NoahmpIO%ghvxy ) ! veg ground heat flux [W/m2] [+ to soil] + if ( allocated (NoahmpIO%ghbxy) ) deallocate ( NoahmpIO%ghbxy ) ! bare ground heat flux [W/m2] [+ to soil] + if ( allocated (NoahmpIO%irgxy) ) deallocate ( NoahmpIO%irgxy ) ! veg ground net lw rad. [W/m2] [+ to atm] + if ( allocated (NoahmpIO%ircxy) ) deallocate ( NoahmpIO%ircxy ) ! canopy net lw rad. [W/m2] [+ to atm] + if ( allocated (NoahmpIO%irbxy) ) deallocate ( NoahmpIO%irbxy ) ! bare net longwave rad. [W/m2] [+ to atm] + if ( allocated (NoahmpIO%trxy) ) deallocate ( NoahmpIO%trxy ) ! transpiration [w/m2] [+ to atm] + if ( allocated (NoahmpIO%evcxy) ) deallocate ( NoahmpIO%evcxy ) ! canopy evaporation heat [W/m2] [+ to atm] + if ( allocated (NoahmpIO%chleafxy) ) deallocate ( NoahmpIO%chleafxy ) ! leaf exchange coefficient + if ( allocated (NoahmpIO%chucxy) ) deallocate ( NoahmpIO%chucxy ) ! under canopy exchange coefficient + if ( allocated (NoahmpIO%chv2xy) ) deallocate ( NoahmpIO%chv2xy ) ! veg 2m exchange coefficient + if ( allocated (NoahmpIO%chb2xy) ) deallocate ( NoahmpIO%chb2xy ) ! bare 2m exchange coefficient + if ( allocated (NoahmpIO%rs) ) deallocate ( NoahmpIO%rs ) ! total stomatal resistance (s/m) + if ( allocated (NoahmpIO%z0) ) deallocate ( NoahmpIO%z0 ) ! roughness length output to WRF + if ( allocated (NoahmpIO%znt) ) deallocate ( NoahmpIO%znt ) ! roughness length output to WRF + if ( allocated (NoahmpIO%qtdrain) ) deallocate ( NoahmpIO%qtdrain ) ! tile drainage (mm) + if ( allocated (NoahmpIO%td_fraction)) deallocate ( NoahmpIO%td_fraction ) ! tile drainage fraction + if ( allocated (NoahmpIO%xlong) ) deallocate ( NoahmpIO%xlong ) ! longitude + if ( allocated (NoahmpIO%terrain) ) deallocate ( NoahmpIO%terrain ) ! terrain height + if ( allocated (NoahmpIO%gvfmin) ) deallocate ( NoahmpIO%gvfmin ) ! annual minimum in vegetation fraction + if ( allocated (NoahmpIO%gvfmax) ) deallocate ( NoahmpIO%gvfmax ) ! annual maximum in vegetation fraction + + ! additional output variables + if ( allocated (NoahmpIO%pahxy) ) deallocate ( NoahmpIO%pahxy ) + if ( allocated (NoahmpIO%pahgxy) ) deallocate ( NoahmpIO%pahgxy ) + if ( allocated (NoahmpIO%pahbxy) ) deallocate ( NoahmpIO%pahbxy ) + if ( allocated (NoahmpIO%pahvxy) ) deallocate ( NoahmpIO%pahvxy ) + if ( allocated (NoahmpIO%qintsxy) ) deallocate ( NoahmpIO%qintsxy ) + if ( allocated (NoahmpIO%qintrxy) ) deallocate ( NoahmpIO%qintrxy ) + if ( allocated (NoahmpIO%qdripsxy) ) deallocate ( NoahmpIO%qdripsxy ) + if ( allocated (NoahmpIO%qdriprxy) ) deallocate ( NoahmpIO%qdriprxy ) + if ( allocated (NoahmpIO%qthrosxy) ) deallocate ( NoahmpIO%qthrosxy ) + if ( allocated (NoahmpIO%qthrorxy) ) deallocate ( NoahmpIO%qthrorxy ) + if ( allocated (NoahmpIO%qsnsubxy) ) deallocate ( NoahmpIO%qsnsubxy ) + if ( allocated (NoahmpIO%qsnfroxy) ) deallocate ( NoahmpIO%qsnfroxy ) + if ( allocated (NoahmpIO%qsubcxy) ) deallocate ( NoahmpIO%qsubcxy ) + if ( allocated (NoahmpIO%qfrocxy) ) deallocate ( NoahmpIO%qfrocxy ) + if ( allocated (NoahmpIO%qevacxy) ) deallocate ( NoahmpIO%qevacxy ) + if ( allocated (NoahmpIO%qdewcxy) ) deallocate ( NoahmpIO%qdewcxy ) + if ( allocated (NoahmpIO%qfrzcxy) ) deallocate ( NoahmpIO%qfrzcxy ) + if ( allocated (NoahmpIO%qmeltcxy) ) deallocate ( NoahmpIO%qmeltcxy ) + if ( allocated (NoahmpIO%qsnbotxy) ) deallocate ( NoahmpIO%qsnbotxy ) + if ( allocated (NoahmpIO%qmeltxy) ) deallocate ( NoahmpIO%qmeltxy ) + if ( allocated (NoahmpIO%pondingxy) ) deallocate ( NoahmpIO%pondingxy ) + if ( allocated (NoahmpIO%fpicexy) ) deallocate ( NoahmpIO%fpicexy ) + if ( allocated (NoahmpIO%rainlsm) ) deallocate ( NoahmpIO%rainlsm ) + if ( allocated (NoahmpIO%snowlsm) ) deallocate ( NoahmpIO%snowlsm ) + if ( allocated (NoahmpIO%forctlsm) ) deallocate ( NoahmpIO%forctlsm ) + if ( allocated (NoahmpIO%forcqlsm) ) deallocate ( NoahmpIO%forcqlsm ) + if ( allocated (NoahmpIO%forcplsm) ) deallocate ( NoahmpIO%forcplsm ) + if ( allocated (NoahmpIO%forczlsm) ) deallocate ( NoahmpIO%forczlsm ) + if ( allocated (NoahmpIO%forcwlsm) ) deallocate ( NoahmpIO%forcwlsm ) + if ( allocated (NoahmpIO%eflxbxy) ) deallocate ( NoahmpIO%eflxbxy ) + if ( allocated (NoahmpIO%soilenergy) ) deallocate ( NoahmpIO%soilenergy ) + if ( allocated (NoahmpIO%snowenergy) ) deallocate ( NoahmpIO%snowenergy ) + if ( allocated (NoahmpIO%canhsxy) ) deallocate ( NoahmpIO%canhsxy ) + if ( allocated (NoahmpIO%acc_dwaterxy)) deallocate ( NoahmpIO%acc_dwaterxy ) + if ( allocated (NoahmpIO%acc_prcpxy) ) deallocate ( NoahmpIO%acc_prcpxy ) + if ( allocated (NoahmpIO%acc_ecanxy) ) deallocate ( NoahmpIO%acc_ecanxy ) + if ( allocated (NoahmpIO%acc_etranxy) ) deallocate ( NoahmpIO%acc_etranxy ) + if ( allocated (NoahmpIO%acc_edirxy) ) deallocate ( NoahmpIO%acc_edirxy ) + if ( allocated (NoahmpIO%acc_ssoilxy) ) deallocate ( NoahmpIO%acc_ssoilxy ) + if ( allocated (NoahmpIO%acc_qinsurxy)) deallocate ( NoahmpIO%acc_qinsurxy ) + if ( allocated (NoahmpIO%acc_qsevaxy) ) deallocate ( NoahmpIO%acc_qsevaxy ) + if ( allocated (NoahmpIO%acc_etranixy)) deallocate ( NoahmpIO%acc_etranixy ) + + ! needed for mmf_runoff (iopt_run = 5); not part of mp driver in WRF + if ( allocated (NoahmpIO%msftx) ) deallocate ( NoahmpIO%msftx ) + if ( allocated (NoahmpIO%msfty) ) deallocate ( NoahmpIO%msfty ) + if ( allocated (NoahmpIO%eqzwt) ) deallocate ( NoahmpIO%eqzwt ) + if ( allocated (NoahmpIO%riverbedxy) ) deallocate ( NoahmpIO%riverbedxy ) + if ( allocated (NoahmpIO%rivercondxy)) deallocate ( NoahmpIO%rivercondxy ) + if ( allocated (NoahmpIO%pexpxy) ) deallocate ( NoahmpIO%pexpxy ) + if ( allocated (NoahmpIO%fdepthxy) ) deallocate ( NoahmpIO%fdepthxy ) + if ( allocated (NoahmpIO%areaxy) ) deallocate ( NoahmpIO%areaxy ) + if ( allocated (NoahmpIO%qrfsxy) ) deallocate ( NoahmpIO%qrfsxy ) + if ( allocated (NoahmpIO%qspringsxy) ) deallocate ( NoahmpIO%qspringsxy ) + if ( allocated (NoahmpIO%qrfxy) ) deallocate ( NoahmpIO%qrfxy ) + if ( allocated (NoahmpIO%qspringxy) ) deallocate ( NoahmpIO%qspringxy ) + if ( allocated (NoahmpIO%qslatxy) ) deallocate ( NoahmpIO%qslatxy ) + if ( allocated (NoahmpIO%qlatxy) ) deallocate ( NoahmpIO%qlatxy ) + if ( allocated (NoahmpIO%rechclim) ) deallocate ( NoahmpIO%rechclim ) + if ( allocated (NoahmpIO%rivermask) ) deallocate ( NoahmpIO%rivermask ) + if ( allocated (NoahmpIO%nonriverxy) ) deallocate ( NoahmpIO%nonriverxy ) + + ! needed for crop model (opt_crop=1) + if ( allocated (NoahmpIO%pgsxy) ) deallocate ( NoahmpIO%pgsxy ) + if ( allocated (NoahmpIO%cropcat) ) deallocate ( NoahmpIO%cropcat ) + if ( allocated (NoahmpIO%planting) ) deallocate ( NoahmpIO%planting ) + if ( allocated (NoahmpIO%harvest) ) deallocate ( NoahmpIO%harvest ) + if ( allocated (NoahmpIO%season_gdd)) deallocate ( NoahmpIO%season_gdd ) + if ( allocated (NoahmpIO%croptype) ) deallocate ( NoahmpIO%croptype ) + + ! Single- and Multi-layer Urban Models + if ( NoahmpIO%sf_urban_physics > 0 ) then + if ( allocated (NoahmpIO%sh_urb2d) ) deallocate ( NoahmpIO%sh_urb2d ) + if ( allocated (NoahmpIO%lh_urb2d) ) deallocate ( NoahmpIO%lh_urb2d ) + if ( allocated (NoahmpIO%g_urb2d) ) deallocate ( NoahmpIO%g_urb2d ) + if ( allocated (NoahmpIO%rn_urb2d) ) deallocate ( NoahmpIO%rn_urb2d ) + if ( allocated (NoahmpIO%ts_urb2d) ) deallocate ( NoahmpIO%ts_urb2d ) + if ( allocated (NoahmpIO%hrang) ) deallocate ( NoahmpIO%hrang ) + if ( allocated (NoahmpIO%frc_urb2d) ) deallocate ( NoahmpIO%frc_urb2d ) + if ( allocated (NoahmpIO%utype_urb2d)) deallocate ( NoahmpIO%utype_urb2d ) + if ( allocated (NoahmpIO%lp_urb2d) ) deallocate ( NoahmpIO%lp_urb2d ) + if ( allocated (NoahmpIO%lb_urb2d) ) deallocate ( NoahmpIO%lb_urb2d ) + if ( allocated (NoahmpIO%hgt_urb2d) ) deallocate ( NoahmpIO%hgt_urb2d ) + if ( allocated (NoahmpIO%ust) ) deallocate ( NoahmpIO%ust ) + endif + + if(NoahmpIO%sf_urban_physics == 1 ) then ! single layer urban model + if ( allocated (NoahmpIO%cmr_sfcdif) ) deallocate ( NoahmpIO%cmr_sfcdif ) + if ( allocated (NoahmpIO%chr_sfcdif) ) deallocate ( NoahmpIO%chr_sfcdif ) + if ( allocated (NoahmpIO%cmc_sfcdif) ) deallocate ( NoahmpIO%cmc_sfcdif ) + if ( allocated (NoahmpIO%chc_sfcdif) ) deallocate ( NoahmpIO%chc_sfcdif ) + if ( allocated (NoahmpIO%cmgr_sfcdif) ) deallocate ( NoahmpIO%cmgr_sfcdif ) + if ( allocated (NoahmpIO%chgr_sfcdif) ) deallocate ( NoahmpIO%chgr_sfcdif ) + if ( allocated (NoahmpIO%tr_urb2d) ) deallocate ( NoahmpIO%tr_urb2d ) + if ( allocated (NoahmpIO%tb_urb2d) ) deallocate ( NoahmpIO%tb_urb2d ) + if ( allocated (NoahmpIO%tg_urb2d) ) deallocate ( NoahmpIO%tg_urb2d ) + if ( allocated (NoahmpIO%tc_urb2d) ) deallocate ( NoahmpIO%tc_urb2d ) + if ( allocated (NoahmpIO%qc_urb2d) ) deallocate ( NoahmpIO%qc_urb2d ) + if ( allocated (NoahmpIO%uc_urb2d) ) deallocate ( NoahmpIO%uc_urb2d ) + if ( allocated (NoahmpIO%xxxr_urb2d) ) deallocate ( NoahmpIO%xxxr_urb2d ) + if ( allocated (NoahmpIO%xxxb_urb2d) ) deallocate ( NoahmpIO%xxxb_urb2d ) + if ( allocated (NoahmpIO%xxxg_urb2d) ) deallocate ( NoahmpIO%xxxg_urb2d ) + if ( allocated (NoahmpIO%xxxc_urb2d) ) deallocate ( NoahmpIO%xxxc_urb2d ) + if ( allocated (NoahmpIO%psim_urb2d) ) deallocate ( NoahmpIO%psim_urb2d ) + if ( allocated (NoahmpIO%psih_urb2d) ) deallocate ( NoahmpIO%psih_urb2d ) + if ( allocated (NoahmpIO%u10_urb2d) ) deallocate ( NoahmpIO%u10_urb2d ) + if ( allocated (NoahmpIO%v10_urb2d) ) deallocate ( NoahmpIO%v10_urb2d ) + if ( allocated (NoahmpIO%gz1oz0_urb2d) ) deallocate ( NoahmpIO%gz1oz0_urb2d ) + if ( allocated (NoahmpIO%akms_urb2d) ) deallocate ( NoahmpIO%akms_urb2d ) + if ( allocated (NoahmpIO%th2_urb2d) ) deallocate ( NoahmpIO%th2_urb2d ) + if ( allocated (NoahmpIO%q2_urb2d) ) deallocate ( NoahmpIO%q2_urb2d ) + if ( allocated (NoahmpIO%ust_urb2d) ) deallocate ( NoahmpIO%ust_urb2d ) + if ( allocated (NoahmpIO%cmcr_urb2d) ) deallocate ( NoahmpIO%cmcr_urb2d ) + if ( allocated (NoahmpIO%tgr_urb2d) ) deallocate ( NoahmpIO%tgr_urb2d ) + if ( allocated (NoahmpIO%drelr_urb2d) ) deallocate ( NoahmpIO%drelr_urb2d ) + if ( allocated (NoahmpIO%drelb_urb2d) ) deallocate ( NoahmpIO%drelb_urb2d ) + if ( allocated (NoahmpIO%drelg_urb2d) ) deallocate ( NoahmpIO%drelg_urb2d ) + if ( allocated (NoahmpIO%flxhumr_urb2d)) deallocate ( NoahmpIO%flxhumr_urb2d ) + if ( allocated (NoahmpIO%flxhumb_urb2d)) deallocate ( NoahmpIO%flxhumb_urb2d ) + if ( allocated (NoahmpIO%flxhumg_urb2d)) deallocate ( NoahmpIO%flxhumg_urb2d ) + if ( allocated (NoahmpIO%chs) ) deallocate ( NoahmpIO%chs ) + if ( allocated (NoahmpIO%chs2) ) deallocate ( NoahmpIO%chs2 ) + if ( allocated (NoahmpIO%cqs2) ) deallocate ( NoahmpIO%cqs2 ) + if ( allocated (NoahmpIO%mh_urb2d) ) deallocate ( NoahmpIO%mh_urb2d ) + if ( allocated (NoahmpIO%stdh_urb2d) ) deallocate ( NoahmpIO%stdh_urb2d ) + if ( allocated (NoahmpIO%lf_urb2d) ) deallocate ( NoahmpIO%lf_urb2d ) + if ( allocated (NoahmpIO%trl_urb3d) ) deallocate ( NoahmpIO%trl_urb3d ) + if ( allocated (NoahmpIO%tbl_urb3d) ) deallocate ( NoahmpIO%tbl_urb3d ) + if ( allocated (NoahmpIO%tgl_urb3d) ) deallocate ( NoahmpIO%tgl_urb3d ) + if ( allocated (NoahmpIO%tgrl_urb3d) ) deallocate ( NoahmpIO%tgrl_urb3d ) + if ( allocated (NoahmpIO%smr_urb3d) ) deallocate ( NoahmpIO%smr_urb3d ) + if ( allocated (NoahmpIO%dzr) ) deallocate ( NoahmpIO%dzr ) + if ( allocated (NoahmpIO%dzb) ) deallocate ( NoahmpIO%dzb ) + if ( allocated (NoahmpIO%dzg) ) deallocate ( NoahmpIO%dzg ) + endif + + if(NoahmpIO%sf_urban_physics == 2 .or. NoahmpIO%sf_urban_physics == 3) then ! bep or bem urban models + if ( allocated (NoahmpIO%trb_urb4d) ) deallocate ( NoahmpIO%trb_urb4d ) + if ( allocated (NoahmpIO%tw1_urb4d) ) deallocate ( NoahmpIO%tw1_urb4d ) + if ( allocated (NoahmpIO%tw2_urb4d) ) deallocate ( NoahmpIO%tw2_urb4d ) + if ( allocated (NoahmpIO%tgb_urb4d) ) deallocate ( NoahmpIO%tgb_urb4d ) + if ( allocated (NoahmpIO%sfw1_urb3d) ) deallocate ( NoahmpIO%sfw1_urb3d ) + if ( allocated (NoahmpIO%sfw2_urb3d) ) deallocate ( NoahmpIO%sfw2_urb3d ) + if ( allocated (NoahmpIO%sfr_urb3d) ) deallocate ( NoahmpIO%sfr_urb3d ) + if ( allocated (NoahmpIO%sfg_urb3d) ) deallocate ( NoahmpIO%sfg_urb3d ) + if ( allocated (NoahmpIO%hi_urb2d) ) deallocate ( NoahmpIO%hi_urb2d ) + if ( allocated (NoahmpIO%theta_urban)) deallocate ( NoahmpIO%theta_urban ) + if ( allocated (NoahmpIO%u_urban) ) deallocate ( NoahmpIO%u_urban ) + if ( allocated (NoahmpIO%v_urban) ) deallocate ( NoahmpIO%v_urban ) + if ( allocated (NoahmpIO%dz_urban) ) deallocate ( NoahmpIO%dz_urban ) + if ( allocated (NoahmpIO%rho_urban) ) deallocate ( NoahmpIO%rho_urban ) + if ( allocated (NoahmpIO%p_urban) ) deallocate ( NoahmpIO%p_urban ) + if ( allocated (NoahmpIO%a_u_bep) ) deallocate ( NoahmpIO%a_u_bep ) + if ( allocated (NoahmpIO%a_v_bep) ) deallocate ( NoahmpIO%a_v_bep ) + if ( allocated (NoahmpIO%a_t_bep) ) deallocate ( NoahmpIO%a_t_bep ) + if ( allocated (NoahmpIO%a_q_bep) ) deallocate ( NoahmpIO%a_q_bep ) + if ( allocated (NoahmpIO%a_e_bep) ) deallocate ( NoahmpIO%a_e_bep ) + if ( allocated (NoahmpIO%b_u_bep) ) deallocate ( NoahmpIO%b_u_bep ) + if ( allocated (NoahmpIO%b_v_bep) ) deallocate ( NoahmpIO%b_v_bep ) + if ( allocated (NoahmpIO%b_t_bep) ) deallocate ( NoahmpIO%b_t_bep ) + if ( allocated (NoahmpIO%b_q_bep) ) deallocate ( NoahmpIO%b_q_bep ) + if ( allocated (NoahmpIO%b_e_bep) ) deallocate ( NoahmpIO%b_e_bep ) + if ( allocated (NoahmpIO%dlg_bep) ) deallocate ( NoahmpIO%dlg_bep ) + if ( allocated (NoahmpIO%dl_u_bep) ) deallocate ( NoahmpIO%dl_u_bep ) + if ( allocated (NoahmpIO%sf_bep) ) deallocate ( NoahmpIO%sf_bep ) + if ( allocated (NoahmpIO%vl_bep) ) deallocate ( NoahmpIO%vl_bep ) + endif + + if(NoahmpIO%sf_urban_physics == 3) then ! bem urban model + if ( allocated (NoahmpIO%tlev_urb3d) ) deallocate ( NoahmpIO%tlev_urb3d ) + if ( allocated (NoahmpIO%qlev_urb3d) ) deallocate ( NoahmpIO%qlev_urb3d ) + if ( allocated (NoahmpIO%tw1lev_urb3d) ) deallocate ( NoahmpIO%tw1lev_urb3d ) + if ( allocated (NoahmpIO%tw2lev_urb3d) ) deallocate ( NoahmpIO%tw2lev_urb3d ) + if ( allocated (NoahmpIO%tglev_urb3d) ) deallocate ( NoahmpIO%tglev_urb3d ) + if ( allocated (NoahmpIO%tflev_urb3d) ) deallocate ( NoahmpIO%tflev_urb3d ) + if ( allocated (NoahmpIO%sf_ac_urb3d) ) deallocate ( NoahmpIO%sf_ac_urb3d ) + if ( allocated (NoahmpIO%lf_ac_urb3d) ) deallocate ( NoahmpIO%lf_ac_urb3d ) + if ( allocated (NoahmpIO%cm_ac_urb3d) ) deallocate ( NoahmpIO%cm_ac_urb3d ) + if ( allocated (NoahmpIO%sfvent_urb3d) ) deallocate ( NoahmpIO%sfvent_urb3d ) + if ( allocated (NoahmpIO%lfvent_urb3d) ) deallocate ( NoahmpIO%lfvent_urb3d ) + if ( allocated (NoahmpIO%sfwin1_urb3d) ) deallocate ( NoahmpIO%sfwin1_urb3d ) + if ( allocated (NoahmpIO%sfwin2_urb3d) ) deallocate ( NoahmpIO%sfwin2_urb3d ) + if ( allocated (NoahmpIO%ep_pv_urb3d) ) deallocate ( NoahmpIO%ep_pv_urb3d ) + if ( allocated (NoahmpIO%t_pv_urb3d) ) deallocate ( NoahmpIO%t_pv_urb3d ) + if ( allocated (NoahmpIO%trv_urb4d) ) deallocate ( NoahmpIO%trv_urb4d ) + if ( allocated (NoahmpIO%qr_urb4d) ) deallocate ( NoahmpIO%qr_urb4d ) + if ( allocated (NoahmpIO%qgr_urb3d) ) deallocate ( NoahmpIO%qgr_urb3d ) + if ( allocated (NoahmpIO%tgr_urb3d) ) deallocate ( NoahmpIO%tgr_urb3d ) + if ( allocated (NoahmpIO%drain_urb4d) ) deallocate ( NoahmpIO%drain_urb4d ) + if ( allocated (NoahmpIO%draingr_urb3d)) deallocate ( NoahmpIO%draingr_urb3d ) + if ( allocated (NoahmpIO%sfrv_urb3d) ) deallocate ( NoahmpIO%sfrv_urb3d ) + if ( allocated (NoahmpIO%lfrv_urb3d) ) deallocate ( NoahmpIO%lfrv_urb3d ) + if ( allocated (NoahmpIO%dgr_urb3d) ) deallocate ( NoahmpIO%dgr_urb3d ) + if ( allocated (NoahmpIO%dg_urb3d) ) deallocate ( NoahmpIO%dg_urb3d ) + if ( allocated (NoahmpIO%lfr_urb3d) ) deallocate ( NoahmpIO%lfr_urb3d ) + if ( allocated (NoahmpIO%lfg_urb3d) ) deallocate ( NoahmpIO%lfg_urb3d ) + + endif + +#ifdef WRF_HYDRO + if ( allocated (NoahmpIO%infxsrt) ) deallocate ( NoahmpIO%infxsrt ) + if ( allocated (NoahmpIO%sfcheadrt) ) deallocate ( NoahmpIO%sfcheadrt ) + if ( allocated (NoahmpIO%soldrain) ) deallocate ( NoahmpIO%soldrain ) + if ( allocated (NoahmpIO%qtiledrain)) deallocate ( NoahmpIO%qtiledrain ) + if ( allocated (NoahmpIO%zwatble2d) ) deallocate ( NoahmpIO%zwatble2d ) +#endif + + end associate + + end subroutine NoahmpIOVarFinalizeDefault + +end module NoahmpIOVarFinalizeMod diff --git a/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpIOVarInitMod.F90 b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpIOVarInitMod.F90 new file mode 100644 index 000000000..4f3c3f4f2 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpIOVarInitMod.F90 @@ -0,0 +1,854 @@ +module NoahmpIOVarInitMod + +!!! Initialize Noah-MP input/output variables +!!! Input/Output variables should be first defined in NoahmpIOVarType.F90 + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use Machine + use NoahmpIOVarType + + implicit none + +contains + +!=== initialize with default values + + subroutine NoahmpIOVarInitDefault(NoahmpIO) + + implicit none + + type(NoahmpIO_type), intent(inout) :: NoahmpIO + +! ------------------------------------------------- + associate( & + its => NoahmpIO%its ,& + ite => NoahmpIO%ite ,& + kts => NoahmpIO%kts ,& + kte => NoahmpIO%kte ,& + nsoil => NoahmpIO%nsoil ,& + nsnow => NoahmpIO%nsnow & + ) +! ------------------------------------------------- + + ! Input variables + if ( .not. allocated (NoahmpIO%coszen) ) allocate ( NoahmpIO%coszen (its:ite ) ) ! cosine zenith angle + if ( .not. allocated (NoahmpIO%xlat) ) allocate ( NoahmpIO%xlat (its:ite ) ) ! latitude [radians] + if ( .not. allocated (NoahmpIO%dzs) ) allocate ( NoahmpIO%dzs (1:nsoil ) ) ! thickness of soil layers [m] + if ( .not. allocated (NoahmpIO%zsoil) ) allocate ( NoahmpIO%zsoil (1:nsoil ) ) ! depth to soil interfaces [m] + if ( .not. allocated (NoahmpIO%ivgtyp) ) allocate ( NoahmpIO%ivgtyp (its:ite ) ) ! vegetation type + if ( .not. allocated (NoahmpIO%isltyp) ) allocate ( NoahmpIO%isltyp (its:ite ) ) ! soil type + if ( .not. allocated (NoahmpIO%vegfra) ) allocate ( NoahmpIO%vegfra (its:ite ) ) ! vegetation fraction [] + if ( .not. allocated (NoahmpIO%tmn) ) allocate ( NoahmpIO%tmn (its:ite ) ) ! deep soil temperature [K] + if ( .not. allocated (NoahmpIO%xland) ) allocate ( NoahmpIO%xland (its:ite ) ) ! =2 ocean; =1 land/seaice + if ( .not. allocated (NoahmpIO%xice) ) allocate ( NoahmpIO%xice (its:ite ) ) ! fraction of grid that is seaice + if ( .not. allocated (NoahmpIO%swdown) ) allocate ( NoahmpIO%swdown (its:ite ) ) ! solar down at surface [W m-2] + if ( .not. allocated (NoahmpIO%swddir) ) allocate ( NoahmpIO%swddir (its:ite ) ) ! solar down at surface [W m-2] for new urban solar panel + if ( .not. allocated (NoahmpIO%swddif) ) allocate ( NoahmpIO%swddif (its:ite ) ) ! solar down at surface [W m-2] for new urban solar panel + if ( .not. allocated (NoahmpIO%glw) ) allocate ( NoahmpIO%glw (its:ite ) ) ! longwave down at surface [W m-2] + if ( .not. allocated (NoahmpIO%rainbl) ) allocate ( NoahmpIO%rainbl (its:ite ) ) ! total precipitation entering land model [mm] per time step + if ( .not. allocated (NoahmpIO%snowbl) ) allocate ( NoahmpIO%snowbl (its:ite ) ) ! snow entering land model [mm] per time step + if ( .not. allocated (NoahmpIO%sr) ) allocate ( NoahmpIO%sr (its:ite ) ) ! frozen precip ratio entering land model [-] + if ( .not. allocated (NoahmpIO%raincv) ) allocate ( NoahmpIO%raincv (its:ite ) ) ! convective precip forcing [mm] + if ( .not. allocated (NoahmpIO%rainncv) ) allocate ( NoahmpIO%rainncv (its:ite ) ) ! non-convective precip forcing [mm] + if ( .not. allocated (NoahmpIO%rainshv) ) allocate ( NoahmpIO%rainshv (its:ite ) ) ! shallow conv. precip forcing [mm] + if ( .not. allocated (NoahmpIO%snowncv) ) allocate ( NoahmpIO%snowncv (its:ite ) ) ! non-covective snow forcing (subset of rainncv) [mm] + if ( .not. allocated (NoahmpIO%graupelncv)) allocate ( NoahmpIO%graupelncv (its:ite ) ) ! non-convective graupel forcing (subset of rainncv) [mm] + if ( .not. allocated (NoahmpIO%hailncv) ) allocate ( NoahmpIO%hailncv (its:ite ) ) ! non-convective hail forcing (subset of rainncv) [mm] + if ( .not. allocated (NoahmpIO%mp_rainc) ) allocate ( NoahmpIO%mp_rainc (its:ite ) ) ! convective precip forcing [mm] + if ( .not. allocated (NoahmpIO%mp_rainnc) ) allocate ( NoahmpIO%mp_rainnc (its:ite ) ) ! non-convective precip forcing [mm] + if ( .not. allocated (NoahmpIO%mp_shcv) ) allocate ( NoahmpIO%mp_shcv (its:ite ) ) ! shallow conv. precip forcing [mm] + if ( .not. allocated (NoahmpIO%mp_snow) ) allocate ( NoahmpIO%mp_snow (its:ite ) ) ! non-covective snow (subset of rainnc) [mm] + if ( .not. allocated (NoahmpIO%mp_graup) ) allocate ( NoahmpIO%mp_graup (its:ite ) ) ! non-convective graupel (subset of rainnc) [mm] + if ( .not. allocated (NoahmpIO%mp_hail) ) allocate ( NoahmpIO%mp_hail (its:ite ) ) ! non-convective hail (subset of rainnc) [mm] + if ( .not. allocated (NoahmpIO%seaice) ) allocate ( NoahmpIO%seaice (its:ite ) ) ! seaice fraction + if ( .not. allocated (NoahmpIO%dz8w) ) allocate ( NoahmpIO%dz8w (its:ite,kts:kte ) ) ! thickness of atmo layers [m] + if ( .not. allocated (NoahmpIO%t_phy) ) allocate ( NoahmpIO%t_phy (its:ite,kts:kte ) ) ! 3d atmospheric temperature valid at mid-levels [K] + if ( .not. allocated (NoahmpIO%qv_curr) ) allocate ( NoahmpIO%qv_curr (its:ite,kts:kte ) ) ! 3d water vapor mixing ratio [kg/kg_dry] + if ( .not. allocated (NoahmpIO%u_phy) ) allocate ( NoahmpIO%u_phy (its:ite,kts:kte ) ) ! 3d u wind component [m/s] + if ( .not. allocated (NoahmpIO%v_phy) ) allocate ( NoahmpIO%v_phy (its:ite,kts:kte ) ) ! 3d v wind component [m/s] + if ( .not. allocated (NoahmpIO%p8w) ) allocate ( NoahmpIO%p8w (its:ite,kts:kte ) ) ! 3d pressure, valid at interface [Pa] + + ! spatial varying parameter map + if ( NoahmpIO%iopt_soil > 1 ) then + if ( .not. allocated (NoahmpIO%soilcomp)) allocate ( NoahmpIO%soilcomp (its:ite,1:2*nsoil) ) ! soil sand and clay content [fraction] + if ( .not. allocated (NoahmpIO%soilcl1) ) allocate ( NoahmpIO%soilcl1 (its:ite ) ) ! soil texture class with depth + if ( .not. allocated (NoahmpIO%soilcl2) ) allocate ( NoahmpIO%soilcl2 (its:ite ) ) ! soil texture class with depth + if ( .not. allocated (NoahmpIO%soilcl3) ) allocate ( NoahmpIO%soilcl3 (its:ite ) ) ! soil texture class with depth + if ( .not. allocated (NoahmpIO%soilcl4) ) allocate ( NoahmpIO%soilcl4 (its:ite ) ) ! soil texture class with depth + endif + if ( NoahmpIO%iopt_soil == 4 ) then + if ( .not. allocated (NoahmpIO%bexp_3d) ) allocate ( NoahmpIO%bexp_3d (its:ite,1:nsoil) ) ! c-h b exponent + if ( .not. allocated (NoahmpIO%smcdry_3d) ) allocate ( NoahmpIO%smcdry_3d (its:ite,1:nsoil) ) ! soil moisture limit: dry + if ( .not. allocated (NoahmpIO%smcwlt_3d) ) allocate ( NoahmpIO%smcwlt_3d (its:ite,1:nsoil) ) ! soil moisture limit: wilt + if ( .not. allocated (NoahmpIO%smcref_3d) ) allocate ( NoahmpIO%smcref_3d (its:ite,1:nsoil) ) ! soil moisture limit: reference + if ( .not. allocated (NoahmpIO%smcmax_3d) ) allocate ( NoahmpIO%smcmax_3d (its:ite,1:nsoil) ) ! soil moisture limit: max + if ( .not. allocated (NoahmpIO%dksat_3d) ) allocate ( NoahmpIO%dksat_3d (its:ite,1:nsoil) ) ! saturated soil conductivity + if ( .not. allocated (NoahmpIO%dwsat_3d) ) allocate ( NoahmpIO%dwsat_3d (its:ite,1:nsoil) ) ! saturated soil diffusivity + if ( .not. allocated (NoahmpIO%psisat_3d) ) allocate ( NoahmpIO%psisat_3d (its:ite,1:nsoil) ) ! saturated matric potential + if ( .not. allocated (NoahmpIO%quartz_3d) ) allocate ( NoahmpIO%quartz_3d (its:ite,1:nsoil) ) ! soil quartz content + if ( .not. allocated (NoahmpIO%refdk_2d) ) allocate ( NoahmpIO%refdk_2d (its:ite ) ) ! reference soil conductivity + if ( .not. allocated (NoahmpIO%refkdt_2d) ) allocate ( NoahmpIO%refkdt_2d (its:ite ) ) ! soil infiltration parameter + if ( .not. allocated (NoahmpIO%irr_frac_2d) ) allocate ( NoahmpIO%irr_frac_2d (its:ite ) ) ! irrigation fraction + if ( .not. allocated (NoahmpIO%irr_har_2d) ) allocate ( NoahmpIO%irr_har_2d (its:ite ) ) ! number of days before harvest date to stop irrigation + if ( .not. allocated (NoahmpIO%irr_lai_2d) ) allocate ( NoahmpIO%irr_lai_2d (its:ite ) ) ! minimum lai to trigger irrigation + if ( .not. allocated (NoahmpIO%irr_mad_2d) ) allocate ( NoahmpIO%irr_mad_2d (its:ite ) ) ! management allowable deficit (0-1) + if ( .not. allocated (NoahmpIO%filoss_2d) ) allocate ( NoahmpIO%filoss_2d (its:ite ) ) ! fraction of flood irrigation loss (0-1) + if ( .not. allocated (NoahmpIO%sprir_rate_2d)) allocate ( NoahmpIO%sprir_rate_2d (its:ite ) ) ! mm/h, sprinkler irrigation rate + if ( .not. allocated (NoahmpIO%micir_rate_2d)) allocate ( NoahmpIO%micir_rate_2d (its:ite ) ) ! mm/h, micro irrigation rate + if ( .not. allocated (NoahmpIO%firtfac_2d) ) allocate ( NoahmpIO%firtfac_2d (its:ite ) ) ! flood application rate factor + if ( .not. allocated (NoahmpIO%ir_rain_2d) ) allocate ( NoahmpIO%ir_rain_2d (its:ite ) ) ! maximum precipitation to stop irrigation trigger + if ( .not. allocated (NoahmpIO%bvic_2d) ) allocate ( NoahmpIO%bvic_2d (its:ite ) ) ! VIC model infiltration parameter [-] + if ( .not. allocated (NoahmpIO%axaj_2d) ) allocate ( NoahmpIO%axaj_2d (its:ite ) ) ! tension water distribution inflection parameter [-] + if ( .not. allocated (NoahmpIO%bxaj_2d) ) allocate ( NoahmpIO%bxaj_2d (its:ite ) ) ! tension water distribution shape parameter [-] + if ( .not. allocated (NoahmpIO%xxaj_2d) ) allocate ( NoahmpIO%xxaj_2d (its:ite ) ) ! free water distribution shape parameter [-] + if ( .not. allocated (NoahmpIO%bdvic_2d) ) allocate ( NoahmpIO%bdvic_2d (its:ite ) ) ! DVIC model infiltration parameter [-] + if ( .not. allocated (NoahmpIO%gdvic_2d) ) allocate ( NoahmpIO%gdvic_2d (its:ite ) ) ! mean capillary drive (m) for infiltration models + if ( .not. allocated (NoahmpIO%bbvic_2d) ) allocate ( NoahmpIO%bbvic_2d (its:ite ) ) ! dvic heterogeniety parameter for infiltration [-] + if ( .not. allocated (NoahmpIO%klat_fac) ) allocate ( NoahmpIO%klat_fac (its:ite ) ) ! factor multiplier to hydraulic conductivity + if ( .not. allocated (NoahmpIO%tdsmc_fac) ) allocate ( NoahmpIO%tdsmc_fac (its:ite ) ) ! factor multiplier to field capacity + if ( .not. allocated (NoahmpIO%td_dc) ) allocate ( NoahmpIO%td_dc (its:ite ) ) ! drainage coefficient for simple + if ( .not. allocated (NoahmpIO%td_dcoef) ) allocate ( NoahmpIO%td_dcoef (its:ite ) ) ! drainage coefficient for Hooghoudt + if ( .not. allocated (NoahmpIO%td_ddrain) ) allocate ( NoahmpIO%td_ddrain (its:ite ) ) ! depth of drain + if ( .not. allocated (NoahmpIO%td_radi) ) allocate ( NoahmpIO%td_radi (its:ite ) ) ! tile radius + if ( .not. allocated (NoahmpIO%td_spac) ) allocate ( NoahmpIO%td_spac (its:ite ) ) ! tile spacing + endif + + ! INOUT (with generic LSM equivalent) (as defined in WRF) + if ( .not. allocated (NoahmpIO%tsk) ) allocate ( NoahmpIO%tsk (its:ite ) ) ! surface radiative temperature [K] + if ( .not. allocated (NoahmpIO%hfx) ) allocate ( NoahmpIO%hfx (its:ite ) ) ! sensible heat flux [W m-2] + if ( .not. allocated (NoahmpIO%qfx) ) allocate ( NoahmpIO%qfx (its:ite ) ) ! latent heat flux [kg s-1 m-2] + if ( .not. allocated (NoahmpIO%lh) ) allocate ( NoahmpIO%lh (its:ite ) ) ! latent heat flux [W m-2] + if ( .not. allocated (NoahmpIO%grdflx) ) allocate ( NoahmpIO%grdflx (its:ite ) ) ! ground/snow heat flux [W m-2] + if ( .not. allocated (NoahmpIO%smstav) ) allocate ( NoahmpIO%smstav (its:ite ) ) ! soil moisture avail. [not used] + if ( .not. allocated (NoahmpIO%smstot) ) allocate ( NoahmpIO%smstot (its:ite ) ) ! total soil water [mm][not used] + if ( .not. allocated (NoahmpIO%sfcrunoff)) allocate ( NoahmpIO%sfcrunoff (its:ite ) ) ! accumulated surface runoff [m] + if ( .not. allocated (NoahmpIO%udrunoff) ) allocate ( NoahmpIO%udrunoff (its:ite ) ) ! accumulated sub-surface runoff [m] + if ( .not. allocated (NoahmpIO%albedo) ) allocate ( NoahmpIO%albedo (its:ite ) ) ! total grid albedo [] + if ( .not. allocated (NoahmpIO%snowc) ) allocate ( NoahmpIO%snowc (its:ite ) ) ! snow cover fraction [] + if ( .not. allocated (NoahmpIO%snow) ) allocate ( NoahmpIO%snow (its:ite ) ) ! snow water equivalent [mm] + if ( .not. allocated (NoahmpIO%snowh) ) allocate ( NoahmpIO%snowh (its:ite ) ) ! physical snow depth [m] + if ( .not. allocated (NoahmpIO%canwat) ) allocate ( NoahmpIO%canwat (its:ite ) ) ! total canopy water + ice [mm] + if ( .not. allocated (NoahmpIO%acsnom) ) allocate ( NoahmpIO%acsnom (its:ite ) ) ! accumulated snow melt leaving pack + if ( .not. allocated (NoahmpIO%acsnow) ) allocate ( NoahmpIO%acsnow (its:ite ) ) ! accumulated snow on grid + if ( .not. allocated (NoahmpIO%emiss) ) allocate ( NoahmpIO%emiss (its:ite ) ) ! surface bulk emissivity + if ( .not. allocated (NoahmpIO%qsfc) ) allocate ( NoahmpIO%qsfc (its:ite ) ) ! bulk surface specific humidity + if ( .not. allocated (NoahmpIO%smoiseq) ) allocate ( NoahmpIO%smoiseq (its:ite,1:nsoil) ) ! equilibrium volumetric soil moisture [m3/m3] + if ( .not. allocated (NoahmpIO%smois) ) allocate ( NoahmpIO%smois (its:ite,1:nsoil) ) ! volumetric soil moisture [m3/m3] + if ( .not. allocated (NoahmpIO%sh2o) ) allocate ( NoahmpIO%sh2o (its:ite,1:nsoil) ) ! volumetric liquid soil moisture [m3/m3] + if ( .not. allocated (NoahmpIO%tslb) ) allocate ( NoahmpIO%tslb (its:ite,1:nsoil) ) ! soil temperature [K] + + ! INOUT (with no Noah LSM equivalent) (as defined in WRF) + if ( .not. allocated (NoahmpIO%isnowxy) ) allocate ( NoahmpIO%isnowxy (its:ite ) ) ! actual no. of snow layers + if ( .not. allocated (NoahmpIO%tvxy) ) allocate ( NoahmpIO%tvxy (its:ite ) ) ! vegetation leaf temperature + if ( .not. allocated (NoahmpIO%tgxy) ) allocate ( NoahmpIO%tgxy (its:ite ) ) ! bulk ground surface temperature + if ( .not. allocated (NoahmpIO%canicexy) ) allocate ( NoahmpIO%canicexy (its:ite ) ) ! canopy-intercepted ice (mm) + if ( .not. allocated (NoahmpIO%canliqxy) ) allocate ( NoahmpIO%canliqxy (its:ite ) ) ! canopy-intercepted liquid water (mm) + if ( .not. allocated (NoahmpIO%eahxy) ) allocate ( NoahmpIO%eahxy (its:ite ) ) ! canopy air vapor pressure (Pa) + if ( .not. allocated (NoahmpIO%tahxy) ) allocate ( NoahmpIO%tahxy (its:ite ) ) ! canopy air temperature (K) + if ( .not. allocated (NoahmpIO%cmxy) ) allocate ( NoahmpIO%cmxy (its:ite ) ) ! bulk momentum drag coefficient + if ( .not. allocated (NoahmpIO%chxy) ) allocate ( NoahmpIO%chxy (its:ite ) ) ! bulk sensible heat exchange coefficient + if ( .not. allocated (NoahmpIO%fwetxy) ) allocate ( NoahmpIO%fwetxy (its:ite ) ) ! wetted or snowed fraction of the canopy (-) + if ( .not. allocated (NoahmpIO%sneqvoxy) ) allocate ( NoahmpIO%sneqvoxy (its:ite ) ) ! snow mass at last time step(mm H2O) + if ( .not. allocated (NoahmpIO%alboldxy) ) allocate ( NoahmpIO%alboldxy (its:ite ) ) ! snow albedo at last time step (-) + if ( .not. allocated (NoahmpIO%qsnowxy) ) allocate ( NoahmpIO%qsnowxy (its:ite ) ) ! snowfall on the ground [mm/s] + if ( .not. allocated (NoahmpIO%qrainxy) ) allocate ( NoahmpIO%qrainxy (its:ite ) ) ! rainfall on the ground [mm/s] + if ( .not. allocated (NoahmpIO%wslakexy) ) allocate ( NoahmpIO%wslakexy (its:ite ) ) ! lake water storage [mm] + if ( .not. allocated (NoahmpIO%zwtxy) ) allocate ( NoahmpIO%zwtxy (its:ite ) ) ! water table depth [m] + if ( .not. allocated (NoahmpIO%waxy) ) allocate ( NoahmpIO%waxy (its:ite ) ) ! water in the "aquifer" [mm] + if ( .not. allocated (NoahmpIO%wtxy) ) allocate ( NoahmpIO%wtxy (its:ite ) ) ! groundwater storage [mm] + if ( .not. allocated (NoahmpIO%smcwtdxy) ) allocate ( NoahmpIO%smcwtdxy (its:ite ) ) ! soil moisture below the bottom of the column (m3 m-3) + if ( .not. allocated (NoahmpIO%deeprechxy)) allocate ( NoahmpIO%deeprechxy (its:ite ) ) ! recharge to the water table when deep (m) + if ( .not. allocated (NoahmpIO%rechxy) ) allocate ( NoahmpIO%rechxy (its:ite ) ) ! recharge to the water table (diagnostic) (m) + if ( .not. allocated (NoahmpIO%lfmassxy) ) allocate ( NoahmpIO%lfmassxy (its:ite ) ) ! leaf mass [g/m2] + if ( .not. allocated (NoahmpIO%rtmassxy) ) allocate ( NoahmpIO%rtmassxy (its:ite ) ) ! mass of fine roots [g/m2] + if ( .not. allocated (NoahmpIO%stmassxy) ) allocate ( NoahmpIO%stmassxy (its:ite ) ) ! stem mass [g/m2] + if ( .not. allocated (NoahmpIO%woodxy) ) allocate ( NoahmpIO%woodxy (its:ite ) ) ! mass of wood (incl. woody roots) [g/m2] + if ( .not. allocated (NoahmpIO%grainxy) ) allocate ( NoahmpIO%grainxy (its:ite ) ) ! mass of grain xing [g/m2] + if ( .not. allocated (NoahmpIO%gddxy) ) allocate ( NoahmpIO%gddxy (its:ite ) ) ! growing degree days xing four + if ( .not. allocated (NoahmpIO%stblcpxy) ) allocate ( NoahmpIO%stblcpxy (its:ite ) ) ! stable carbon in deep soil [g/m2] + if ( .not. allocated (NoahmpIO%fastcpxy) ) allocate ( NoahmpIO%fastcpxy (its:ite ) ) ! short-lived carbon, shallow soil [g/m2] + if ( .not. allocated (NoahmpIO%lai) ) allocate ( NoahmpIO%lai (its:ite ) ) ! leaf area index + if ( .not. allocated (NoahmpIO%xsaixy) ) allocate ( NoahmpIO%xsaixy (its:ite ) ) ! stem area index + if ( .not. allocated (NoahmpIO%taussxy) ) allocate ( NoahmpIO%taussxy (its:ite ) ) ! snow age factor + if ( .not. allocated (NoahmpIO%tsnoxy) ) allocate ( NoahmpIO%tsnoxy (its:ite,-nsnow+1:0 ) ) ! snow temperature [K] + if ( .not. allocated (NoahmpIO%zsnsoxy) ) allocate ( NoahmpIO%zsnsoxy (its:ite,-nsnow+1:nsoil) ) ! snow layer depth [m] + if ( .not. allocated (NoahmpIO%snicexy) ) allocate ( NoahmpIO%snicexy (its:ite,-nsnow+1:0 ) ) ! snow layer ice [mm] + if ( .not. allocated (NoahmpIO%snliqxy) ) allocate ( NoahmpIO%snliqxy (its:ite,-nsnow+1:0 ) ) ! snow layer liquid water [mm] + + ! irrigation + if ( .not. allocated (NoahmpIO%irfract) ) allocate ( NoahmpIO%irfract (its:ite) ) ! irrigation fraction + if ( .not. allocated (NoahmpIO%sifract) ) allocate ( NoahmpIO%sifract (its:ite) ) ! sprinkler irrigation fraction + if ( .not. allocated (NoahmpIO%mifract) ) allocate ( NoahmpIO%mifract (its:ite) ) ! micro irrigation fraction + if ( .not. allocated (NoahmpIO%fifract) ) allocate ( NoahmpIO%fifract (its:ite) ) ! flood irrigation fraction + if ( .not. allocated (NoahmpIO%irnumsi) ) allocate ( NoahmpIO%irnumsi (its:ite) ) ! irrigation event number, sprinkler + if ( .not. allocated (NoahmpIO%irnummi) ) allocate ( NoahmpIO%irnummi (its:ite) ) ! irrigation event number, micro + if ( .not. allocated (NoahmpIO%irnumfi) ) allocate ( NoahmpIO%irnumfi (its:ite) ) ! irrigation event number, flood + if ( .not. allocated (NoahmpIO%irwatsi) ) allocate ( NoahmpIO%irwatsi (its:ite) ) ! irrigation water amount [m] to be applied, sprinkler + if ( .not. allocated (NoahmpIO%irwatmi) ) allocate ( NoahmpIO%irwatmi (its:ite) ) ! irrigation water amount [m] to be applied, micro + if ( .not. allocated (NoahmpIO%irwatfi) ) allocate ( NoahmpIO%irwatfi (its:ite) ) ! irrigation water amount [m] to be applied, flood + if ( .not. allocated (NoahmpIO%ireloss) ) allocate ( NoahmpIO%ireloss (its:ite) ) ! loss of irrigation water to evaporation,sprinkler [mm] + if ( .not. allocated (NoahmpIO%irsivol) ) allocate ( NoahmpIO%irsivol (its:ite) ) ! amount of irrigation by sprinkler (mm) + if ( .not. allocated (NoahmpIO%irmivol) ) allocate ( NoahmpIO%irmivol (its:ite) ) ! amount of irrigation by micro (mm) + if ( .not. allocated (NoahmpIO%irfivol) ) allocate ( NoahmpIO%irfivol (its:ite) ) ! amount of irrigation by micro (mm) + if ( .not. allocated (NoahmpIO%irrsplh) ) allocate ( NoahmpIO%irrsplh (its:ite) ) ! latent heating from sprinkler evaporation (W/m2) + if ( .not. allocated (NoahmpIO%loctim) ) allocate ( NoahmpIO%loctim (its:ite) ) ! local time + + ! OUT (with no Noah LSM equivalent) (as defined in WRF) + if ( .not. allocated (NoahmpIO%t2mvxy) ) allocate ( NoahmpIO%t2mvxy (its:ite) ) ! 2m temperature of vegetation part + if ( .not. allocated (NoahmpIO%t2mbxy) ) allocate ( NoahmpIO%t2mbxy (its:ite) ) ! 2m temperature of bare ground part + if ( .not. allocated (NoahmpIO%t2mxy) ) allocate ( NoahmpIO%t2mxy (its:ite) ) ! 2m grid-mean temperature + if ( .not. allocated (NoahmpIO%q2mvxy) ) allocate ( NoahmpIO%q2mvxy (its:ite) ) ! 2m mixing ratio of vegetation part + if ( .not. allocated (NoahmpIO%q2mbxy) ) allocate ( NoahmpIO%q2mbxy (its:ite) ) ! 2m mixing ratio of bare ground part + if ( .not. allocated (NoahmpIO%q2mxy) ) allocate ( NoahmpIO%q2mxy (its:ite) ) ! 2m grid-mean mixing ratio + if ( .not. allocated (NoahmpIO%tradxy) ) allocate ( NoahmpIO%tradxy (its:ite) ) ! surface radiative temperature (K) + if ( .not. allocated (NoahmpIO%neexy) ) allocate ( NoahmpIO%neexy (its:ite) ) ! net ecosys exchange (g/m2/s CO2) + if ( .not. allocated (NoahmpIO%gppxy) ) allocate ( NoahmpIO%gppxy (its:ite) ) ! gross primary assimilation [g/m2/s C] + if ( .not. allocated (NoahmpIO%nppxy) ) allocate ( NoahmpIO%nppxy (its:ite) ) ! net primary productivity [g/m2/s C] + if ( .not. allocated (NoahmpIO%fvegxy) ) allocate ( NoahmpIO%fvegxy (its:ite) ) ! noah-mp vegetation fraction [-] + if ( .not. allocated (NoahmpIO%runsfxy) ) allocate ( NoahmpIO%runsfxy (its:ite) ) ! surface runoff [mm per soil timestep] + if ( .not. allocated (NoahmpIO%runsbxy) ) allocate ( NoahmpIO%runsbxy (its:ite) ) ! subsurface runoff [mm per soil timestep] + if ( .not. allocated (NoahmpIO%ecanxy) ) allocate ( NoahmpIO%ecanxy (its:ite) ) ! evaporation of intercepted water (mm/s) + if ( .not. allocated (NoahmpIO%edirxy) ) allocate ( NoahmpIO%edirxy (its:ite) ) ! soil surface evaporation rate (mm/s] + if ( .not. allocated (NoahmpIO%etranxy) ) allocate ( NoahmpIO%etranxy (its:ite) ) ! transpiration rate (mm/s) + if ( .not. allocated (NoahmpIO%fsaxy) ) allocate ( NoahmpIO%fsaxy (its:ite) ) ! total absorbed solar radiation (W/m2) + if ( .not. allocated (NoahmpIO%firaxy) ) allocate ( NoahmpIO%firaxy (its:ite) ) ! total net longwave rad (W/m2) [+ to atm] + if ( .not. allocated (NoahmpIO%aparxy) ) allocate ( NoahmpIO%aparxy (its:ite) ) ! photosyn active energy by canopy (W/m2) + if ( .not. allocated (NoahmpIO%psnxy) ) allocate ( NoahmpIO%psnxy (its:ite) ) ! total photosynthesis (umol CO2/m2/s) [+] + if ( .not. allocated (NoahmpIO%savxy) ) allocate ( NoahmpIO%savxy (its:ite) ) ! solar rad absorbed by veg. (W/m2) + if ( .not. allocated (NoahmpIO%sagxy) ) allocate ( NoahmpIO%sagxy (its:ite) ) ! solar rad absorbed by ground (W/m2) + if ( .not. allocated (NoahmpIO%rssunxy) ) allocate ( NoahmpIO%rssunxy (its:ite) ) ! sunlit leaf stomatal resistance (s/m) + if ( .not. allocated (NoahmpIO%rsshaxy) ) allocate ( NoahmpIO%rsshaxy (its:ite) ) ! shaded leaf stomatal resistance (s/m) + if ( .not. allocated (NoahmpIO%bgapxy) ) allocate ( NoahmpIO%bgapxy (its:ite) ) ! between gap fraction + if ( .not. allocated (NoahmpIO%wgapxy) ) allocate ( NoahmpIO%wgapxy (its:ite) ) ! within gap fraction + if ( .not. allocated (NoahmpIO%tgvxy) ) allocate ( NoahmpIO%tgvxy (its:ite) ) ! under canopy ground temperature[K] + if ( .not. allocated (NoahmpIO%tgbxy) ) allocate ( NoahmpIO%tgbxy (its:ite) ) ! bare ground temperature [K] + if ( .not. allocated (NoahmpIO%chvxy) ) allocate ( NoahmpIO%chvxy (its:ite) ) ! sensible heat exchange coefficient vegetated + if ( .not. allocated (NoahmpIO%chbxy) ) allocate ( NoahmpIO%chbxy (its:ite) ) ! sensible heat exchange coefficient bare-ground + if ( .not. allocated (NoahmpIO%shgxy) ) allocate ( NoahmpIO%shgxy (its:ite) ) ! veg ground sen. heat [W/m2] [+ to atm] + if ( .not. allocated (NoahmpIO%shcxy) ) allocate ( NoahmpIO%shcxy (its:ite) ) ! canopy sen. heat [W/m2] [+ to atm] + if ( .not. allocated (NoahmpIO%shbxy) ) allocate ( NoahmpIO%shbxy (its:ite) ) ! bare sensible heat [W/m2] [+ to atm] + if ( .not. allocated (NoahmpIO%evgxy) ) allocate ( NoahmpIO%evgxy (its:ite) ) ! veg ground evap. heat [W/m2] [+ to atm] + if ( .not. allocated (NoahmpIO%evbxy) ) allocate ( NoahmpIO%evbxy (its:ite) ) ! bare soil evaporation [W/m2] [+ to atm] + if ( .not. allocated (NoahmpIO%ghvxy) ) allocate ( NoahmpIO%ghvxy (its:ite) ) ! veg ground heat flux [W/m2] [+ to soil] + if ( .not. allocated (NoahmpIO%ghbxy) ) allocate ( NoahmpIO%ghbxy (its:ite) ) ! bare ground heat flux [W/m2] [+ to soil] + if ( .not. allocated (NoahmpIO%irgxy) ) allocate ( NoahmpIO%irgxy (its:ite) ) ! veg ground net lw rad. [W/m2] [+ to atm] + if ( .not. allocated (NoahmpIO%ircxy) ) allocate ( NoahmpIO%ircxy (its:ite) ) ! canopy net lw rad. [W/m2] [+ to atm] + if ( .not. allocated (NoahmpIO%irbxy) ) allocate ( NoahmpIO%irbxy (its:ite) ) ! bare net longwave rad. [W/m2] [+ to atm] + if ( .not. allocated (NoahmpIO%trxy) ) allocate ( NoahmpIO%trxy (its:ite) ) ! transpiration [w/m2] [+ to atm] + if ( .not. allocated (NoahmpIO%evcxy) ) allocate ( NoahmpIO%evcxy (its:ite) ) ! canopy evaporation heat [W/m2] [+ to atm] + if ( .not. allocated (NoahmpIO%chleafxy) ) allocate ( NoahmpIO%chleafxy (its:ite) ) ! leaf exchange coefficient + if ( .not. allocated (NoahmpIO%chucxy) ) allocate ( NoahmpIO%chucxy (its:ite) ) ! under canopy exchange coefficient + if ( .not. allocated (NoahmpIO%chv2xy) ) allocate ( NoahmpIO%chv2xy (its:ite) ) ! veg 2m exchange coefficient + if ( .not. allocated (NoahmpIO%chb2xy) ) allocate ( NoahmpIO%chb2xy (its:ite) ) ! bare 2m exchange coefficient + if ( .not. allocated (NoahmpIO%rs) ) allocate ( NoahmpIO%rs (its:ite) ) ! total stomatal resistance (s/m) + if ( .not. allocated (NoahmpIO%z0) ) allocate ( NoahmpIO%z0 (its:ite) ) ! roughness length output to WRF + if ( .not. allocated (NoahmpIO%znt) ) allocate ( NoahmpIO%znt (its:ite) ) ! roughness length output to WRF + if ( .not. allocated (NoahmpIO%qtdrain) ) allocate ( NoahmpIO%qtdrain (its:ite) ) ! tile drainage (mm) + if ( .not. allocated (NoahmpIO%td_fraction)) allocate ( NoahmpIO%td_fraction (its:ite) ) ! tile drainage fraction + if ( .not. allocated (NoahmpIO%xlong) ) allocate ( NoahmpIO%xlong (its:ite) ) ! longitude + if ( .not. allocated (NoahmpIO%terrain) ) allocate ( NoahmpIO%terrain (its:ite) ) ! terrain height + if ( .not. allocated (NoahmpIO%gvfmin) ) allocate ( NoahmpIO%gvfmin (its:ite) ) ! annual minimum in vegetation fraction + if ( .not. allocated (NoahmpIO%gvfmax) ) allocate ( NoahmpIO%gvfmax (its:ite) ) ! annual maximum in vegetation fraction + + ! additional output variables + if ( .not. allocated (NoahmpIO%pahxy) ) allocate ( NoahmpIO%pahxy (its:ite) ) + if ( .not. allocated (NoahmpIO%pahgxy) ) allocate ( NoahmpIO%pahgxy (its:ite) ) + if ( .not. allocated (NoahmpIO%pahbxy) ) allocate ( NoahmpIO%pahbxy (its:ite) ) + if ( .not. allocated (NoahmpIO%pahvxy) ) allocate ( NoahmpIO%pahvxy (its:ite) ) + if ( .not. allocated (NoahmpIO%qintsxy) ) allocate ( NoahmpIO%qintsxy (its:ite) ) + if ( .not. allocated (NoahmpIO%qintrxy) ) allocate ( NoahmpIO%qintrxy (its:ite) ) + if ( .not. allocated (NoahmpIO%qdripsxy) ) allocate ( NoahmpIO%qdripsxy (its:ite) ) + if ( .not. allocated (NoahmpIO%qdriprxy) ) allocate ( NoahmpIO%qdriprxy (its:ite) ) + if ( .not. allocated (NoahmpIO%qthrosxy) ) allocate ( NoahmpIO%qthrosxy (its:ite) ) + if ( .not. allocated (NoahmpIO%qthrorxy) ) allocate ( NoahmpIO%qthrorxy (its:ite) ) + if ( .not. allocated (NoahmpIO%qsnsubxy) ) allocate ( NoahmpIO%qsnsubxy (its:ite) ) + if ( .not. allocated (NoahmpIO%qsnfroxy) ) allocate ( NoahmpIO%qsnfroxy (its:ite) ) + if ( .not. allocated (NoahmpIO%qsubcxy) ) allocate ( NoahmpIO%qsubcxy (its:ite) ) + if ( .not. allocated (NoahmpIO%qfrocxy) ) allocate ( NoahmpIO%qfrocxy (its:ite) ) + if ( .not. allocated (NoahmpIO%qevacxy) ) allocate ( NoahmpIO%qevacxy (its:ite) ) + if ( .not. allocated (NoahmpIO%qdewcxy) ) allocate ( NoahmpIO%qdewcxy (its:ite) ) + if ( .not. allocated (NoahmpIO%qfrzcxy) ) allocate ( NoahmpIO%qfrzcxy (its:ite) ) + if ( .not. allocated (NoahmpIO%qmeltcxy) ) allocate ( NoahmpIO%qmeltcxy (its:ite) ) + if ( .not. allocated (NoahmpIO%qsnbotxy) ) allocate ( NoahmpIO%qsnbotxy (its:ite) ) + if ( .not. allocated (NoahmpIO%qmeltxy) ) allocate ( NoahmpIO%qmeltxy (its:ite) ) + if ( .not. allocated (NoahmpIO%pondingxy) ) allocate ( NoahmpIO%pondingxy (its:ite) ) + if ( .not. allocated (NoahmpIO%fpicexy) ) allocate ( NoahmpIO%fpicexy (its:ite) ) + if ( .not. allocated (NoahmpIO%rainlsm) ) allocate ( NoahmpIO%rainlsm (its:ite) ) + if ( .not. allocated (NoahmpIO%snowlsm) ) allocate ( NoahmpIO%snowlsm (its:ite) ) + if ( .not. allocated (NoahmpIO%forctlsm) ) allocate ( NoahmpIO%forctlsm (its:ite) ) + if ( .not. allocated (NoahmpIO%forcqlsm) ) allocate ( NoahmpIO%forcqlsm (its:ite) ) + if ( .not. allocated (NoahmpIO%forcplsm) ) allocate ( NoahmpIO%forcplsm (its:ite) ) + if ( .not. allocated (NoahmpIO%forczlsm) ) allocate ( NoahmpIO%forczlsm (its:ite) ) + if ( .not. allocated (NoahmpIO%forcwlsm) ) allocate ( NoahmpIO%forcwlsm (its:ite) ) + if ( .not. allocated (NoahmpIO%eflxbxy) ) allocate ( NoahmpIO%eflxbxy (its:ite) ) + if ( .not. allocated (NoahmpIO%soilenergy) ) allocate ( NoahmpIO%soilenergy (its:ite) ) + if ( .not. allocated (NoahmpIO%snowenergy) ) allocate ( NoahmpIO%snowenergy (its:ite) ) + if ( .not. allocated (NoahmpIO%canhsxy) ) allocate ( NoahmpIO%canhsxy (its:ite) ) + if ( .not. allocated (NoahmpIO%acc_dwaterxy)) allocate ( NoahmpIO%acc_dwaterxy (its:ite) ) + if ( .not. allocated (NoahmpIO%acc_prcpxy) ) allocate ( NoahmpIO%acc_prcpxy (its:ite) ) + if ( .not. allocated (NoahmpIO%acc_ecanxy) ) allocate ( NoahmpIO%acc_ecanxy (its:ite) ) + if ( .not. allocated (NoahmpIO%acc_etranxy) ) allocate ( NoahmpIO%acc_etranxy (its:ite) ) + if ( .not. allocated (NoahmpIO%acc_edirxy) ) allocate ( NoahmpIO%acc_edirxy (its:ite) ) + if ( .not. allocated (NoahmpIO%acc_ssoilxy) ) allocate ( NoahmpIO%acc_ssoilxy (its:ite) ) + if ( .not. allocated (NoahmpIO%acc_qinsurxy)) allocate ( NoahmpIO%acc_qinsurxy (its:ite) ) + if ( .not. allocated (NoahmpIO%acc_qsevaxy) ) allocate ( NoahmpIO%acc_qsevaxy (its:ite) ) + if ( .not. allocated (NoahmpIO%acc_etranixy)) allocate ( NoahmpIO%acc_etranixy (its:ite,1:nsoil) ) + + ! needed for mmf_runoff (iopt_run = 5); not part of mp driver in WRF + if ( .not. allocated (NoahmpIO%msftx) ) allocate ( NoahmpIO%msftx (its:ite) ) + if ( .not. allocated (NoahmpIO%msfty) ) allocate ( NoahmpIO%msfty (its:ite) ) + if ( .not. allocated (NoahmpIO%eqzwt) ) allocate ( NoahmpIO%eqzwt (its:ite) ) + if ( .not. allocated (NoahmpIO%riverbedxy) ) allocate ( NoahmpIO%riverbedxy (its:ite) ) + if ( .not. allocated (NoahmpIO%rivercondxy)) allocate ( NoahmpIO%rivercondxy (its:ite) ) + if ( .not. allocated (NoahmpIO%pexpxy) ) allocate ( NoahmpIO%pexpxy (its:ite) ) + if ( .not. allocated (NoahmpIO%fdepthxy) ) allocate ( NoahmpIO%fdepthxy (its:ite) ) + if ( .not. allocated (NoahmpIO%areaxy) ) allocate ( NoahmpIO%areaxy (its:ite) ) + if ( .not. allocated (NoahmpIO%qrfsxy) ) allocate ( NoahmpIO%qrfsxy (its:ite) ) + if ( .not. allocated (NoahmpIO%qspringsxy) ) allocate ( NoahmpIO%qspringsxy (its:ite) ) + if ( .not. allocated (NoahmpIO%qrfxy) ) allocate ( NoahmpIO%qrfxy (its:ite) ) + if ( .not. allocated (NoahmpIO%qspringxy) ) allocate ( NoahmpIO%qspringxy (its:ite) ) + if ( .not. allocated (NoahmpIO%qslatxy) ) allocate ( NoahmpIO%qslatxy (its:ite) ) + if ( .not. allocated (NoahmpIO%qlatxy) ) allocate ( NoahmpIO%qlatxy (its:ite) ) + if ( .not. allocated (NoahmpIO%rechclim) ) allocate ( NoahmpIO%rechclim (its:ite) ) + if ( .not. allocated (NoahmpIO%rivermask) ) allocate ( NoahmpIO%rivermask (its:ite) ) + if ( .not. allocated (NoahmpIO%nonriverxy) ) allocate ( NoahmpIO%nonriverxy (its:ite) ) + + ! needed for crop model (opt_crop=1) + if ( .not. allocated (NoahmpIO%pgsxy) ) allocate ( NoahmpIO%pgsxy (its:ite) ) + if ( .not. allocated (NoahmpIO%cropcat) ) allocate ( NoahmpIO%cropcat (its:ite) ) + if ( .not. allocated (NoahmpIO%planting) ) allocate ( NoahmpIO%planting (its:ite) ) + if ( .not. allocated (NoahmpIO%harvest) ) allocate ( NoahmpIO%harvest (its:ite) ) + if ( .not. allocated (NoahmpIO%season_gdd)) allocate ( NoahmpIO%season_gdd (its:ite) ) + if ( .not. allocated (NoahmpIO%croptype) ) allocate ( NoahmpIO%croptype (its:ite,5) ) + + ! Single- and Multi-layer Urban Models + if ( NoahmpIO%sf_urban_physics > 0 ) then + if ( .not. allocated (NoahmpIO%sh_urb2d) ) allocate ( NoahmpIO%sh_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%lh_urb2d) ) allocate ( NoahmpIO%lh_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%g_urb2d) ) allocate ( NoahmpIO%g_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%rn_urb2d) ) allocate ( NoahmpIO%rn_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%ts_urb2d) ) allocate ( NoahmpIO%ts_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%hrang) ) allocate ( NoahmpIO%hrang (its:ite) ) + if ( .not. allocated (NoahmpIO%frc_urb2d) ) allocate ( NoahmpIO%frc_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%utype_urb2d)) allocate ( NoahmpIO%utype_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%lp_urb2d) ) allocate ( NoahmpIO%lp_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%lb_urb2d) ) allocate ( NoahmpIO%lb_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%hgt_urb2d) ) allocate ( NoahmpIO%hgt_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%ust) ) allocate ( NoahmpIO%ust (its:ite) ) + !endif + + !if(NoahmpIO%sf_urban_physics == 1 ) then ! single layer urban model + if ( .not. allocated (NoahmpIO%cmr_sfcdif) ) allocate ( NoahmpIO%cmr_sfcdif (its:ite) ) + if ( .not. allocated (NoahmpIO%chr_sfcdif) ) allocate ( NoahmpIO%chr_sfcdif (its:ite) ) + if ( .not. allocated (NoahmpIO%cmc_sfcdif) ) allocate ( NoahmpIO%cmc_sfcdif (its:ite) ) + if ( .not. allocated (NoahmpIO%chc_sfcdif) ) allocate ( NoahmpIO%chc_sfcdif (its:ite) ) + if ( .not. allocated (NoahmpIO%cmgr_sfcdif) ) allocate ( NoahmpIO%cmgr_sfcdif (its:ite) ) + if ( .not. allocated (NoahmpIO%chgr_sfcdif) ) allocate ( NoahmpIO%chgr_sfcdif (its:ite) ) + if ( .not. allocated (NoahmpIO%tr_urb2d) ) allocate ( NoahmpIO%tr_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%tb_urb2d) ) allocate ( NoahmpIO%tb_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%tg_urb2d) ) allocate ( NoahmpIO%tg_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%tc_urb2d) ) allocate ( NoahmpIO%tc_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%qc_urb2d) ) allocate ( NoahmpIO%qc_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%uc_urb2d) ) allocate ( NoahmpIO%uc_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%xxxr_urb2d) ) allocate ( NoahmpIO%xxxr_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%xxxb_urb2d) ) allocate ( NoahmpIO%xxxb_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%xxxg_urb2d) ) allocate ( NoahmpIO%xxxg_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%xxxc_urb2d) ) allocate ( NoahmpIO%xxxc_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%psim_urb2d) ) allocate ( NoahmpIO%psim_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%psih_urb2d) ) allocate ( NoahmpIO%psih_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%u10_urb2d) ) allocate ( NoahmpIO%u10_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%v10_urb2d) ) allocate ( NoahmpIO%v10_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%gz1oz0_urb2d) ) allocate ( NoahmpIO%gz1oz0_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%akms_urb2d) ) allocate ( NoahmpIO%akms_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%th2_urb2d) ) allocate ( NoahmpIO%th2_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%q2_urb2d) ) allocate ( NoahmpIO%q2_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%ust_urb2d) ) allocate ( NoahmpIO%ust_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%cmcr_urb2d) ) allocate ( NoahmpIO%cmcr_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%tgr_urb2d) ) allocate ( NoahmpIO%tgr_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%drelr_urb2d) ) allocate ( NoahmpIO%drelr_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%drelb_urb2d) ) allocate ( NoahmpIO%drelb_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%drelg_urb2d) ) allocate ( NoahmpIO%drelg_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%flxhumr_urb2d)) allocate ( NoahmpIO%flxhumr_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%flxhumb_urb2d)) allocate ( NoahmpIO%flxhumb_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%flxhumg_urb2d)) allocate ( NoahmpIO%flxhumg_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%chs) ) allocate ( NoahmpIO%chs (its:ite) ) + if ( .not. allocated (NoahmpIO%chs2) ) allocate ( NoahmpIO%chs2 (its:ite) ) + if ( .not. allocated (NoahmpIO%cqs2) ) allocate ( NoahmpIO%cqs2 (its:ite) ) + if ( .not. allocated (NoahmpIO%mh_urb2d) ) allocate ( NoahmpIO%mh_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%stdh_urb2d) ) allocate ( NoahmpIO%stdh_urb2d (its:ite) ) + if ( .not. allocated (NoahmpIO%lf_urb2d) ) allocate ( NoahmpIO%lf_urb2d (its:ite,4) ) + if ( .not. allocated (NoahmpIO%trl_urb3d) ) allocate ( NoahmpIO%trl_urb3d (its:ite,1:nsoil) ) + if ( .not. allocated (NoahmpIO%tbl_urb3d) ) allocate ( NoahmpIO%tbl_urb3d (its:ite,1:nsoil) ) + if ( .not. allocated (NoahmpIO%tgl_urb3d) ) allocate ( NoahmpIO%tgl_urb3d (its:ite,1:nsoil) ) + if ( .not. allocated (NoahmpIO%tgrl_urb3d) ) allocate ( NoahmpIO%tgrl_urb3d (its:ite,1:nsoil) ) + if ( .not. allocated (NoahmpIO%smr_urb3d) ) allocate ( NoahmpIO%smr_urb3d (its:ite,1:nsoil) ) + if ( .not. allocated (NoahmpIO%dzr) ) allocate ( NoahmpIO%dzr ( 1:nsoil) ) + if ( .not. allocated (NoahmpIO%dzb) ) allocate ( NoahmpIO%dzb ( 1:nsoil) ) + if ( .not. allocated (NoahmpIO%dzg) ) allocate ( NoahmpIO%dzg ( 1:nsoil) ) + !endif + + !if(sf_urban_physics == 2 .or. sf_urban_physics == 3) then ! bep or bem urban models + if ( .not. allocated (NoahmpIO%trb_urb4d) ) allocate ( NoahmpIO%trb_urb4d (its:ite,NoahmpIO%urban_map_zrd) ) + if ( .not. allocated (NoahmpIO%tw1_urb4d) ) allocate ( NoahmpIO%tw1_urb4d (its:ite,NoahmpIO%urban_map_zwd) ) + if ( .not. allocated (NoahmpIO%tw2_urb4d) ) allocate ( NoahmpIO%tw2_urb4d (its:ite,NoahmpIO%urban_map_zwd) ) + if ( .not. allocated (NoahmpIO%tgb_urb4d) ) allocate ( NoahmpIO%tgb_urb4d (its:ite,NoahmpIO%urban_map_gd ) ) + if ( .not. allocated (NoahmpIO%sfw1_urb3d) ) allocate ( NoahmpIO%sfw1_urb3d (its:ite,NoahmpIO%urban_map_zd ) ) + if ( .not. allocated (NoahmpIO%sfw2_urb3d) ) allocate ( NoahmpIO%sfw2_urb3d (its:ite,NoahmpIO%urban_map_zd ) ) + if ( .not. allocated (NoahmpIO%sfr_urb3d) ) allocate ( NoahmpIO%sfr_urb3d (its:ite,NoahmpIO%urban_map_zdf) ) + if ( .not. allocated (NoahmpIO%sfg_urb3d) ) allocate ( NoahmpIO%sfg_urb3d (its:ite,NoahmpIO%num_urban_ndm) ) + if ( .not. allocated (NoahmpIO%hi_urb2d) ) allocate ( NoahmpIO%hi_urb2d (its:ite,NoahmpIO%num_urban_hi ) ) + if ( .not. allocated (NoahmpIO%theta_urban)) allocate ( NoahmpIO%theta_urban (its:ite,kts:kte ) ) + if ( .not. allocated (NoahmpIO%u_urban) ) allocate ( NoahmpIO%u_urban (its:ite,kts:kte ) ) + if ( .not. allocated (NoahmpIO%v_urban) ) allocate ( NoahmpIO%v_urban (its:ite,kts:kte ) ) + if ( .not. allocated (NoahmpIO%dz_urban) ) allocate ( NoahmpIO%dz_urban (its:ite,kts:kte ) ) + if ( .not. allocated (NoahmpIO%rho_urban) ) allocate ( NoahmpIO%rho_urban (its:ite,kts:kte ) ) + if ( .not. allocated (NoahmpIO%p_urban) ) allocate ( NoahmpIO%p_urban (its:ite,kts:kte ) ) + if ( .not. allocated (NoahmpIO%a_u_bep) ) allocate ( NoahmpIO%a_u_bep (its:ite,kts:kte ) ) + if ( .not. allocated (NoahmpIO%a_v_bep) ) allocate ( NoahmpIO%a_v_bep (its:ite,kts:kte ) ) + if ( .not. allocated (NoahmpIO%a_t_bep) ) allocate ( NoahmpIO%a_t_bep (its:ite,kts:kte ) ) + if ( .not. allocated (NoahmpIO%a_q_bep) ) allocate ( NoahmpIO%a_q_bep (its:ite,kts:kte ) ) + if ( .not. allocated (NoahmpIO%a_e_bep) ) allocate ( NoahmpIO%a_e_bep (its:ite,kts:kte ) ) + if ( .not. allocated (NoahmpIO%b_u_bep) ) allocate ( NoahmpIO%b_u_bep (its:ite,kts:kte ) ) + if ( .not. allocated (NoahmpIO%b_v_bep) ) allocate ( NoahmpIO%b_v_bep (its:ite,kts:kte ) ) + if ( .not. allocated (NoahmpIO%b_t_bep) ) allocate ( NoahmpIO%b_t_bep (its:ite,kts:kte ) ) + if ( .not. allocated (NoahmpIO%b_q_bep) ) allocate ( NoahmpIO%b_q_bep (its:ite,kts:kte ) ) + if ( .not. allocated (NoahmpIO%b_e_bep) ) allocate ( NoahmpIO%b_e_bep (its:ite,kts:kte ) ) + if ( .not. allocated (NoahmpIO%dlg_bep) ) allocate ( NoahmpIO%dlg_bep (its:ite,kts:kte ) ) + if ( .not. allocated (NoahmpIO%dl_u_bep) ) allocate ( NoahmpIO%dl_u_bep (its:ite,kts:kte ) ) + if ( .not. allocated (NoahmpIO%sf_bep) ) allocate ( NoahmpIO%sf_bep (its:ite,kts:kte ) ) + if ( .not. allocated (NoahmpIO%vl_bep) ) allocate ( NoahmpIO%vl_bep (its:ite,kts:kte ) ) + !endif + + !if(sf_urban_physics == 3) then ! bem urban model + if ( .not. allocated (NoahmpIO%tlev_urb3d) ) allocate ( NoahmpIO%tlev_urb3d (its:ite,NoahmpIO%urban_map_bd ) ) + if ( .not. allocated (NoahmpIO%qlev_urb3d) ) allocate ( NoahmpIO%qlev_urb3d (its:ite,NoahmpIO%urban_map_bd ) ) + if ( .not. allocated (NoahmpIO%tw1lev_urb3d) ) allocate ( NoahmpIO%tw1lev_urb3d (its:ite,NoahmpIO%urban_map_wd ) ) + if ( .not. allocated (NoahmpIO%tw2lev_urb3d) ) allocate ( NoahmpIO%tw2lev_urb3d (its:ite,NoahmpIO%urban_map_wd ) ) + if ( .not. allocated (NoahmpIO%tglev_urb3d) ) allocate ( NoahmpIO%tglev_urb3d (its:ite,NoahmpIO%urban_map_gbd ) ) + if ( .not. allocated (NoahmpIO%tflev_urb3d) ) allocate ( NoahmpIO%tflev_urb3d (its:ite,NoahmpIO%urban_map_fbd ) ) + if ( .not. allocated (NoahmpIO%sf_ac_urb3d) ) allocate ( NoahmpIO%sf_ac_urb3d (its:ite ) ) + if ( .not. allocated (NoahmpIO%lf_ac_urb3d) ) allocate ( NoahmpIO%lf_ac_urb3d (its:ite ) ) + if ( .not. allocated (NoahmpIO%cm_ac_urb3d) ) allocate ( NoahmpIO%cm_ac_urb3d (its:ite ) ) + if ( .not. allocated (NoahmpIO%sfvent_urb3d) ) allocate ( NoahmpIO%sfvent_urb3d (its:ite ) ) + if ( .not. allocated (NoahmpIO%lfvent_urb3d) ) allocate ( NoahmpIO%lfvent_urb3d (its:ite ) ) + if ( .not. allocated (NoahmpIO%sfwin1_urb3d) ) allocate ( NoahmpIO%sfwin1_urb3d (its:ite,NoahmpIO%urban_map_wd ) ) + if ( .not. allocated (NoahmpIO%sfwin2_urb3d) ) allocate ( NoahmpIO%sfwin2_urb3d (its:ite,NoahmpIO%urban_map_wd ) ) + if ( .not. allocated (NoahmpIO%ep_pv_urb3d) ) allocate ( NoahmpIO%ep_pv_urb3d (its:ite ) ) + if ( .not. allocated (NoahmpIO%t_pv_urb3d) ) allocate ( NoahmpIO%t_pv_urb3d (its:ite,NoahmpIO%urban_map_zdf ) ) + if ( .not. allocated (NoahmpIO%trv_urb4d) ) allocate ( NoahmpIO%trv_urb4d (its:ite,NoahmpIO%urban_map_zgrd) ) + if ( .not. allocated (NoahmpIO%qr_urb4d) ) allocate ( NoahmpIO%qr_urb4d (its:ite,NoahmpIO%urban_map_zgrd) ) + if ( .not. allocated (NoahmpIO%qgr_urb3d) ) allocate ( NoahmpIO%qgr_urb3d (its:ite ) ) + if ( .not. allocated (NoahmpIO%tgr_urb3d) ) allocate ( NoahmpIO%tgr_urb3d (its:ite ) ) + if ( .not. allocated (NoahmpIO%drain_urb4d) ) allocate ( NoahmpIO%drain_urb4d (its:ite,NoahmpIO%urban_map_zdf ) ) + if ( .not. allocated (NoahmpIO%draingr_urb3d)) allocate ( NoahmpIO%draingr_urb3d (its:ite ) ) + if ( .not. allocated (NoahmpIO%sfrv_urb3d) ) allocate ( NoahmpIO%sfrv_urb3d (its:ite,NoahmpIO%urban_map_zdf ) ) + if ( .not. allocated (NoahmpIO%lfrv_urb3d) ) allocate ( NoahmpIO%lfrv_urb3d (its:ite,NoahmpIO%urban_map_zdf ) ) + if ( .not. allocated (NoahmpIO%dgr_urb3d) ) allocate ( NoahmpIO%dgr_urb3d (its:ite,NoahmpIO%urban_map_zdf ) ) + if ( .not. allocated (NoahmpIO%dg_urb3d) ) allocate ( NoahmpIO%dg_urb3d (its:ite,NoahmpIO%num_urban_ndm ) ) + if ( .not. allocated (NoahmpIO%lfr_urb3d) ) allocate ( NoahmpIO%lfr_urb3d (its:ite,NoahmpIO%urban_map_zdf ) ) + if ( .not. allocated (NoahmpIO%lfg_urb3d) ) allocate ( NoahmpIO%lfg_urb3d (its:ite,NoahmpIO%num_urban_ndm ) ) + + endif + +#ifdef WRF_HYDRO + if ( .not. allocated (NoahmpIO%infxsrt) ) allocate ( NoahmpIO%infxsrt (its:ite) ) + if ( .not. allocated (NoahmpIO%sfcheadrt) ) allocate ( NoahmpIO%sfcheadrt (its:ite) ) + if ( .not. allocated (NoahmpIO%soldrain) ) allocate ( NoahmpIO%soldrain (its:ite) ) + if ( .not. allocated (NoahmpIO%qtiledrain)) allocate ( NoahmpIO%qtiledrain (its:ite) ) + if ( .not. allocated (NoahmpIO%zwatble2d) ) allocate ( NoahmpIO%zwatble2d (its:ite) ) +#endif + + !------------------------------------------------------------------- + ! Initialize variables with default values + !------------------------------------------------------------------- + + NoahmpIO%ice = undefined_int + NoahmpIO%ivgtyp = undefined_int + NoahmpIO%isltyp = undefined_int + NoahmpIO%isnowxy = undefined_int + NoahmpIO%coszen = undefined_real + NoahmpIO%xlat = undefined_real + NoahmpIO%dz8w = undefined_real + NoahmpIO%dzs = undefined_real + NoahmpIO%zsoil = undefined_real + NoahmpIO%vegfra = undefined_real + NoahmpIO%tmn = undefined_real + NoahmpIO%xland = undefined_real + NoahmpIO%xice = undefined_real + NoahmpIO%t_phy = undefined_real + NoahmpIO%qv_curr = undefined_real + NoahmpIO%u_phy = undefined_real + NoahmpIO%v_phy = undefined_real + NoahmpIO%swdown = undefined_real + NoahmpIO%swddir = undefined_real + NoahmpIO%swddif = undefined_real + NoahmpIO%glw = undefined_real + NoahmpIO%p8w = undefined_real + NoahmpIO%rainbl = undefined_real + NoahmpIO%snowbl = undefined_real + NoahmpIO%sr = undefined_real + NoahmpIO%raincv = undefined_real + NoahmpIO%rainncv = undefined_real + NoahmpIO%rainshv = undefined_real + NoahmpIO%snowncv = undefined_real + NoahmpIO%graupelncv = undefined_real + NoahmpIO%hailncv = undefined_real + NoahmpIO%qsfc = undefined_real + NoahmpIO%tsk = undefined_real + NoahmpIO%qfx = undefined_real + NoahmpIO%smstav = undefined_real + NoahmpIO%smstot = undefined_real + NoahmpIO%smois = undefined_real + NoahmpIO%sh2o = undefined_real + NoahmpIO%tslb = undefined_real + NoahmpIO%snow = undefined_real + NoahmpIO%snowh = undefined_real + NoahmpIO%canwat = undefined_real + NoahmpIO%smoiseq = undefined_real + NoahmpIO%albedo = undefined_real + NoahmpIO%tvxy = undefined_real + NoahmpIO%tgxy = undefined_real + NoahmpIO%canicexy = undefined_real + NoahmpIO%canliqxy = undefined_real + NoahmpIO%eahxy = undefined_real + NoahmpIO%tahxy = undefined_real + NoahmpIO%cmxy = undefined_real + NoahmpIO%chxy = undefined_real + NoahmpIO%fwetxy = undefined_real + NoahmpIO%sneqvoxy = undefined_real + NoahmpIO%alboldxy = undefined_real + NoahmpIO%qsnowxy = undefined_real + NoahmpIO%qrainxy = undefined_real + NoahmpIO%wslakexy = undefined_real + NoahmpIO%zwtxy = undefined_real + NoahmpIO%waxy = undefined_real + NoahmpIO%wtxy = undefined_real + NoahmpIO%tsnoxy = undefined_real + NoahmpIO%snicexy = undefined_real + NoahmpIO%snliqxy = undefined_real + NoahmpIO%lfmassxy = undefined_real + NoahmpIO%rtmassxy = undefined_real + NoahmpIO%stmassxy = undefined_real + NoahmpIO%woodxy = undefined_real + NoahmpIO%stblcpxy = undefined_real + NoahmpIO%fastcpxy = undefined_real + NoahmpIO%lai = undefined_real + NoahmpIO%xsaixy = undefined_real + NoahmpIO%xlong = undefined_real + NoahmpIO%seaice = undefined_real + NoahmpIO%smcwtdxy = undefined_real + NoahmpIO%zsnsoxy = undefined_real + NoahmpIO%grdflx = undefined_real + NoahmpIO%hfx = undefined_real + NoahmpIO%lh = undefined_real + NoahmpIO%emiss = undefined_real + NoahmpIO%snowc = undefined_real + NoahmpIO%t2mvxy = undefined_real + NoahmpIO%t2mbxy = undefined_real + NoahmpIO%t2mxy = undefined_real + NoahmpIO%q2mvxy = undefined_real + NoahmpIO%q2mbxy = undefined_real + NoahmpIO%q2mxy = undefined_real + NoahmpIO%tradxy = undefined_real + NoahmpIO%neexy = undefined_real + NoahmpIO%gppxy = undefined_real + NoahmpIO%nppxy = undefined_real + NoahmpIO%fvegxy = undefined_real + NoahmpIO%runsfxy = undefined_real + NoahmpIO%runsbxy = undefined_real + NoahmpIO%ecanxy = undefined_real + NoahmpIO%edirxy = undefined_real + NoahmpIO%etranxy = undefined_real + NoahmpIO%fsaxy = undefined_real + NoahmpIO%firaxy = undefined_real + NoahmpIO%aparxy = undefined_real + NoahmpIO%psnxy = undefined_real + NoahmpIO%savxy = undefined_real + NoahmpIO%sagxy = undefined_real + NoahmpIO%rssunxy = undefined_real + NoahmpIO%rsshaxy = undefined_real + NoahmpIO%bgapxy = undefined_real + NoahmpIO%wgapxy = undefined_real + NoahmpIO%tgvxy = undefined_real + NoahmpIO%tgbxy = undefined_real + NoahmpIO%chvxy = undefined_real + NoahmpIO%chbxy = undefined_real + NoahmpIO%shgxy = undefined_real + NoahmpIO%shcxy = undefined_real + NoahmpIO%shbxy = undefined_real + NoahmpIO%evgxy = undefined_real + NoahmpIO%evbxy = undefined_real + NoahmpIO%ghvxy = undefined_real + NoahmpIO%ghbxy = undefined_real + NoahmpIO%irgxy = undefined_real + NoahmpIO%ircxy = undefined_real + NoahmpIO%irbxy = undefined_real + NoahmpIO%trxy = undefined_real + NoahmpIO%evcxy = undefined_real + NoahmpIO%chleafxy = undefined_real + NoahmpIO%chucxy = undefined_real + NoahmpIO%chv2xy = undefined_real + NoahmpIO%chb2xy = undefined_real + NoahmpIO%rs = undefined_real + NoahmpIO%canhsxy = undefined_real + NoahmpIO%z0 = undefined_real + NoahmpIO%znt = undefined_real + NoahmpIO%taussxy = 0.0 + NoahmpIO%deeprechxy = 0.0 + NoahmpIO%rechxy = 0.0 + NoahmpIO%acsnom = 0.0 + NoahmpIO%acsnow = 0.0 + NoahmpIO%mp_rainc = 0.0 + NoahmpIO%mp_rainnc = 0.0 + NoahmpIO%mp_shcv = 0.0 + NoahmpIO%mp_snow = 0.0 + NoahmpIO%mp_graup = 0.0 + NoahmpIO%mp_hail = 0.0 + NoahmpIO%sfcrunoff = 0.0 + NoahmpIO%udrunoff = 0.0 + + ! additional output + NoahmpIO%pahxy = undefined_real + NoahmpIO%pahgxy = undefined_real + NoahmpIO%pahbxy = undefined_real + NoahmpIO%pahvxy = undefined_real + NoahmpIO%qintsxy = undefined_real + NoahmpIO%qintrxy = undefined_real + NoahmpIO%qdripsxy = undefined_real + NoahmpIO%qdriprxy = undefined_real + NoahmpIO%qthrosxy = undefined_real + NoahmpIO%qthrorxy = undefined_real + NoahmpIO%qsnsubxy = undefined_real + NoahmpIO%qsnfroxy = undefined_real + NoahmpIO%qsubcxy = undefined_real + NoahmpIO%qfrocxy = undefined_real + NoahmpIO%qevacxy = undefined_real + NoahmpIO%qdewcxy = undefined_real + NoahmpIO%qfrzcxy = undefined_real + NoahmpIO%qmeltcxy = undefined_real + NoahmpIO%qsnbotxy = undefined_real + NoahmpIO%qmeltxy = undefined_real + NoahmpIO%fpicexy = undefined_real + NoahmpIO%rainlsm = undefined_real + NoahmpIO%snowlsm = undefined_real + NoahmpIO%forctlsm = undefined_real + NoahmpIO%forcqlsm = undefined_real + NoahmpIO%forcplsm = undefined_real + NoahmpIO%forczlsm = undefined_real + NoahmpIO%forcwlsm = undefined_real + NoahmpIO%eflxbxy = undefined_real + NoahmpIO%soilenergy = undefined_real + NoahmpIO%snowenergy = undefined_real + NoahmpIO%pondingxy = 0.0 + NoahmpIO%acc_ssoilxy = 0.0 + NoahmpIO%acc_qinsurxy = 0.0 + NoahmpIO%acc_qsevaxy = 0.0 + NoahmpIO%acc_etranixy = 0.0 + NoahmpIO%acc_dwaterxy = 0.0 + NoahmpIO%acc_prcpxy = 0.0 + NoahmpIO%acc_ecanxy = 0.0 + NoahmpIO%acc_etranxy = 0.0 + NoahmpIO%acc_edirxy = 0.0 + + ! MMF Groundwater + NoahmpIO%terrain = undefined_real + NoahmpIO%gvfmin = undefined_real + NoahmpIO%gvfmax = undefined_real + NoahmpIO%msftx = undefined_real + NoahmpIO%msfty = undefined_real + NoahmpIO%eqzwt = undefined_real + NoahmpIO%riverbedxy = undefined_real + NoahmpIO%rivercondxy = undefined_real + NoahmpIO%pexpxy = undefined_real + NoahmpIO%fdepthxy = undefined_real + NoahmpIO%areaxy = undefined_real + NoahmpIO%qrfsxy = undefined_real + NoahmpIO%qspringsxy = undefined_real + NoahmpIO%qrfxy = undefined_real + NoahmpIO%qspringxy = undefined_real + NoahmpIO%qslatxy = undefined_real + NoahmpIO%qlatxy = undefined_real + + ! crop model + NoahmpIO%pgsxy = undefined_int + NoahmpIO%cropcat = undefined_int + NoahmpIO%planting = undefined_real + NoahmpIO%harvest = undefined_real + NoahmpIO%season_gdd = undefined_real + NoahmpIO%croptype = undefined_real + + ! tile drainage + NoahmpIO%qtdrain = 0.0 + NoahmpIO%td_fraction = undefined_real + + ! irrigation + NoahmpIO%irfract = 0.0 + NoahmpIO%sifract = 0.0 + NoahmpIO%mifract = 0.0 + NoahmpIO%fifract = 0.0 + NoahmpIO%irnumsi = 0 + NoahmpIO%irnummi = 0 + NoahmpIO%irnumfi = 0 + NoahmpIO%irwatsi = 0.0 + NoahmpIO%irwatmi = 0.0 + NoahmpIO%irwatfi = 0.0 + NoahmpIO%ireloss = 0.0 + NoahmpIO%irsivol = 0.0 + NoahmpIO%irmivol = 0.0 + NoahmpIO%irfivol = 0.0 + NoahmpIO%irrsplh = 0.0 + NoahmpIO%loctim = undefined_real + + ! spatial varying soil texture + if ( NoahmpIO%iopt_soil > 1 ) then + NoahmpIO%soilcl1 = undefined_real + NoahmpIO%soilcl2 = undefined_real + NoahmpIO%soilcl3 = undefined_real + NoahmpIO%soilcl4 = undefined_real + NoahmpIO%soilcomp = undefined_real + endif + + ! urban model + if ( NoahmpIO%sf_urban_physics > 0 ) then + NoahmpIO%julday = undefined_int_neg + NoahmpIO%iri_urban = undefined_int_neg + NoahmpIO%utype_urb2d = undefined_int_neg + NoahmpIO%hrang = undefined_real_neg + NoahmpIO%declin = undefined_real_neg + NoahmpIO%sh_urb2d = undefined_real_neg + NoahmpIO%lh_urb2d = undefined_real_neg + NoahmpIO%g_urb2d = undefined_real_neg + NoahmpIO%rn_urb2d = undefined_real_neg + NoahmpIO%ts_urb2d = undefined_real_neg + NoahmpIO%gmt = undefined_real_neg + NoahmpIO%frc_urb2d = undefined_real_neg + NoahmpIO%lp_urb2d = undefined_real_neg + NoahmpIO%lb_urb2d = undefined_real_neg + NoahmpIO%hgt_urb2d = undefined_real_neg + NoahmpIO%ust = undefined_real_neg + NoahmpIO%cmr_sfcdif = 1.0e-4 + NoahmpIO%chr_sfcdif = 1.0e-4 + NoahmpIO%cmc_sfcdif = 1.0e-4 + NoahmpIO%chc_sfcdif = 1.0e-4 + NoahmpIO%cmgr_sfcdif = 1.0e-4 + NoahmpIO%chgr_sfcdif = 1.0e-4 + NoahmpIO%tr_urb2d = undefined_real_neg + NoahmpIO%tb_urb2d = undefined_real_neg + NoahmpIO%tg_urb2d = undefined_real_neg + NoahmpIO%tc_urb2d = undefined_real_neg + NoahmpIO%qc_urb2d = undefined_real_neg + NoahmpIO%uc_urb2d = undefined_real_neg + NoahmpIO%xxxr_urb2d = undefined_real_neg + NoahmpIO%xxxb_urb2d = undefined_real_neg + NoahmpIO%xxxg_urb2d = undefined_real_neg + NoahmpIO%xxxc_urb2d = undefined_real_neg + NoahmpIO%trl_urb3d = undefined_real_neg + NoahmpIO%tbl_urb3d = undefined_real_neg + NoahmpIO%tgl_urb3d = undefined_real_neg + NoahmpIO%psim_urb2d = undefined_real_neg + NoahmpIO%psih_urb2d = undefined_real_neg + NoahmpIO%u10_urb2d = undefined_real_neg + NoahmpIO%v10_urb2d = undefined_real_neg + NoahmpIO%gz1oz0_urb2d = undefined_real_neg + NoahmpIO%akms_urb2d = undefined_real_neg + NoahmpIO%th2_urb2d = undefined_real_neg + NoahmpIO%q2_urb2d = undefined_real_neg + NoahmpIO%ust_urb2d = undefined_real_neg + NoahmpIO%dzr = undefined_real_neg + NoahmpIO%dzb = undefined_real_neg + NoahmpIO%dzg = undefined_real_neg + NoahmpIO%cmcr_urb2d = undefined_real_neg + NoahmpIO%tgr_urb2d = undefined_real_neg + NoahmpIO%tgrl_urb3d = undefined_real_neg + NoahmpIO%smr_urb3d = undefined_real_neg + NoahmpIO%drelr_urb2d = undefined_real_neg + NoahmpIO%drelb_urb2d = undefined_real_neg + NoahmpIO%drelg_urb2d = undefined_real_neg + NoahmpIO%flxhumr_urb2d = undefined_real_neg + NoahmpIO%flxhumb_urb2d = undefined_real_neg + NoahmpIO%flxhumg_urb2d = undefined_real_neg + NoahmpIO%chs = 1.0e-4 + NoahmpIO%chs2 = 1.0e-4 + NoahmpIO%cqs2 = 1.0e-4 + NoahmpIO%mh_urb2d = undefined_real_neg + NoahmpIO%stdh_urb2d = undefined_real_neg + NoahmpIO%lf_urb2d = undefined_real_neg + NoahmpIO%trb_urb4d = undefined_real_neg + NoahmpIO%tw1_urb4d = undefined_real_neg + NoahmpIO%tw2_urb4d = undefined_real_neg + NoahmpIO%tgb_urb4d = undefined_real_neg + NoahmpIO%sfw1_urb3d = undefined_real_neg + NoahmpIO%sfw2_urb3d = undefined_real_neg + NoahmpIO%sfr_urb3d = undefined_real_neg + NoahmpIO%sfg_urb3d = undefined_real_neg + NoahmpIO%hi_urb2d = undefined_real_neg + NoahmpIO%theta_urban = undefined_real_neg + NoahmpIO%u_urban = undefined_real_neg + NoahmpIO%v_urban = undefined_real_neg + NoahmpIO%dz_urban = undefined_real_neg + NoahmpIO%rho_urban = undefined_real_neg + NoahmpIO%p_urban = undefined_real_neg + NoahmpIO%a_u_bep = undefined_real_neg + NoahmpIO%a_v_bep = undefined_real_neg + NoahmpIO%a_t_bep = undefined_real_neg + NoahmpIO%a_q_bep = undefined_real_neg + NoahmpIO%a_e_bep = undefined_real_neg + NoahmpIO%b_u_bep = undefined_real_neg + NoahmpIO%b_v_bep = undefined_real_neg + NoahmpIO%b_t_bep = undefined_real_neg + NoahmpIO%b_q_bep = undefined_real_neg + NoahmpIO%b_e_bep = undefined_real_neg + NoahmpIO%dlg_bep = undefined_real_neg + NoahmpIO%dl_u_bep = undefined_real_neg + NoahmpIO%sf_bep = undefined_real_neg + NoahmpIO%vl_bep = undefined_real_neg + NoahmpIO%tlev_urb3d = undefined_real_neg + NoahmpIO%qlev_urb3d = undefined_real_neg + NoahmpIO%tw1lev_urb3d = undefined_real_neg + NoahmpIO%tw2lev_urb3d = undefined_real_neg + NoahmpIO%tglev_urb3d = undefined_real_neg + NoahmpIO%tflev_urb3d = undefined_real_neg + NoahmpIO%sf_ac_urb3d = undefined_real_neg + NoahmpIO%lf_ac_urb3d = undefined_real_neg + NoahmpIO%cm_ac_urb3d = undefined_real_neg + NoahmpIO%sfvent_urb3d = undefined_real_neg + NoahmpIO%lfvent_urb3d = undefined_real_neg + NoahmpIO%sfwin1_urb3d = undefined_real_neg + NoahmpIO%sfwin2_urb3d = undefined_real_neg + NoahmpIO%ep_pv_urb3d = undefined_real_neg + NoahmpIO%t_pv_urb3d = undefined_real_neg + NoahmpIO%trv_urb4d = undefined_real_neg + NoahmpIO%qr_urb4d = undefined_real_neg + NoahmpIO%qgr_urb3d = undefined_real_neg + NoahmpIO%tgr_urb3d = undefined_real_neg + NoahmpIO%drain_urb4d = undefined_real_neg + NoahmpIO%draingr_urb3d = undefined_real_neg + NoahmpIO%sfrv_urb3d = undefined_real_neg + NoahmpIO%lfrv_urb3d = undefined_real_neg + NoahmpIO%dgr_urb3d = undefined_real_neg + NoahmpIO%dg_urb3d = undefined_real_neg + NoahmpIO%lfr_urb3d = undefined_real_neg + NoahmpIO%lfg_urb3d = undefined_real_neg + endif + + NoahmpIO%slopetyp = 1 ! soil parameter slope type + NoahmpIO%soil_update_steps = 1 ! number of model time step to update soil proces + NoahmpIO%calculate_soil = .false. ! index for if do soil process + +#ifdef WRF_HYDRO + NoahmpIO%infxsrt = 0.0 + NoahmpIO%sfcheadrt = 0.0 + NoahmpIO%soldrain = 0.0 + NoahmpIO%qtiledrain = 0.0 + NoahmpIO%zwatble2d = 0.0 +#endif + + end associate + + end subroutine NoahmpIOVarInitDefault + +end module NoahmpIOVarInitMod diff --git a/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpIOVarType.F90 b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpIOVarType.F90 new file mode 100644 index 000000000..05a29d703 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpIOVarType.F90 @@ -0,0 +1,938 @@ +module NoahmpIOVarType + +!!! Define Noah-MP Input variables (2D forcing, namelist, table, static) +!!! Input variable initialization is done in NoahmpIOVarInitMod.F90 + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use Machine + + implicit none + save + private + + type, public :: NoahmpIO_type + +!------------------------------------------------------------------------ +! general 2-D/3-D Noah-MP variables +!------------------------------------------------------------------------ + + ! IN only (as defined in WRF) + integer :: its,ite, & ! t -> tile + kts,kte ! t -> tile + integer :: itimestep ! timestep number + integer :: yr ! 4-digit year + integer :: month ! 2-digit month + integer :: day ! 2-digit day + integer :: nsoil ! number of soil layers + integer :: ice ! sea-ice point + integer :: isice ! land cover category for ice + integer :: isurban ! land cover category for urban + integer :: iswater ! land cover category for water + integer :: islake ! land cover category for lake + integer :: urbtype_beg ! urban type start number - 1 + integer :: iopt_dveg ! dynamic vegetation + integer :: iopt_crs ! canopy stomatal resistance (1-> Ball-Berry; 2->Jarvis) + integer :: iopt_btr ! soil moisture factor for stomatal resistance (1-> Noah; 2-> CLM; 3-> SSiB) + integer :: iopt_runsrf ! surface runoff and groundwater (1->SIMGM; 2->SIMTOP; 3->Schaake96; 4->BATS) + integer :: iopt_runsub ! subsurface runoff option + integer :: iopt_sfc ! surface layer drag coeff (CH & CM) (1->M-O; 2->Chen97) + integer :: iopt_frz ! supercooled liquid water (1-> NY06; 2->Koren99) + integer :: iopt_inf ! frozen soil permeability (1-> NY06; 2->Koren99) + integer :: iopt_rad ! radiation transfer (1->gap=F(3D,cosz); 2->gap=0; 3->gap=1-Fveg) + integer :: iopt_alb ! snow surface albedo (1->BATS; 2->CLASS) + integer :: iopt_snf ! rainfall & snowfall (1-Jordan91; 2->BATS; 3->Noah) + integer :: iopt_tksno ! snow thermal conductivity: 1 -> Stieglitz(yen,1965) scheme (default), 2 -> Anderson, 1976 scheme, 3 -> constant, 4 -> Verseghy (1991) scheme, 5 -> Douvill(Yen, 1981) scheme + integer :: iopt_tbot ! lower boundary of soil temperature (1->zero-flux; 2->Noah) + integer :: iopt_stc ! snow/soil temperature time scheme + integer :: iopt_gla ! glacier option (1->phase change; 2->simple) + integer :: iopt_rsf ! surface resistance option (1->Zeng; 2->simple) + integer :: iz0tlnd ! option of Chen adjustment of Czil (not used) + integer :: iopt_soil ! soil configuration option + integer :: iopt_pedo ! soil pedotransfer function option + integer :: iopt_crop ! crop model option (0->none; 1->Liu et al.) + integer :: iopt_irr ! irrigation scheme (0->none; >1 irrigation scheme ON) + integer :: iopt_irrm ! irrigation method (0->dynamic; 1-> sprinkler; 2-> micro; 3-> flood) + integer :: iopt_infdv ! infiltration options for dynamic VIC (1->Philip; 2-> Green-Ampt;3->Smith-Parlange) + integer :: iopt_tdrn ! drainage option (0->off; 1->simple scheme; 2->Hooghoudt's scheme) + real(kind=kind_noahmp) :: xice_threshold ! fraction of grid determining seaice + real(kind=kind_noahmp) :: julian ! julian day + real(kind=kind_noahmp) :: dtbl ! timestep [s] + real(kind=kind_noahmp) :: dx ! horizontal grid spacing [m] + real(kind=kind_noahmp) :: soiltstep ! soil time step (s) (default=0: same as main NoahMP timstep) + logical :: fndsnowh ! snow depth present in input + logical :: calculate_soil ! logical index for if do soil calculation + integer :: soil_update_steps ! number of model time steps to update soil process + integer, allocatable, dimension(:) :: ivgtyp ! vegetation type + integer, allocatable, dimension(:) :: isltyp ! soil type + real(kind=kind_noahmp), allocatable, dimension(:) :: coszen ! cosine zenith angle + real(kind=kind_noahmp), allocatable, dimension(:) :: xlat ! latitude [rad] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: dz8w ! thickness of atmo layers [m] + real(kind=kind_noahmp), allocatable, dimension(:) :: dzs ! thickness of soil layers [m] + real(kind=kind_noahmp), allocatable, dimension(:) :: zsoil ! depth to soil interfaces [m] + real(kind=kind_noahmp), allocatable, dimension(:) :: vegfra ! vegetation fraction [] + real(kind=kind_noahmp), allocatable, dimension(:) :: tmn ! deep soil temperature [K] + real(kind=kind_noahmp), allocatable, dimension(:) :: xland ! =2 ocean; =1 land/seaice + real(kind=kind_noahmp), allocatable, dimension(:) :: xice ! fraction of grid that is seaice + real(kind=kind_noahmp), allocatable, dimension(:) :: seaice ! seaice fraction + + ! forcings + real(kind=kind_noahmp), allocatable, dimension(:,:) :: t_phy ! 3D atmospheric temperature valid at mid-levels [K] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: qv_curr ! 3D water vapor mixing ratio [kg/kg_dry] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: u_phy ! 3D U wind component [m/s] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: v_phy ! 3D V wind component [m/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: swdown ! solar down at surface [W m-2] + real(kind=kind_noahmp), allocatable, dimension(:) :: glw ! longwave down at surface [W m-2] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: p8w ! 3D pressure, valid at interface [Pa] + real(kind=kind_noahmp), allocatable, dimension(:) :: rainbl ! precipitation entering land model [mm] per time step + real(kind=kind_noahmp), allocatable, dimension(:) :: snowbl ! snow entering land model [mm] per time step + real(kind=kind_noahmp), allocatable, dimension(:) :: sr ! frozen precip ratio entering land model [-] + real(kind=kind_noahmp), allocatable, dimension(:) :: raincv ! convective precip forcing [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: rainncv ! non-convective precip forcing [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: rainshv ! shallow conv. precip forcing [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: snowncv ! non-covective snow forcing (subset of rainncv) [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: graupelncv ! non-convective graupel forcing (subset of rainncv) [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: hailncv ! non-convective hail forcing (subset of rainncv) [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: mp_rainc ! convective precipitation entering land model [mm] ! MB/AN : v3.7 + real(kind=kind_noahmp), allocatable, dimension(:) :: mp_rainnc ! large-scale precipitation entering land model [mm]! MB/AN : v3.7 + real(kind=kind_noahmp), allocatable, dimension(:) :: mp_shcv ! shallow conv precip entering land model [mm] ! MB/AN : v3.7 + real(kind=kind_noahmp), allocatable, dimension(:) :: mp_snow ! snow precipitation entering land model [mm] ! MB/AN : v3.7 + real(kind=kind_noahmp), allocatable, dimension(:) :: mp_graup ! graupel precipitation entering land model [mm] ! MB/AN : v3.7 + real(kind=kind_noahmp), allocatable, dimension(:) :: mp_hail ! hail precipitation entering land model [mm] ! MB/AN : v3.7 + +#ifdef WRF_HYDRO + real(kind=kind_noahmp), allocatable, dimension(:) :: infxsrt ! surface infiltration + real(kind=kind_noahmp), allocatable, dimension(:) :: sfcheadrt ! surface water head + real(kind=kind_noahmp), allocatable, dimension(:) :: soldrain ! soil drainage + real(kind=kind_noahmp), allocatable, dimension(:) :: qtiledrain ! tile drainage + real(kind=kind_noahmp), allocatable, dimension(:) :: zwatble2d ! water table depth +#endif + + ! Spatially varying fields (for now it is de-activated) + real(kind=kind_noahmp), allocatable, dimension(:,:) :: soilcomp ! Soil sand and clay content [fraction] + real(kind=kind_noahmp), allocatable, dimension(:) :: soilcl1 ! Soil texture class with depth + real(kind=kind_noahmp), allocatable, dimension(:) :: soilcl2 ! Soil texture class with depth + real(kind=kind_noahmp), allocatable, dimension(:) :: soilcl3 ! Soil texture class with depth + real(kind=kind_noahmp), allocatable, dimension(:) :: soilcl4 ! Soil texture class with depth + real(kind=kind_noahmp), allocatable, dimension(:,:) :: bexp_3D ! C-H B exponent + real(kind=kind_noahmp), allocatable, dimension(:,:) :: smcdry_3D ! Soil Moisture Limit: Dry + real(kind=kind_noahmp), allocatable, dimension(:,:) :: smcwlt_3D ! Soil Moisture Limit: Wilt + real(kind=kind_noahmp), allocatable, dimension(:,:) :: smcref_3D ! Soil Moisture Limit: Reference + real(kind=kind_noahmp), allocatable, dimension(:,:) :: smcmax_3D ! Soil Moisture Limit: Max + real(kind=kind_noahmp), allocatable, dimension(:,:) :: dksat_3D ! Saturated Soil Conductivity + real(kind=kind_noahmp), allocatable, dimension(:,:) :: dwsat_3D ! Saturated Soil Diffusivity + real(kind=kind_noahmp), allocatable, dimension(:,:) :: psisat_3D ! Saturated Matric Potential + real(kind=kind_noahmp), allocatable, dimension(:,:) :: quartz_3D ! Soil quartz content + real(kind=kind_noahmp), allocatable, dimension(:) :: refdk_2D ! Reference Soil Conductivity + real(kind=kind_noahmp), allocatable, dimension(:) :: refkdt_2D ! Soil Infiltration Parameter + real(kind=kind_noahmp), allocatable, dimension(:) :: irr_frac_2D ! irrigation Fraction + real(kind=kind_noahmp), allocatable, dimension(:) :: irr_har_2D ! number of days before harvest date to stop irrigation + real(kind=kind_noahmp), allocatable, dimension(:) :: irr_lai_2D ! Minimum lai to trigger irrigation + real(kind=kind_noahmp), allocatable, dimension(:) :: irr_mad_2D ! management allowable deficit (0-1) + real(kind=kind_noahmp), allocatable, dimension(:) :: filoss_2D ! fraction of flood irrigation loss (0-1) + real(kind=kind_noahmp), allocatable, dimension(:) :: sprir_rate_2D ! mm/h, sprinkler irrigation rate + real(kind=kind_noahmp), allocatable, dimension(:) :: micir_rate_2D ! mm/h, micro irrigation rate + real(kind=kind_noahmp), allocatable, dimension(:) :: firtfac_2D ! flood application rate factor + real(kind=kind_noahmp), allocatable, dimension(:) :: ir_rain_2D ! maximum precipitation to stop irrigation trigger + real(kind=kind_noahmp), allocatable, dimension(:) :: bvic_2d ! VIC model infiltration parameter [-] opt_run=6 + real(kind=kind_noahmp), allocatable, dimension(:) :: axaj_2D ! Tension water distribution inflection parameter [-] opt_run=7 + real(kind=kind_noahmp), allocatable, dimension(:) :: bxaj_2D ! Tension water distribution shape parameter [-] opt_run=7 + real(kind=kind_noahmp), allocatable, dimension(:) :: xxaj_2D ! Free water distribution shape parameter [-] opt_run=7 + real(kind=kind_noahmp), allocatable, dimension(:) :: bdvic_2d ! VIC model infiltration parameter [-] opt_run=8 + real(kind=kind_noahmp), allocatable, dimension(:) :: gdvic_2d ! Mean Capillary Drive (m) for infiltration models opt_run=8 + real(kind=kind_noahmp), allocatable, dimension(:) :: bbvic_2d ! DVIC heterogeniety parameter for infiltration [-] opt_run=8 + real(kind=kind_noahmp), allocatable, dimension(:) :: KLAT_FAC ! factor multiplier to hydraulic conductivity + real(kind=kind_noahmp), allocatable, dimension(:) :: TDSMC_FAC ! factor multiplier to field capacity + real(kind=kind_noahmp), allocatable, dimension(:) :: TD_DC ! drainage coefficient for simple + real(kind=kind_noahmp), allocatable, dimension(:) :: TD_DCOEF ! drainge coefficient for Hooghoudt + real(kind=kind_noahmp), allocatable, dimension(:) :: TD_DDRAIN ! depth of drain + real(kind=kind_noahmp), allocatable, dimension(:) :: TD_RADI ! tile radius + real(kind=kind_noahmp), allocatable, dimension(:) :: TD_SPAC ! tile spacing + + ! INOUT (with generic LSM equivalent) (as defined in WRF) + real(kind=kind_noahmp), allocatable, dimension(:) :: tsk ! surface radiative temperature [K] + real(kind=kind_noahmp), allocatable, dimension(:) :: hfx ! sensible heat flux [W m-2] + real(kind=kind_noahmp), allocatable, dimension(:) :: qfx ! latent heat flux [kg s-1 m-2] + real(kind=kind_noahmp), allocatable, dimension(:) :: lh ! latent heat flux [W m-2] + real(kind=kind_noahmp), allocatable, dimension(:) :: grdflx ! ground/snow heat flux [W m-2] + real(kind=kind_noahmp), allocatable, dimension(:) :: smstav ! soil moisture avail. [not used] + real(kind=kind_noahmp), allocatable, dimension(:) :: smstot ! total soil water [mm][not used] + real(kind=kind_noahmp), allocatable, dimension(:) :: sfcrunoff ! accumulated surface runoff [m] + real(kind=kind_noahmp), allocatable, dimension(:) :: udrunoff ! accumulated sub-surface runoff [m] + real(kind=kind_noahmp), allocatable, dimension(:) :: albedo ! total grid albedo [] + real(kind=kind_noahmp), allocatable, dimension(:) :: snowc ! snow cover fraction [] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: smoiseq ! volumetric soil moisture [m3/m3] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: smois ! volumetric soil moisture [m3/m3] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: sh2o ! volumetric liquid soil moisture [m3/m3] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: tslb ! soil temperature [K] + real(kind=kind_noahmp), allocatable, dimension(:) :: snow ! snow water equivalent [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: snowh ! physical snow depth [m] + real(kind=kind_noahmp), allocatable, dimension(:) :: canwat ! total canopy water + ice [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: acsnom ! accumulated snow melt leaving pack + real(kind=kind_noahmp), allocatable, dimension(:) :: acsnow ! accumulated snow on grid + real(kind=kind_noahmp), allocatable, dimension(:) :: emiss ! surface bulk emissivity + real(kind=kind_noahmp), allocatable, dimension(:) :: qsfc ! bulk surface specific humidity + + ! INOUT (with no Noah LSM equivalent) (as defined in WRF) + integer, allocatable, dimension(:) :: isnowxy ! actual no. of snow layers + real(kind=kind_noahmp), allocatable, dimension(:) :: tvxy ! vegetation leaf temperature + real(kind=kind_noahmp), allocatable, dimension(:) :: tgxy ! bulk ground surface temperature + real(kind=kind_noahmp), allocatable, dimension(:) :: canicexy ! canopy-intercepted ice (mm) + real(kind=kind_noahmp), allocatable, dimension(:) :: canliqxy ! canopy-intercepted liquid water (mm) + real(kind=kind_noahmp), allocatable, dimension(:) :: eahxy ! canopy air vapor pressure (Pa) + real(kind=kind_noahmp), allocatable, dimension(:) :: tahxy ! canopy air temperature (K) + real(kind=kind_noahmp), allocatable, dimension(:) :: cmxy ! bulk momentum drag coefficient + real(kind=kind_noahmp), allocatable, dimension(:) :: chxy ! bulk sensible heat exchange coefficient + real(kind=kind_noahmp), allocatable, dimension(:) :: fwetxy ! wetted or snowed fraction of the canopy (-) + real(kind=kind_noahmp), allocatable, dimension(:) :: sneqvoxy ! snow mass at last time step(mm h2o) + real(kind=kind_noahmp), allocatable, dimension(:) :: alboldxy ! snow albedo at last time step (-) + real(kind=kind_noahmp), allocatable, dimension(:) :: qsnowxy ! snowfall on the ground [mm/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: qrainxy ! rainfall on the ground [mm/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: wslakexy ! lake water storage [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: zwtxy ! water table depth [m] + real(kind=kind_noahmp), allocatable, dimension(:) :: waxy ! water in the "aquifer" [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: wtxy ! groundwater storage [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: smcwtdxy ! groundwater storage [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: deeprechxy ! groundwater storage [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: rechxy ! groundwater storage [mm] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: tsnoxy ! snow temperature [K] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: zsnsoxy ! snow layer depth [m] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: snicexy ! snow layer ice [mm] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: snliqxy ! snow layer liquid water [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: lfmassxy ! leaf mass [g/m2] + real(kind=kind_noahmp), allocatable, dimension(:) :: rtmassxy ! mass of fine roots [g/m2] + real(kind=kind_noahmp), allocatable, dimension(:) :: stmassxy ! stem mass [g/m2] + real(kind=kind_noahmp), allocatable, dimension(:) :: woodxy ! mass of wood (incl. woody roots) [g/m2] + real(kind=kind_noahmp), allocatable, dimension(:) :: grainxy ! xing mass of grain!three + real(kind=kind_noahmp), allocatable, dimension(:) :: gddxy ! xinggrowingdegressday + real(kind=kind_noahmp), allocatable, dimension(:) :: stblcpxy ! stable carbon in deep soil [g/m2] + real(kind=kind_noahmp), allocatable, dimension(:) :: fastcpxy ! short-lived carbon, shallow soil [g/m2] + real(kind=kind_noahmp), allocatable, dimension(:) :: lai ! leaf area index + real(kind=kind_noahmp), allocatable, dimension(:) :: xsaixy ! stem area index + real(kind=kind_noahmp), allocatable, dimension(:) :: taussxy ! snow age factor + + ! irrigation + real(kind=kind_noahmp), allocatable, dimension(:) :: irfract ! irrigation fraction + real(kind=kind_noahmp), allocatable, dimension(:) :: sifract ! sprinkler irrigation fraction + real(kind=kind_noahmp), allocatable, dimension(:) :: mifract ! micro irrigation fraction + real(kind=kind_noahmp), allocatable, dimension(:) :: fifract ! flood irrigation fraction + integer, allocatable, dimension(:) :: irnumsi ! irrigation event number, sprinkler + integer, allocatable, dimension(:) :: irnummi ! irrigation event number, micro + integer, allocatable, dimension(:) :: irnumfi ! irrigation event number, flood + real(kind=kind_noahmp), allocatable, dimension(:) :: irwatsi ! irrigation water amount [m] to be applied, sprinkler + real(kind=kind_noahmp), allocatable, dimension(:) :: irwatmi ! irrigation water amount [m] to be applied, micro + real(kind=kind_noahmp), allocatable, dimension(:) :: irwatfi ! irrigation water amount [m] to be applied, flood + real(kind=kind_noahmp), allocatable, dimension(:) :: ireloss ! loss of irrigation water to evaporation,sprinkler [m/timestep] + real(kind=kind_noahmp), allocatable, dimension(:) :: irsivol ! amount of irrigation by sprinkler (mm) + real(kind=kind_noahmp), allocatable, dimension(:) :: irmivol ! amount of irrigation by micro (mm) + real(kind=kind_noahmp), allocatable, dimension(:) :: irfivol ! amount of irrigation by micro (mm) + real(kind=kind_noahmp), allocatable, dimension(:) :: irrsplh ! latent heating from sprinkler evaporation (W/m2) + real(kind=kind_noahmp), allocatable, dimension(:) :: loctim ! local time + + ! OUT (with no Noah LSM equivalent) (as defined in WRF) + real(kind=kind_noahmp), allocatable, dimension(:) :: t2mvxy ! 2m temperature of vegetation part [K] + real(kind=kind_noahmp), allocatable, dimension(:) :: t2mbxy ! 2m temperature of bare ground part [K] + real(kind=kind_noahmp), allocatable, dimension(:) :: t2mxy ! 2m grid-mean temperature [K] + real(kind=kind_noahmp), allocatable, dimension(:) :: q2mvxy ! 2m mixing ratio of vegetation part [kg/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: q2mbxy ! 2m mixing ratio of bare ground part [kg/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: q2mxy ! 2m grid-mean mixing ratio [kg/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: tradxy ! surface radiative temperature (K) + real(kind=kind_noahmp), allocatable, dimension(:) :: neexy ! net ecosys exchange (g/m2/s CO2) + real(kind=kind_noahmp), allocatable, dimension(:) :: gppxy ! gross primary assimilation [g/m2/s C] + real(kind=kind_noahmp), allocatable, dimension(:) :: nppxy ! net primary productivity [g/m2/s C] + real(kind=kind_noahmp), allocatable, dimension(:) :: fvegxy ! noah-mp vegetation fraction [-] + real(kind=kind_noahmp), allocatable, dimension(:) :: runsfxy ! surface runoff [mm per soil timestep] + real(kind=kind_noahmp), allocatable, dimension(:) :: runsbxy ! subsurface runoff [mm per soil timestep] + real(kind=kind_noahmp), allocatable, dimension(:) :: ecanxy ! evaporation of intercepted water (mm/s) + real(kind=kind_noahmp), allocatable, dimension(:) :: edirxy ! soil surface evaporation rate (mm/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: etranxy ! transpiration rate (mm/s) + real(kind=kind_noahmp), allocatable, dimension(:) :: fsaxy ! total absorbed solar radiation (W/m2) + real(kind=kind_noahmp), allocatable, dimension(:) :: firaxy ! total net longwave rad (w/m2) [+ to atm] + real(kind=kind_noahmp), allocatable, dimension(:) :: aparxy ! photosyn active energy by canopy (W/m2) + real(kind=kind_noahmp), allocatable, dimension(:) :: psnxy ! total photosynthesis (umol co2/m2/s) [+] + real(kind=kind_noahmp), allocatable, dimension(:) :: savxy ! solar rad absorbed by veg. (W/m2) + real(kind=kind_noahmp), allocatable, dimension(:) :: sagxy ! solar rad absorbed by ground (W/m2) + real(kind=kind_noahmp), allocatable, dimension(:) :: rssunxy ! sunlit leaf stomatal resistance (s/m) + real(kind=kind_noahmp), allocatable, dimension(:) :: rsshaxy ! shaded leaf stomatal resistance (s/m) + real(kind=kind_noahmp), allocatable, dimension(:) :: bgapxy ! between gap fraction + real(kind=kind_noahmp), allocatable, dimension(:) :: wgapxy ! within gap fraction + real(kind=kind_noahmp), allocatable, dimension(:) :: tgvxy ! under canopy ground temperature[K] + real(kind=kind_noahmp), allocatable, dimension(:) :: tgbxy ! bare ground temperature [K] + real(kind=kind_noahmp), allocatable, dimension(:) :: chvxy ! sensible heat exchange coefficient vegetated + real(kind=kind_noahmp), allocatable, dimension(:) :: chbxy ! sensible heat exchange coefficient bare-ground + real(kind=kind_noahmp), allocatable, dimension(:) :: shgxy ! veg ground sen. heat [W/m2] [+ to atm] + real(kind=kind_noahmp), allocatable, dimension(:) :: shcxy ! canopy sen. heat [W/m2] [+ to atm] + real(kind=kind_noahmp), allocatable, dimension(:) :: shbxy ! bare sensible heat [W/m2] [+ to atm] + real(kind=kind_noahmp), allocatable, dimension(:) :: evgxy ! veg ground evap. heat [W/m2] [+ to atm] + real(kind=kind_noahmp), allocatable, dimension(:) :: evbxy ! bare soil evaporation [W/m2] [+ to atm] + real(kind=kind_noahmp), allocatable, dimension(:) :: ghvxy ! veg ground heat flux [W/m2] [+ to soil] + real(kind=kind_noahmp), allocatable, dimension(:) :: ghbxy ! bare ground heat flux [W/m2] [+ to soil] + real(kind=kind_noahmp), allocatable, dimension(:) :: irgxy ! veg ground net lw rad. [W/m2] [+ to atm] + real(kind=kind_noahmp), allocatable, dimension(:) :: ircxy ! canopy net lw rad. [W/m2] [+ to atm] + real(kind=kind_noahmp), allocatable, dimension(:) :: irbxy ! bare net longwave rad. [W/m2] [+ to atm] + real(kind=kind_noahmp), allocatable, dimension(:) :: trxy ! transpiration [W/m2] [+ to atm] + real(kind=kind_noahmp), allocatable, dimension(:) :: evcxy ! canopy evaporation heat [W/m2] [+ to atm] + real(kind=kind_noahmp), allocatable, dimension(:) :: chleafxy ! leaf exchange coefficient + real(kind=kind_noahmp), allocatable, dimension(:) :: chucxy ! under canopy exchange coefficient + real(kind=kind_noahmp), allocatable, dimension(:) :: chv2xy ! veg 2m exchange coefficient + real(kind=kind_noahmp), allocatable, dimension(:) :: chb2xy ! bare 2m exchange coefficient + real(kind=kind_noahmp), allocatable, dimension(:) :: rs ! total stomatal resistance [s/m] + real(kind=kind_noahmp), allocatable, dimension(:) :: z0 ! roughness length output to wrf + real(kind=kind_noahmp), allocatable, dimension(:) :: znt ! roughness length output to wrf + real(kind=kind_noahmp), allocatable, dimension(:) :: qtdrain ! tile drain discharge [mm] + + ! additional output variables + real(kind=kind_noahmp), allocatable, dimension(:) :: pahxy ! precipitation advected heat [W/m2] + real(kind=kind_noahmp), allocatable, dimension(:) :: pahgxy ! precipitation advected heat [W/m2] + real(kind=kind_noahmp), allocatable, dimension(:) :: pahbxy ! precipitation advected heat [W/m2] + real(kind=kind_noahmp), allocatable, dimension(:) :: pahvxy ! precipitation advected heat [W/m2] + real(kind=kind_noahmp), allocatable, dimension(:) :: qintsxy ! canopy intercepted snow [mm/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: qintrxy ! canopy intercepted rain [mm/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: qdripsxy ! canopy dripping snow [mm/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: qdriprxy ! canopy dripping rain [mm/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: qthrosxy ! canopy throughfall snow [mm/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: qthrorxy ! canopy throughfall rain [mm/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: qsnsubxy ! snowpack sublimation rate [mm/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: qmeltxy ! snowpack melting rate due to phase change [mm/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: qsnfroxy ! snowpack frost rate [mm/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: qsubcxy ! canopy snow sublimation rate [mm/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: qfrocxy ! canopy snow frost rate [mm/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: qevacxy ! canopy water evaporation rate [mm/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: qdewcxy ! canopy water dew rate [mm/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: qfrzcxy ! canopy water freezing rate [mm/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: qmeltcxy ! canopy snow melting rate [mm/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: qsnbotxy ! total water (melt+rain through snow) out of snowpack bottom [mm/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: pondingxy ! total surface ponding [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: fpicexy ! fraction of ice in total precipitation + real(kind=kind_noahmp), allocatable, dimension(:) :: rainlsm ! total rain rate at the surface [mm/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: snowlsm ! total snow rate at the surface [mm/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: forctlsm ! surface temperature as lsm forcing [K] + real(kind=kind_noahmp), allocatable, dimension(:) :: forcqlsm ! surface specific humidity as lsm forcing [kg/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: forcplsm ! surface pressure as lsm forcing [Pa] + real(kind=kind_noahmp), allocatable, dimension(:) :: forczlsm ! reference height as lsm input [m] + real(kind=kind_noahmp), allocatable, dimension(:) :: forcwlsm ! surface wind speed as lsm forcing [m/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: acc_ssoilxy ! accumulated ground heat flux [W/m2 * dt_soil/dt_main] + real(kind=kind_noahmp), allocatable, dimension(:) :: acc_qinsurxy ! accumulated water flux into soil [m/s * dt_soil/dt_main] + real(kind=kind_noahmp), allocatable, dimension(:) :: acc_qsevaxy ! accumulated soil surface evaporation [m/s * dt_soil/dt_main] + real(kind=kind_noahmp), allocatable, dimension(:) :: eflxbxy ! accumulated heat flux through soil bottom per soil timestep [J/m2] + real(kind=kind_noahmp), allocatable, dimension(:) :: soilenergy ! energy content in soil relative to 273.16 [kJ/m2] + real(kind=kind_noahmp), allocatable, dimension(:) :: snowenergy ! energy content in snow relative to 273.16 [kJ/m2] + real(kind=kind_noahmp), allocatable, dimension(:) :: canhsxy ! canopy heat storage change [W/m2] + real(kind=kind_noahmp), allocatable, dimension(:) :: acc_dwaterxy ! accumulated snow,soil,canopy water change per soil timestep [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: acc_prcpxy ! accumulated precipitation per soil timestep [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: acc_ecanxy ! accumulated net canopy evaporation per soil timestep [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: acc_etranxy ! accumulated transpiration per soil timestep [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: acc_edirxy ! accumulated net ground (soil/snow) evaporation per soil timestep [mm] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: acc_etranixy ! accumualted transpiration rate within soil timestep [m/s * dt_soil/dt_main] + +!------------------------------------------------------------------------ +! Needed for MMF_RUNOFF (IOPT_RUN = 5); not part of MP driver in WRF +!------------------------------------------------------------------------ + + real(kind=kind_noahmp), allocatable, dimension(:) :: msftx ! mapping factor x + real(kind=kind_noahmp), allocatable, dimension(:) :: msfty ! mapping factor y + real(kind=kind_noahmp), allocatable, dimension(:) :: eqzwt ! equilibrium water table + real(kind=kind_noahmp), allocatable, dimension(:) :: riverbedxy ! riverbed depth + real(kind=kind_noahmp), allocatable, dimension(:) :: rivercondxy ! river conductivity + real(kind=kind_noahmp), allocatable, dimension(:) :: pexpxy ! exponential factor + real(kind=kind_noahmp), allocatable, dimension(:) :: fdepthxy ! depth + real(kind=kind_noahmp), allocatable, dimension(:) :: areaxy ! river area + real(kind=kind_noahmp), allocatable, dimension(:) :: qrfsxy ! accumulated groundwater baseflow [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: qspringsxy ! accumulated seeping water [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: qrfxy ! groundwater baselow [m] + real(kind=kind_noahmp), allocatable, dimension(:) :: qspringxy ! seeping water [m] + real(kind=kind_noahmp), allocatable, dimension(:) :: qslatxy ! accumulated lateral flow [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: qlatxy ! lateral flow [m] + real(kind=kind_noahmp), allocatable, dimension(:) :: rechclim ! climatology recharge + real(kind=kind_noahmp), allocatable, dimension(:) :: rivermask ! river mask + real(kind=kind_noahmp), allocatable, dimension(:) :: nonriverxy ! non-river portion + real(kind=kind_noahmp) :: wtddt = 30.0 ! frequency of groundwater call [minutes] + integer :: stepwtd ! step of groundwater call + +!------------------------------------------------------------------------ +! Needed for TILE DRAINAGE IF IOPT_TDRN = 1 OR 2 +!------------------------------------------------------------------------ + real(kind=kind_noahmp), allocatable, dimension(:) :: td_fraction ! tile drainage fraction + +!------------------------------------------------------------------------ +! Needed for crop model (OPT_CROP=1) +!------------------------------------------------------------------------ + + integer, allocatable, dimension(:) :: pgsxy ! plant growth stage + integer, allocatable, dimension(:) :: cropcat ! crop category + real(kind=kind_noahmp), allocatable, dimension(:) :: planting ! planting day + real(kind=kind_noahmp), allocatable, dimension(:) :: harvest ! harvest day + real(kind=kind_noahmp), allocatable, dimension(:) :: season_gdd ! seasonal gdd + real(kind=kind_noahmp), allocatable, dimension(:,:) :: croptype ! crop type + +!------------------------------------------------------------------------ +! Single- and Multi-layer Urban Models +!------------------------------------------------------------------------ + + integer :: num_urban_atmosphere ! atmospheric levels including ZLVL for BEP/BEM models + integer :: iri_urban ! urban irrigation flag (move from module_sf_urban to here) + real(kind=kind_noahmp) :: gmt ! hour of day (fractional) (needed for urban) + integer :: julday ! integer day (needed for urban) + real(kind=kind_noahmp), allocatable, dimension(:) :: hrang ! hour angle (needed for urban) + real(kind=kind_noahmp) :: declin ! declination (needed for urban) + integer :: num_roof_layers = 4 ! roof layer number + integer :: num_road_layers = 4 ! road layer number + integer :: num_wall_layers = 4 ! wall layer number + real(kind=kind_noahmp), allocatable, dimension(:) :: cmr_sfcdif + real(kind=kind_noahmp), allocatable, dimension(:) :: chr_sfcdif + real(kind=kind_noahmp), allocatable, dimension(:) :: cmc_sfcdif + real(kind=kind_noahmp), allocatable, dimension(:) :: chc_sfcdif + real(kind=kind_noahmp), allocatable, dimension(:) :: cmgr_sfcdif + real(kind=kind_noahmp), allocatable, dimension(:) :: chgr_sfcdif + real(kind=kind_noahmp), allocatable, dimension(:) :: tr_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: tb_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: tg_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: tc_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: qc_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: uc_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: xxxr_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: xxxb_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: xxxg_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: xxxc_urb2d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: trl_urb3d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: tbl_urb3d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: tgl_urb3d + real(kind=kind_noahmp), allocatable, dimension(:) :: sh_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: lh_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: g_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: rn_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: ts_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: psim_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: psih_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: u10_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: v10_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: gz1oz0_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: akms_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: th2_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: q2_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: ust_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: dzr + real(kind=kind_noahmp), allocatable, dimension(:) :: dzb + real(kind=kind_noahmp), allocatable, dimension(:) :: dzg + real(kind=kind_noahmp), allocatable, dimension(:) :: cmcr_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: tgr_urb2d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: tgrl_urb3d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: smr_urb3d + real(kind=kind_noahmp), allocatable, dimension(:) :: drelr_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: drelb_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: drelg_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: flxhumr_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: flxhumb_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: flxhumg_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: frc_urb2d + integer, allocatable, dimension(:) :: utype_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: chs + real(kind=kind_noahmp), allocatable, dimension(:) :: chs2 + real(kind=kind_noahmp), allocatable, dimension(:) :: cqs2 + real(kind=kind_noahmp), allocatable, dimension(:,:) :: trb_urb4d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: tw1_urb4d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: tw2_urb4d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: tgb_urb4d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: tlev_urb3d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: qlev_urb3d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: tw1lev_urb3d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: tw2lev_urb3d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: tglev_urb3d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: tflev_urb3d + real(kind=kind_noahmp), allocatable, dimension(:) :: sf_ac_urb3d + real(kind=kind_noahmp), allocatable, dimension(:) :: lf_ac_urb3d + real(kind=kind_noahmp), allocatable, dimension(:) :: cm_ac_urb3d + real(kind=kind_noahmp), allocatable, dimension(:) :: sfvent_urb3d + real(kind=kind_noahmp), allocatable, dimension(:) :: lfvent_urb3d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: sfwin1_urb3d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: sfwin2_urb3d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: sfw1_urb3d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: sfw2_urb3d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: sfr_urb3d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: sfg_urb3d + real(kind=kind_noahmp), allocatable, dimension(:) :: lp_urb2d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: hi_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: lb_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: hgt_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: mh_urb2d + real(kind=kind_noahmp), allocatable, dimension(:) :: stdh_urb2d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: lf_urb2d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: theta_urban + real(kind=kind_noahmp), allocatable, dimension(:,:) :: u_urban + real(kind=kind_noahmp), allocatable, dimension(:,:) :: v_urban + real(kind=kind_noahmp), allocatable, dimension(:,:) :: dz_urban + real(kind=kind_noahmp), allocatable, dimension(:,:) :: rho_urban + real(kind=kind_noahmp), allocatable, dimension(:,:) :: p_urban + real(kind=kind_noahmp), allocatable, dimension(:) :: ust + real(kind=kind_noahmp), allocatable, dimension(:,:) :: a_u_bep + real(kind=kind_noahmp), allocatable, dimension(:,:) :: a_v_bep + real(kind=kind_noahmp), allocatable, dimension(:,:) :: a_t_bep + real(kind=kind_noahmp), allocatable, dimension(:,:) :: a_q_bep + real(kind=kind_noahmp), allocatable, dimension(:,:) :: a_e_bep + real(kind=kind_noahmp), allocatable, dimension(:,:) :: b_u_bep + real(kind=kind_noahmp), allocatable, dimension(:,:) :: b_v_bep + real(kind=kind_noahmp), allocatable, dimension(:,:) :: b_t_bep + real(kind=kind_noahmp), allocatable, dimension(:,:) :: b_q_bep + real(kind=kind_noahmp), allocatable, dimension(:,:) :: b_e_bep + real(kind=kind_noahmp), allocatable, dimension(:,:) :: dlg_bep + real(kind=kind_noahmp), allocatable, dimension(:,:) :: dl_u_bep + real(kind=kind_noahmp), allocatable, dimension(:,:) :: sf_bep + real(kind=kind_noahmp), allocatable, dimension(:,:) :: vl_bep + real(kind=kind_noahmp) :: height_urban + + ! new urban variables for green roof, PVP for BEP_BEM scheme=3, Zonato et al., 2021 + real(kind=kind_noahmp), allocatable, dimension(:) :: ep_pv_urb3d + real(kind=kind_noahmp), allocatable, dimension(:) :: qgr_urb3d + real(kind=kind_noahmp), allocatable, dimension(:) :: tgr_urb3d + real(kind=kind_noahmp), allocatable, dimension(:) :: draingr_urb3d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: t_pv_urb3d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: trv_urb4d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: qr_urb4d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: drain_urb4d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: sfrv_urb3d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: lfrv_urb3d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: dgr_urb3d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: dg_urb3d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: lfr_urb3d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: lfg_urb3d + real(kind=kind_noahmp), allocatable, dimension(:) :: swddir ! solar down at surface [w m-2] + real(kind=kind_noahmp), allocatable, dimension(:) :: swddif + +!------------------------------------------------------------------------ +! 2D variables not used in WRF - should be removed? +!------------------------------------------------------------------------ + + real(kind=kind_noahmp), allocatable, dimension(:) :: xlong ! longitude + real(kind=kind_noahmp), allocatable, dimension(:) :: terrain ! terrain height + real(kind=kind_noahmp), allocatable, dimension(:) :: gvfmin ! annual minimum in vegetation fraction + real(kind=kind_noahmp), allocatable, dimension(:) :: gvfmax ! annual maximum in vegetation fraction + +!------------------------------------------------------------------------ +! End 2D variables not used in WRF +!------------------------------------------------------------------------ + + CHARACTER(LEN=256) :: mminsl = 'STAS' ! soil classification + CHARACTER(LEN=256) :: llanduse ! (=USGS, using USGS landuse classification) + +!------------------------------------------------------------------------ +! Timing: +!------------------------------------------------------------------------ + + integer :: ntime ! timesteps + integer :: clock_count_1 = 0 + integer :: clock_count_2 = 0 + integer :: clock_rate = 0 + real(kind=kind_noahmp) :: timing_sum = 0.0 + integer :: sflx_count_sum + integer :: count_before_sflx + integer :: count_after_sflx + +!--------------------------------------------------------------------- +! DECLARE/Initialize constants +!--------------------------------------------------------------------- + + integer :: i + integer :: j + integer :: slopetyp + integer :: yearlen + integer :: nsnow + logical :: update_lai, update_veg + integer :: spinup_loop + logical :: reset_spinup_date + +!--------------------------------------------------------------------- +! File naming, parallel +!--------------------------------------------------------------------- + + character(len=19) :: olddate, & + newdate, & + startdate + character :: hgrid + integer :: igrid + logical :: lexist + integer :: imode + integer :: ixfull + integer :: jxfull + integer :: ixpar + integer :: jxpar + integer :: ystartpar + integer :: rank = 0 + character(len=256) :: inflnm, & + outflnm, & + inflnm_template + logical :: restart_flag + character(len=256) :: restart_flnm + integer :: ierr + +!--------------------------------------------------------------------- +! Attributes from LDASIN input file (or HRLDAS_SETUP_FILE, as the case may be) +!--------------------------------------------------------------------- + + integer :: ix + integer :: jx + real(kind=kind_noahmp) :: dy + real(kind=kind_noahmp) :: truelat1 + real(kind=kind_noahmp) :: truelat2 + real(kind=kind_noahmp) :: cen_lon + integer :: mapproj + real(kind=kind_noahmp) :: lat1 + real(kind=kind_noahmp) :: lon1 + +!--------------------------------------------------------------------- +! NAMELIST start +!--------------------------------------------------------------------- + + character(len=256) :: indir + ! nsoil defined above + integer :: forcing_timestep + integer :: noah_timestep + integer :: start_year + integer :: start_month + integer :: start_day + integer :: start_hour + integer :: start_min + character(len=256) :: outdir + character(len=256) :: restart_filename_requested + integer :: restart_frequency_hours + integer :: output_timestep + integer :: spinup_loops + + integer :: sf_urban_physics + integer :: use_wudapt_lcz + integer :: num_urban_ndm + integer :: num_urban_ng + integer :: num_urban_nwr + integer :: num_urban_ngb + integer :: num_urban_nf + integer :: num_urban_nz + integer :: num_urban_nbui + integer :: num_urban_hi + integer :: num_urban_ngr + real(kind=kind_noahmp) :: urban_atmosphere_thickness + + ! derived urban dimensions + integer :: urban_map_zrd + integer :: urban_map_zwd + integer :: urban_map_gd + integer :: urban_map_zd + integer :: urban_map_zdf + integer :: urban_map_bd + integer :: urban_map_wd + integer :: urban_map_gbd + integer :: urban_map_fbd + integer :: urban_map_zgrd + integer :: max_urban_dim ! C. He: maximum urban dimension for urban variable + + character(len=256) :: forcing_name_T + character(len=256) :: forcing_name_Q + character(len=256) :: forcing_name_U + character(len=256) :: forcing_name_V + character(len=256) :: forcing_name_P + character(len=256) :: forcing_name_LW + character(len=256) :: forcing_name_SW + character(len=256) :: forcing_name_PR + character(len=256) :: forcing_name_SN + + integer :: noahmp_output ! =0: default output; >0 include additional output + integer :: split_output_count + logical :: skip_first_output + integer :: khour + integer :: kday + real(kind=kind_noahmp) :: zlvl + character(len=256) :: hrldas_setup_file + character(len=256) :: spatial_filename + character(len=256) :: external_veg_filename_template + character(len=256) :: external_lai_filename_template + character(len=256) :: agdata_flnm + character(len=256) :: tdinput_flnm + integer :: MAX_SOIL_LEVELS + real(kind=kind_noahmp), allocatable, dimension(:) :: soil_thick_input + +!---------------------------------------------------------------- +! Noahmp Parameters Table +!---------------------------------------------------------------- + + ! vegetation parameters + character(len=256) :: veg_dataset_description_table + integer :: nveg_table ! number of vegetation types + integer :: isurban_table ! urban flag + integer :: iswater_table ! water flag + integer :: isbarren_table ! barren ground flag + integer :: isice_table ! ice flag + integer :: iscrop_table ! cropland flag + integer :: eblforest_table ! evergreen broadleaf forest flag + integer :: natural_table ! natural vegetation type + integer :: lcz_1_table ! urban lcz 1 + integer :: lcz_2_table ! urban lcz 2 + integer :: lcz_3_table ! urban lcz 3 + integer :: lcz_4_table ! urban lcz 4 + integer :: lcz_5_table ! urban lcz 5 + integer :: lcz_6_table ! urban lcz 6 + integer :: lcz_7_table ! urban lcz 7 + integer :: lcz_8_table ! urban lcz 8 + integer :: lcz_9_table ! urban lcz 9 + integer :: lcz_10_table ! urban lcz 10 + integer :: lcz_11_table ! urban lcz 11 + real(kind=kind_noahmp), allocatable, dimension(:) :: ch2op_table ! maximum intercepted h2o per unit lai+sai (mm) + real(kind=kind_noahmp), allocatable, dimension(:) :: dleaf_table ! characteristic leaf dimension (m) + real(kind=kind_noahmp), allocatable, dimension(:) :: z0mvt_table ! momentum roughness length (m) + real(kind=kind_noahmp), allocatable, dimension(:) :: hvt_table ! top of canopy (m) + real(kind=kind_noahmp), allocatable, dimension(:) :: hvb_table ! bottom of canopy (m) + real(kind=kind_noahmp), allocatable, dimension(:) :: den_table ! tree density (no. of trunks per m2) + real(kind=kind_noahmp), allocatable, dimension(:) :: rc_table ! tree crown radius (m) + real(kind=kind_noahmp), allocatable, dimension(:) :: mfsno_table ! snowmelt curve parameter + real(kind=kind_noahmp), allocatable, dimension(:) :: scffac_table ! snow cover factor (m) (replace original hard-coded 2.5*z0 in SCF formulation) + real(kind=kind_noahmp), allocatable, dimension(:) :: cbiom_table ! canopy biomass heat capacity parameter (m) + real(kind=kind_noahmp), allocatable, dimension(:,:) :: saim_table ! monthly stem area index, one-sided + real(kind=kind_noahmp), allocatable, dimension(:,:) :: laim_table ! monthly leaf area index, one-sided + real(kind=kind_noahmp), allocatable, dimension(:) :: sla_table ! single-side leaf area per kg [m2/kg] + real(kind=kind_noahmp), allocatable, dimension(:) :: dilefc_table ! coeficient for leaf stress death [1/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: dilefw_table ! coeficient for leaf stress death [1/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: fragr_table ! fraction of growth respiration !original was 0.3 + real(kind=kind_noahmp), allocatable, dimension(:) :: ltovrc_table ! leaf turnover [1/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: c3psn_table ! photosynthetic pathway: 0. = c4, 1. = c3 + real(kind=kind_noahmp), allocatable, dimension(:) :: kc25_table ! co2 michaelis-menten constant at 25C (Pa) + real(kind=kind_noahmp), allocatable, dimension(:) :: akc_table ! q10 for kc25 + real(kind=kind_noahmp), allocatable, dimension(:) :: ko25_table ! o2 michaelis-menten constant at 25C (Pa) + real(kind=kind_noahmp), allocatable, dimension(:) :: ako_table ! q10 for ko25 + real(kind=kind_noahmp), allocatable, dimension(:) :: vcmx25_table ! maximum rate of carboxylation at 25C (umol CO2/m2/s) + real(kind=kind_noahmp), allocatable, dimension(:) :: avcmx_table ! q10 for vcmx25 + real(kind=kind_noahmp), allocatable, dimension(:) :: bp_table ! minimum leaf conductance (umol/m2/s) + real(kind=kind_noahmp), allocatable, dimension(:) :: mp_table ! slope of conductance-to-photosynthesis relationship + real(kind=kind_noahmp), allocatable, dimension(:) :: qe25_table ! quantum efficiency at 25C (umol CO2 / umol photon) + real(kind=kind_noahmp), allocatable, dimension(:) :: aqe_table ! q10 for qe25 + real(kind=kind_noahmp), allocatable, dimension(:) :: rmf25_table ! leaf maintenance respiration at 25C (umol CO2/m2/s) + real(kind=kind_noahmp), allocatable, dimension(:) :: rms25_table ! stem maintenance respiration at 25C (umol CO2/kg bio/s) + real(kind=kind_noahmp), allocatable, dimension(:) :: rmr25_table ! root maintenance respiration at 25C (umol CO2/kg bio/s) + real(kind=kind_noahmp), allocatable, dimension(:) :: arm_table ! q10 for maintenance respiration + real(kind=kind_noahmp), allocatable, dimension(:) :: folnmx_table ! foliage nitrogen concentration when f(n)=1 (%) + real(kind=kind_noahmp), allocatable, dimension(:) :: tmin_table ! minimum temperature for photosynthesis (K) + real(kind=kind_noahmp), allocatable, dimension(:) :: xl_table ! leaf/stem orientation index + real(kind=kind_noahmp), allocatable, dimension(:,:) :: rhol_table ! leaf reflectance: 1=vis, 2=nir + real(kind=kind_noahmp), allocatable, dimension(:,:) :: rhos_table ! stem reflectance: 1=vis, 2=nir + real(kind=kind_noahmp), allocatable, dimension(:,:) :: taul_table ! leaf transmittance: 1=vis, 2=nir + real(kind=kind_noahmp), allocatable, dimension(:,:) :: taus_table ! stem transmittance: 1=vis, 2=nir + real(kind=kind_noahmp), allocatable, dimension(:) :: mrp_table ! microbial respiration parameter (umol CO2 /kg c/ s) + real(kind=kind_noahmp), allocatable, dimension(:) :: cwpvt_table ! empirical canopy wind parameter + real(kind=kind_noahmp), allocatable, dimension(:) :: wrrat_table ! wood to non-wood ratio + real(kind=kind_noahmp), allocatable, dimension(:) :: wdpool_table ! wood pool (switch 1 or 0) depending on woody or not [-] + real(kind=kind_noahmp), allocatable, dimension(:) :: tdlef_table ! characteristic t for leaf freezing [K] + real(kind=kind_noahmp), allocatable, dimension(:) :: nroot_table ! number of soil layers with root present + real(kind=kind_noahmp), allocatable, dimension(:) :: rgl_table ! parameter used in radiation stress function + real(kind=kind_noahmp), allocatable, dimension(:) :: rs_table ! minimum stomatal resistance [s m-1] + real(kind=kind_noahmp), allocatable, dimension(:) :: hs_table ! parameter used in vapor pressure deficit function + real(kind=kind_noahmp), allocatable, dimension(:) :: topt_table ! optimum transpiration air temperature [K] + real(kind=kind_noahmp), allocatable, dimension(:) :: rsmax_table ! maximal stomatal resistance [s m-1] + real(kind=kind_noahmp), allocatable, dimension(:) :: rtovrc_table ! root turnover coefficient [1/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: rswoodc_table ! wood respiration coeficient [1/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: bf_table ! parameter for present wood allocation [-] + real(kind=kind_noahmp), allocatable, dimension(:) :: wstrc_table ! water stress coeficient [-] + real(kind=kind_noahmp), allocatable, dimension(:) :: laimin_table ! minimum leaf area index [m2/m2] + real(kind=kind_noahmp), allocatable, dimension(:) :: xsamin_table ! minimum stem area index [m2/m2] + + ! radiation parameters + real(kind=kind_noahmp), allocatable, dimension(:,:) :: albsat_table ! saturated soil albedos: 1=vis, 2=nir + real(kind=kind_noahmp), allocatable, dimension(:,:) :: albdry_table ! dry soil albedos: 1=vis, 2=nir + real(kind=kind_noahmp), allocatable, dimension(:) :: albice_table ! albedo land ice: 1=vis, 2=nir + real(kind=kind_noahmp), allocatable, dimension(:) :: alblak_table ! albedo frozen lakes: 1=vis, 2=nir + real(kind=kind_noahmp), allocatable, dimension(:) :: omegas_table ! two-stream parameter omega for snow + real(kind=kind_noahmp) :: betads_table ! two-stream parameter betad for snow + real(kind=kind_noahmp) :: betais_table ! two-stream parameter betad for snow + real(kind=kind_noahmp), allocatable, dimension(:) :: eg_table ! emissivity soil surface + real(kind=kind_noahmp) :: eice_table ! ice surface emissivity + + ! global parameters + real(kind=kind_noahmp) :: co2_table ! co2 partial pressure + real(kind=kind_noahmp) :: o2_table ! o2 partial pressure + real(kind=kind_noahmp) :: timean_table ! gridcell mean topgraphic index (global mean) + real(kind=kind_noahmp) :: fsatmx_table ! maximum surface saturated fraction (global mean) + real(kind=kind_noahmp) :: z0sno_table ! snow surface roughness length (m) (0.002) + real(kind=kind_noahmp) :: ssi_table ! liquid water holding capacity for snowpack (m3/m3) (0.03) + real(kind=kind_noahmp) :: snow_ret_fac_table ! snowpack water release timescale factor (1/s) + real(kind=kind_noahmp) :: snow_emis_table ! snow emissivity + real(kind=kind_noahmp) :: swemx_table ! new snow mass to fully cover old snow (mm) + real(kind=kind_noahmp) :: tau0_table ! tau0 from Yang97 eqn. 10a + real(kind=kind_noahmp) :: grain_growth_table ! growth from vapor diffusion Yang97 eqn. 10b + real(kind=kind_noahmp) :: extra_growth_table ! extra growth near freezing Yang97 eqn. 10c + real(kind=kind_noahmp) :: dirt_soot_table ! dirt and soot term Yang97 eqn. 10d + real(kind=kind_noahmp) :: bats_cosz_table ! zenith angle snow albedo adjustment; b in Yang97 eqn. 15 + real(kind=kind_noahmp) :: bats_vis_new_table ! new snow visible albedo + real(kind=kind_noahmp) :: bats_nir_new_table ! new snow nir albedo + real(kind=kind_noahmp) :: bats_vis_age_table ! age factor for diffuse visible snow albedo Yang97 eqn. 17 + real(kind=kind_noahmp) :: bats_nir_age_table ! age factor for diffuse nir snow albedo Yang97 eqn. 18 + real(kind=kind_noahmp) :: bats_vis_dir_table ! cosz factor for direct visible snow albedo Yang97 eqn. 15 + real(kind=kind_noahmp) :: bats_nir_dir_table ! cosz factor for direct nir snow albedo Yang97 eqn. 16 + real(kind=kind_noahmp) :: rsurf_snow_table ! surface resistance for snow(s/m) + real(kind=kind_noahmp) :: rsurf_exp_table ! exponent in the shape parameter for soil resistance option 1 + real(kind=kind_noahmp) :: c2_snowcompact_table ! overburden snow compaction parameter (m3/kg) + real(kind=kind_noahmp) :: c3_snowcompact_table ! snow desctructive metamorphism compaction parameter1 [1/s] + real(kind=kind_noahmp) :: c4_snowcompact_table ! snow desctructive metamorphism compaction parameter2 [1/k] + real(kind=kind_noahmp) :: c5_snowcompact_table ! snow desctructive metamorphism compaction parameter3 + real(kind=kind_noahmp) :: dm_snowcompact_table ! upper limit on destructive metamorphism compaction [kg/m3] + real(kind=kind_noahmp) :: eta0_snowcompact_table ! snow viscosity coefficient [kg-s/m2] + real(kind=kind_noahmp) :: snliqmaxfrac_table ! maximum liquid water fraction in snow + real(kind=kind_noahmp) :: swemaxgla_table ! maximum swe allowed at glaciers (mm) + real(kind=kind_noahmp) :: wslmax_table ! maximum lake water storage (mm) + real(kind=kind_noahmp) :: rous_table ! specific yield [-] for Niu et al. 2007 groundwater scheme + real(kind=kind_noahmp) :: cmic_table ! microprore content (0.0-1.0), 0.0: close to free drainage + real(kind=kind_noahmp) :: snowden_max_table ! maximum fresh snowfall density (kg/m3) + real(kind=kind_noahmp) :: class_alb_ref_table ! reference snow albedo in class scheme + real(kind=kind_noahmp) :: class_sno_age_table ! snow aging e-folding time (s) in class albedo scheme + real(kind=kind_noahmp) :: class_alb_new_table ! fresh snow albedo in class scheme + real(kind=kind_noahmp) :: psiwlt_table ! soil metric potential for wilting point (m) + real(kind=kind_noahmp) :: z0soil_table ! bare-soil roughness length (m) (i.e., under the canopy) + real(kind=kind_noahmp) :: z0lake_table ! lake surface roughness length (m) + + ! irrigation parameters + integer :: irr_har_table ! number of days before harvest date to stop irrigation + real(kind=kind_noahmp) :: irr_frac_table ! irrigation fraction + real(kind=kind_noahmp) :: irr_lai_table ! minimum lai to trigger irrigation + real(kind=kind_noahmp) :: irr_mad_table ! management allowable deficit (0-1) + real(kind=kind_noahmp) :: filoss_table ! factor of flood irrigation loss + real(kind=kind_noahmp) :: sprir_rate_table ! mm/h, sprinkler irrigation rate + real(kind=kind_noahmp) :: micir_rate_table ! mm/h, micro irrigation rate + real(kind=kind_noahmp) :: firtfac_table ! flood application rate factor + real(kind=kind_noahmp) :: ir_rain_table ! maximum precipitation to stop irrigation trigger + + ! tile drainage parameters + integer :: drain_layer_opt_table ! tile drainage layer + integer , allocatable, dimension(:) :: td_depth_table ! tile drainage depth (layer number) from soil surface + real(kind=kind_noahmp), allocatable, dimension(:) :: tdsmc_fac_table ! tile drainage soil moisture factor + real(kind=kind_noahmp), allocatable, dimension(:) :: td_dc_table ! tile drainage coefficient [mm/d] + real(kind=kind_noahmp), allocatable, dimension(:) :: td_dcoef_table ! tile drainage coefficient [mm/d] + real(kind=kind_noahmp), allocatable, dimension(:) :: td_d_table ! depth to impervious layer from drain water level [m] + real(kind=kind_noahmp), allocatable, dimension(:) :: td_adepth_table ! actual depth of impervious layer from land surface [m] + real(kind=kind_noahmp), allocatable, dimension(:) :: td_radi_table ! effective radius of drain tubes [m] + real(kind=kind_noahmp), allocatable, dimension(:) :: td_spac_table ! distance between two drain tubes or tiles [m] + real(kind=kind_noahmp), allocatable, dimension(:) :: td_ddrain_table ! tile drainage depth [m] + real(kind=kind_noahmp), allocatable, dimension(:) :: klat_fac_table ! hydraulic conductivity mutiplification factor + + ! crop parameters + integer :: default_crop_table ! default crop index + integer , allocatable, dimension(:) :: pltday_table ! planting date + integer , allocatable, dimension(:) :: hsday_table ! harvest date + real(kind=kind_noahmp), allocatable, dimension(:) :: plantpop_table ! plant density [per ha] - used? + real(kind=kind_noahmp), allocatable, dimension(:) :: irri_table ! irrigation strategy 0= non-irrigation 1=irrigation (no water-stress) + real(kind=kind_noahmp), allocatable, dimension(:) :: gddtbase_table ! base temperature for gdd accumulation [C] + real(kind=kind_noahmp), allocatable, dimension(:) :: gddtcut_table ! upper temperature for gdd accumulation [C] + real(kind=kind_noahmp), allocatable, dimension(:) :: gdds1_table ! gdd from seeding to emergence + real(kind=kind_noahmp), allocatable, dimension(:) :: gdds2_table ! gdd from seeding to initial vegetative + real(kind=kind_noahmp), allocatable, dimension(:) :: gdds3_table ! gdd from seeding to post vegetative + real(kind=kind_noahmp), allocatable, dimension(:) :: gdds4_table ! gdd from seeding to intial reproductive + real(kind=kind_noahmp), allocatable, dimension(:) :: gdds5_table ! gdd from seeding to pysical maturity + real(kind=kind_noahmp), allocatable, dimension(:) :: c3psni_table ! photosynthetic pathway: 0. = c4, 1. = c3 ! Zhe Zhang 2020-07-03 + real(kind=kind_noahmp), allocatable, dimension(:) :: kc25i_table ! co2 michaelis-menten constant at 25c (Pa) + real(kind=kind_noahmp), allocatable, dimension(:) :: akci_table ! q10 for kc25 + real(kind=kind_noahmp), allocatable, dimension(:) :: ko25i_table ! o2 michaelis-menten constant at 25c (Pa) + real(kind=kind_noahmp), allocatable, dimension(:) :: akoi_table ! q10 for ko25 + real(kind=kind_noahmp), allocatable, dimension(:) :: vcmx25i_table ! maximum rate of carboxylation at 25c (umol CO2/m2/s) + real(kind=kind_noahmp), allocatable, dimension(:) :: avcmxi_table ! q10 for vcmx25 + real(kind=kind_noahmp), allocatable, dimension(:) :: bpi_table ! minimum leaf conductance (umol/m2/s) + real(kind=kind_noahmp), allocatable, dimension(:) :: mpi_table ! slope of conductance-to-photosynthesis relationship + real(kind=kind_noahmp), allocatable, dimension(:) :: qe25i_table ! quantum efficiency at 25c (umol CO2 / umol photon) + real(kind=kind_noahmp), allocatable, dimension(:) :: folnmxi_table ! foliage nitrogen concentration when f(n)=1 (%) + real(kind=kind_noahmp), allocatable, dimension(:) :: aref_table ! reference maximum CO2 assimulation rate + real(kind=kind_noahmp), allocatable, dimension(:) :: psnrf_table ! co2 assimulation reduction factor(0-1) (caused by non-modeled part, pest,weeds) + real(kind=kind_noahmp), allocatable, dimension(:) :: i2par_table ! fraction of incoming solar radiation to photosynthetically active radiation + real(kind=kind_noahmp), allocatable, dimension(:) :: tassim0_table ! minimum temperature for CO2 assimulation [C] + real(kind=kind_noahmp), allocatable, dimension(:) :: tassim1_table ! co2 assimulation linearly increasing until temperature reaches t1 [C] + real(kind=kind_noahmp), allocatable, dimension(:) :: tassim2_table ! co2 assmilation rate remain at aref until temperature reaches t2 [C] + real(kind=kind_noahmp), allocatable, dimension(:) :: k_table ! light extinction coefficient + real(kind=kind_noahmp), allocatable, dimension(:) :: epsi_table ! initial light use efficiency + real(kind=kind_noahmp), allocatable, dimension(:) :: q10mr_table ! q10 for maintainance respiration + real(kind=kind_noahmp), allocatable, dimension(:) :: lefreez_table ! characteristic t for leaf freezing [K] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: dile_fc_table ! coeficient for temperature leaf stress death [1/s] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: dile_fw_table ! coeficient for water leaf stress death [1/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: fra_gr_table ! fraction of growth respiration + real(kind=kind_noahmp), allocatable, dimension(:,:) :: lf_ovrc_table ! fraction of leaf turnover [1/s] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: st_ovrc_table ! fraction of stem turnover [1/s] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: rt_ovrc_table ! fraction of root tunrover [1/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: lfmr25_table ! leaf maintenance respiration at 25C [umol CO2/m2/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: stmr25_table ! stem maintenance respiration at 25C [umol CO2/kg bio/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: rtmr25_table ! root maintenance respiration at 25C [umol CO2/kg bio/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: grainmr25_table ! grain maintenance respiration at 25C [umol CO2/kg bio/s] + real(kind=kind_noahmp), allocatable, dimension(:,:) :: lfpt_table ! fraction of carbohydrate flux to leaf + real(kind=kind_noahmp), allocatable, dimension(:,:) :: stpt_table ! fraction of carbohydrate flux to stem + real(kind=kind_noahmp), allocatable, dimension(:,:) :: rtpt_table ! fraction of carbohydrate flux to root + real(kind=kind_noahmp), allocatable, dimension(:,:) :: grainpt_table ! fraction of carbohydrate flux to grain + real(kind=kind_noahmp), allocatable, dimension(:,:) :: lfct_table ! fraction of carbohydrate translocation from leaf to grain + real(kind=kind_noahmp), allocatable, dimension(:,:) :: stct_table ! fraction of carbohydrate translocation from stem to grain + real(kind=kind_noahmp), allocatable, dimension(:,:) :: rtct_table ! fraction of carbohydrate translocation from root to grain + real(kind=kind_noahmp), allocatable, dimension(:) :: bio2lai_table ! leaf area per living leaf biomass [m2/kg] + + ! soil parameters + integer :: slcats_table ! number of soil categories + real(kind=kind_noahmp), allocatable, dimension(:) :: bexp_table ! soil b parameter + real(kind=kind_noahmp), allocatable, dimension(:) :: smcdry_table ! dry soil moisture threshold + real(kind=kind_noahmp), allocatable, dimension(:) :: smcmax_table ! porosity, saturated value of soil moisture (volumetric) + real(kind=kind_noahmp), allocatable, dimension(:) :: smcref_table ! reference soil moisture (field capacity) (volumetric) + real(kind=kind_noahmp), allocatable, dimension(:) :: psisat_table ! saturated soil matric potential + real(kind=kind_noahmp), allocatable, dimension(:) :: dksat_table ! saturated soil hydraulic conductivity + real(kind=kind_noahmp), allocatable, dimension(:) :: dwsat_table ! saturated soil hydraulic diffusivity + real(kind=kind_noahmp), allocatable, dimension(:) :: smcwlt_table ! wilting point soil moisture (volumetric) + real(kind=kind_noahmp), allocatable, dimension(:) :: quartz_table ! soil quartz content + real(kind=kind_noahmp), allocatable, dimension(:) :: bvic_table ! vic model infiltration parameter (-) for opt_run=6 + real(kind=kind_noahmp), allocatable, dimension(:) :: axaj_table ! xinanjiang: tension water distribution inflection parameter [-] for opt_run=7 + real(kind=kind_noahmp), allocatable, dimension(:) :: bxaj_table ! xinanjiang: tension water distribution shape parameter [-] for opt_run=7 + real(kind=kind_noahmp), allocatable, dimension(:) :: xxaj_table ! xinanjiang: free water distribution shape parameter [-] for opt_run=7 + real(kind=kind_noahmp), allocatable, dimension(:) :: bdvic_table ! vic model infiltration parameter (-) + real(kind=kind_noahmp), allocatable, dimension(:) :: gdvic_table ! mean capilary drive (m) + real(kind=kind_noahmp), allocatable, dimension(:) :: bbvic_table ! heterogeniety parameter for dvic infiltration [-] + + ! general parameters + real(kind=kind_noahmp), allocatable, dimension(:) :: slope_table ! slope factor for soil drainage + real(kind=kind_noahmp) :: csoil_table ! Soil heat capacity [J m-3 K-1] + real(kind=kind_noahmp) :: refdk_table ! parameter in the surface runoff parameterization + real(kind=kind_noahmp) :: refkdt_table ! parameter in the surface runoff parameterization + real(kind=kind_noahmp) :: frzk_table ! frozen ground parameter + real(kind=kind_noahmp) :: zbot_table ! depth [m] of lower boundary soil temperature + real(kind=kind_noahmp) :: czil_table ! parameter used in the calculation of the roughness length for heat + + ! optional parameters + real(kind=kind_noahmp) :: sr2006_theta_1500t_a_TABLE ! sand coefficient + real(kind=kind_noahmp) :: sr2006_theta_1500t_b_TABLE ! clay coefficient + real(kind=kind_noahmp) :: sr2006_theta_1500t_c_TABLE ! orgm coefficient + real(kind=kind_noahmp) :: sr2006_theta_1500t_d_TABLE ! sand*orgm coefficient + real(kind=kind_noahmp) :: sr2006_theta_1500t_e_TABLE ! clay*orgm coefficient + real(kind=kind_noahmp) :: sr2006_theta_1500t_f_TABLE ! sand*clay coefficient + real(kind=kind_noahmp) :: sr2006_theta_1500t_g_TABLE ! constant adjustment + real(kind=kind_noahmp) :: sr2006_theta_1500_a_TABLE ! theta_1500t coefficient + real(kind=kind_noahmp) :: sr2006_theta_1500_b_TABLE ! constant adjustment + real(kind=kind_noahmp) :: sr2006_theta_33t_a_TABLE ! sand coefficient + real(kind=kind_noahmp) :: sr2006_theta_33t_b_TABLE ! clay coefficient + real(kind=kind_noahmp) :: sr2006_theta_33t_c_TABLE ! orgm coefficient + real(kind=kind_noahmp) :: sr2006_theta_33t_d_TABLE ! sand*orgm coefficient + real(kind=kind_noahmp) :: sr2006_theta_33t_e_TABLE ! clay*orgm coefficient + real(kind=kind_noahmp) :: sr2006_theta_33t_f_TABLE ! sand*clay coefficient + real(kind=kind_noahmp) :: sr2006_theta_33t_g_TABLE ! constant adjustment + real(kind=kind_noahmp) :: sr2006_theta_33_a_TABLE ! theta_33t*theta_33t coefficient + real(kind=kind_noahmp) :: sr2006_theta_33_b_TABLE ! theta_33t coefficient + real(kind=kind_noahmp) :: sr2006_theta_33_c_TABLE ! constant adjustment + real(kind=kind_noahmp) :: sr2006_theta_s33t_a_TABLE ! sand coefficient + real(kind=kind_noahmp) :: sr2006_theta_s33t_b_TABLE ! clay coefficient + real(kind=kind_noahmp) :: sr2006_theta_s33t_c_TABLE ! orgm coefficient + real(kind=kind_noahmp) :: sr2006_theta_s33t_d_TABLE ! sand*orgm coefficient + real(kind=kind_noahmp) :: sr2006_theta_s33t_e_TABLE ! clay*orgm coefficient + real(kind=kind_noahmp) :: sr2006_theta_s33t_f_TABLE ! sand*clay coefficient + real(kind=kind_noahmp) :: sr2006_theta_s33t_g_TABLE ! constant adjustment + real(kind=kind_noahmp) :: sr2006_theta_s33_a_TABLE ! theta_s33t coefficient + real(kind=kind_noahmp) :: sr2006_theta_s33_b_TABLE ! constant adjustment + real(kind=kind_noahmp) :: sr2006_psi_et_a_TABLE ! sand coefficient + real(kind=kind_noahmp) :: sr2006_psi_et_b_TABLE ! clay coefficient + real(kind=kind_noahmp) :: sr2006_psi_et_c_TABLE ! theta_s33 coefficient + real(kind=kind_noahmp) :: sr2006_psi_et_d_TABLE ! sand*theta_s33 coefficient + real(kind=kind_noahmp) :: sr2006_psi_et_e_TABLE ! clay*theta_s33 coefficient + real(kind=kind_noahmp) :: sr2006_psi_et_f_TABLE ! sand*clay coefficient + real(kind=kind_noahmp) :: sr2006_psi_et_g_TABLE ! constant adjustment + real(kind=kind_noahmp) :: sr2006_psi_e_a_TABLE ! psi_et*psi_et coefficient + real(kind=kind_noahmp) :: sr2006_psi_e_b_TABLE ! psi_et coefficient + real(kind=kind_noahmp) :: sr2006_psi_e_c_TABLE ! constant adjustment + real(kind=kind_noahmp) :: sr2006_smcmax_a_TABLE ! sand adjustment + real(kind=kind_noahmp) :: sr2006_smcmax_b_TABLE ! constant adjustment + + end type NoahmpIO_type + +end module NoahmpIOVarType diff --git a/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpInitMainMod.F90 b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpInitMainMod.F90 new file mode 100644 index 000000000..e23930562 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpInitMainMod.F90 @@ -0,0 +1,255 @@ + module NoahmpInitMainMod + +!!! Module to initialize Noah-MP 2-D variables + + use Machine + use NoahmpIOVarType + use NoahmpSnowInitMod + + implicit none + + contains + + subroutine NoahmpInitMain(NoahmpIO) + +! ------------------------ Code history ------------------------------------- +! Original Noah-MP subroutine: NOAHMP_INIT +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! --------------------------------------------------------------------------- + + implicit none + + type(NoahmpIO_type), intent(inout) :: NoahmpIO + +! local variables + integer :: its,ite + integer :: i,ns + integer :: errorflag + logical :: urbanpt_flag + real(kind=kind_noahmp) :: bexp, smcmax, psisat, fk + real(kind=kind_noahmp), parameter :: hlice = 3.335e5 + real(kind=kind_noahmp), parameter :: grav0 = 9.81 + real(kind=kind_noahmp), parameter :: t0 = 273.15 +! --------------------------------------------------------------------------- + +! only initialize for non-restart case: + if ( .not. NoahmpIO%restart_flag ) then + + its = NoahmpIO%its + ite = NoahmpIO%ite + + ! initialize physical snow height SNOWH + if ( .not. NoahmpIO%fndsnowh ) then + ! If no SNOWH do the following + print*, 'SNOW HEIGHT NOT FOUND - VALUE DEFINED IN LSMINIT' + do i = its, ite + NoahmpIO%snowh(i) = NoahmpIO%snow(i)*0.005 ! snow in mm and snowh in m. + enddo + endif + + ! Check if snow/snowh are consistent and cap SWE at 2000mm + ! the Noah-MP code does it internally but if we don't do it here, problems ensue + do i = its, ite + if ( NoahmpIO%snow(i) < 0.0 ) NoahmpIO%snow(i) = 0.0 + if ( NoahmpIO%snowh(i) < 0.0 ) NoahmpIO%snowh(i) = 0.0 + if ( (NoahmpIO%snow(i) > 0.0) .and. (NoahmpIO%snowh(i) == 0.0) ) & + NoahmpIO%snowh(i) = NoahmpIO%snow(i) * 0.005 + if ( (NoahmpIO%snowh(i) > 0.0) .and. (NoahmpIO%snow(i) == 0.0) ) & + NoahmpIO%snow(i) = NoahmpIO%snowh(i) / 0.005 + if ( NoahmpIO%snow(i) > 2000.0 ) then + NoahmpIO%snowh(i) = NoahmpIO%snowh(i) * 2000.0 / NoahmpIO%snow(i) !snow in mm and snowh in m. + NoahmpIO%snow (i) = 2000.0 !cap snow at 2000 to maintain + !density. + endif + enddo + + ! check soil type: + errorflag = 0 + do i = its, ite + if ( NoahmpIO%isltyp(i) < 1 ) then + errorflag = 1 + write(*,*) "LSMINIT: OUT OF RANGE ISLTYP ",i,NoahmpIO%isltyp(i) + stop + endif + enddo + + ! initialize soil liquid water content SH2O: + do i = its , ite + if ( (NoahmpIO%ivgtyp(i) == NoahmpIO%isice_table) .and. & + (NoahmpIO%xice(i) <= 0.0) ) then + do ns = 1, NoahmpIO%nsoil + NoahmpIO%smois(i,ns) = 1.0 ! glacier starts all frozen + NoahmpIO%sh2o(i,ns) = 0.0 + NoahmpIO%tslb(i,ns) = min(NoahmpIO%tslb(i,ns), 263.15) !set glacier temp to at most -10c + enddo + !NoahmpIO%tmn(i) = min(NoahmpIO%tmn(i), 263.15) !set deep temp to at most -10C + NoahmpIO%snow(i) = max(NoahmpIO%snow(i), 10.0) !set swe to at least 10mm + NoahmpIO%snowh(i) = NoahmpIO%snow(i) * 0.01 !snow in mm and snowh in m + else + bexp = NoahmpIO%bexp_table (NoahmpIO%isltyp(i)) + smcmax = NoahmpIO%smcmax_table(NoahmpIO%isltyp(i)) + psisat = NoahmpIO%psisat_table(NoahmpIO%isltyp(i)) + do ns = 1, NoahmpIO%nsoil + if ( NoahmpIO%smois(i,ns) > smcmax ) NoahmpIO%smois(i,ns) = smcmax + enddo + if ( (bexp > 0.0) .and. (smcmax > 0.0) .and. (psisat > 0.0) ) then + do ns = 1, NoahmpIO%nsoil + if ( NoahmpIO%tslb(i,ns) < 273.149 ) then + fk = (((hlice / (grav0*(-psisat))) * & + ((NoahmpIO%tslb(i,ns)-t0) / NoahmpIO%tslb(i,ns)))**(-1/bexp))*smcmax + fk = max(fk, 0.02) + NoahmpIO%sh2o(i,ns) = min(fk, NoahmpIO%smois(i,ns)) + else + NoahmpIO%sh2o(i,ns) = NoahmpIO%smois(i,ns) + endif + enddo + else + do ns = 1, NoahmpIO%nsoil + NoahmpIO%sh2o(i,ns) = NoahmpIO%smois(i,ns) + enddo + endif + endif + enddo + + ! initialize other quantities: + do i = its, ite + NoahmpIO%qtdrain(i) = 0.0 + NoahmpIO%tvxy(i) = NoahmpIO%tsk(i) + NoahmpIO%tgxy(i) = NoahmpIO%tsk(i) + if ( (NoahmpIO%snow(i) > 0.0) .and. (NoahmpIO%tsk(i) > t0) ) NoahmpIO%tvxy(i) = t0 + if ( (NoahmpIO%snow(i) > 0.0) .and. (NoahmpIO%tsk(i) > t0) ) NoahmpIO%tgxy(i) = t0 + + NoahmpIO%canwat(i) = 0.0 + NoahmpIO%canliqxy(i) = NoahmpIO%canwat(i) + NoahmpIO%canicexy(i) = 0.0 + NoahmpIO%eahxy(i) = 2000.0 + NoahmpIO%tahxy(i) = NoahmpIO%tsk(i) + NoahmpIO%t2mvxy(i) = NoahmpIO%tsk(i) + NoahmpIO%t2mbxy(i) = NoahmpIO%tsk(i) + NoahmpIO%t2mxy(i) = NoahmpIO%tsk(i) + if ( (NoahmpIO%snow(i) > 0.0) .and. (NoahmpIO%tsk(i) > t0) ) NoahmpIO%tahxy(i) = t0 + if ( (NoahmpIO%snow(i) > 0.0) .and. (NoahmpIO%tsk(i) > t0) ) NoahmpIO%t2mvxy(i) = t0 + if ( (NoahmpIO%snow(i) > 0.0) .and. (NoahmpIO%tsk(i) > t0) ) NoahmpIO%t2mbxy(i) = t0 + if ( (NoahmpIO%snow(i) > 0.0) .and. (NoahmpIO%tsk(i) > t0) ) NoahmpIO%t2mxy(i) = t0 + + NoahmpIO%cmxy(i) = 0.0 + NoahmpIO%chxy(i) = 0.0 + NoahmpIO%fwetxy(i) = 0.0 + NoahmpIO%sneqvoxy(i) = 0.0 + NoahmpIO%alboldxy(i) = 0.65 + NoahmpIO%qsnowxy(i) = 0.0 + NoahmpIO%qrainxy(i) = 0.0 + NoahmpIO%wslakexy(i) = 0.0 + + if ( NoahmpIO%iopt_runsub /= 5 ) then + NoahmpIO%waxy(i) = 4900.0 + NoahmpIO%wtxy(i) = NoahmpIO%waxy(i) + NoahmpIO%zwtxy(i) = (25.0 + 2.0) - NoahmpIO%waxy(i)/1000/0.2 + else + NoahmpIO%waxy(i) = 0.0 + NoahmpIO%wtxy(i) = 0.0 + endif + + urbanpt_flag = .false. + if ( (NoahmpIO%ivgtyp(i) == NoahmpIO%isurban_table) .or. & + (NoahmpIO%ivgtyp(i) > NoahmpIO%urbtype_beg) ) then + urbanpt_flag = .true. + endif + + if ( (NoahmpIO%ivgtyp(i) == NoahmpIO%isbarren_table) .or. & + (NoahmpIO%ivgtyp(i) == NoahmpIO%isice_table) .or. & + ((NoahmpIO%sf_urban_physics == 0) .and. (urbanpt_flag .eqv. .true.)) .or. & + (NoahmpIO%ivgtyp(i) == NoahmpIO%iswater_table )) then + NoahmpIO%lai(i) = 0.0 + NoahmpIO%xsaixy(i) = 0.0 + NoahmpIO%lfmassxy(i) = 0.0 + NoahmpIO%stmassxy(i) = 0.0 + NoahmpIO%rtmassxy(i) = 0.0 + NoahmpIO%woodxy(i) = 0.0 + NoahmpIO%stblcpxy(i) = 0.0 + NoahmpIO%fastcpxy(i) = 0.0 + NoahmpIO%grainxy(i) = 1.0e-10 + NoahmpIO%gddxy(i) = 0 + NoahmpIO%cropcat(i) = 0 + else + if ( (NoahmpIO%lai(i) > 100) .or. (NoahmpIO%lai(i) < 0) ) NoahmpIO%lai(i) = 0.0 + NoahmpIO%lai(i) = max(NoahmpIO%lai(i), 0.05) !at least start with 0.05 for arbitrary initialization (v3.7) + NoahmpIO%xsaixy(i) = max(0.1*NoahmpIO%lai(i), 0.05) !mb: arbitrarily initialize sai using input lai (v3.7) + NoahmpIO%lfmassxy(i) = NoahmpIO%lai(i) * 1000.0 / & + max(NoahmpIO%sla_table(NoahmpIO%ivgtyp(i)),1.0) !use lai to initialize (v3.7) + NoahmpIO%stmassxy(i) = NoahmpIO%xsaixy(i) * 1000.0 / 3.0 !use sai to initialize (v3.7) + NoahmpIO%rtmassxy(i) = 500.0 !these are all arbitrary and probably should be + NoahmpIO%woodxy(i) = 500.0 !in the table or read from initialization + NoahmpIO%stblcpxy(i) = 1000.0 + NoahmpIO%fastcpxy(i) = 1000.0 + NoahmpIO%grainxy(i) = 1.0e-10 + NoahmpIO%gddxy(i) = 0 + + ! initialize crop for crop model: + if ( NoahmpIO%iopt_crop == 1 ) then + NoahmpIO%cropcat(i) = NoahmpIO%default_crop_table + if ( NoahmpIO%croptype(i,5) >= 0.5 ) then + NoahmpIO%rtmassxy(i) = 0.0 + NoahmpIO%woodxy (i) = 0.0 + if ( (NoahmpIO%croptype(i,1) > NoahmpIO%croptype(i,2)) .and. & + (NoahmpIO%croptype(i,1) > NoahmpIO%croptype(i,3)) .and. & + (NoahmpIO%croptype(i,1) > NoahmpIO%croptype(i,4)) ) then !choose corn + NoahmpIO%cropcat(i) = 1 + NoahmpIO%lfmassxy(i) = NoahmpIO%lai(i) / 0.015 !initialize lfmass zhe zhang 2020-07-13 + NoahmpIO%stmassxy(i) = NoahmpIO%xsaixy(i) / 0.003 + elseif ( (NoahmpIO%croptype(i,2) > NoahmpIO%croptype(i,1)) .and. & + (NoahmpIO%croptype(i,2) > NoahmpIO%croptype(i,3)) .and. & + (NoahmpIO%croptype(i,2) > NoahmpIO%croptype(i,4)) ) then!choose soybean + NoahmpIO%cropcat(i) = 2 + NoahmpIO%lfmassxy(i) = NoahmpIO%lai(i) / 0.030 !initialize lfmass zhe zhang 2020-07-13 + NoahmpIO%stmassxy(i) = NoahmpIO%xsaixy(i) / 0.003 + else + NoahmpIO%cropcat(i) = NoahmpIO%default_crop_table + NoahmpIO%lfmassxy(i) = NoahmpIO%lai(i) / 0.035 + NoahmpIO%stmassxy(i) = NoahmpIO%xsaixy(i) / 0.003 + endif + endif + endif + + ! Noah-MP irrigation scheme: + if ( (NoahmpIO%iopt_irr >= 1) .and. (NoahmpIO%iopt_irr <= 3) ) then + if ( (NoahmpIO%iopt_irrm == 0) .or. (NoahmpIO%iopt_irrm ==1) ) then ! sprinkler + NoahmpIO%irnumsi(i) = 0 + NoahmpIO%irwatsi(i) = 0.0 + NoahmpIO%ireloss(i) = 0.0 + NoahmpIO%irrsplh(i) = 0.0 + elseif ( (NoahmpIO%iopt_irrm == 0) .or. (NoahmpIO%iopt_irrm == 2) ) then ! micro or drip + NoahmpIO%irnummi(i) = 0 + NoahmpIO%irwatmi(i) = 0.0 + NoahmpIO%irmivol(i) = 0.0 + elseif ( (NoahmpIO%iopt_irrm == 0) .or. (NoahmpIO%iopt_irrm == 3) ) then ! flood + NoahmpIO%irnumfi(i) = 0 + NoahmpIO%irwatfi(i) = 0.0 + NoahmpIO%irfivol(i) = 0.0 + endif + endif + endif + enddo + + ! Given the soil layer thicknesses (in DZS), initialize the soil layer + ! depths from the surface: + NoahmpIO%zsoil(1) = -NoahmpIO%dzs(1) ! negative + do ns = 2, NoahmpIO%nsoil + NoahmpIO%zsoil(ns) = NoahmpIO%zsoil(ns-1) - NoahmpIO%dzs(ns) + enddo + + ! initialize noah-mp snow + call NoahmpSnowInitMain(NoahmpIO) + + !initialize arrays for groundwater dynamics iopt_runsub=5 + if ( NoahmpIO%iopt_runsub == 5 ) then + NoahmpIO%stepwtd = nint(NoahmpIO%wtddt * 60.0 / NoahmpIO%dtbl) + NoahmpIO%stepwtd = max(NoahmpIO%stepwtd,1) + endif + + endif ! NoahmpIO%restart_flag + + end subroutine NoahmpInitMain + + end module NoahmpInitMainMod diff --git a/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpReadNamelistMod.F90 b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpReadNamelistMod.F90 new file mode 100644 index 000000000..439e9161b --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpReadNamelistMod.F90 @@ -0,0 +1,397 @@ +module NoahmpReadNamelistMod + +!!! Initialize Noah-MP namelist variables +!!! Namelist variables should be first defined in NoahmpIOVarType.F90 + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use Machine + use NoahmpIOVarType + + implicit none + +contains + +!=== read namelist values + + subroutine NoahmpReadNamelist(NoahmpIO) + + implicit none + + type(NoahmpIO_type), intent(inout) :: NoahmpIO + +!--------------------------------------------------------------------- +! NAMELIST start +!--------------------------------------------------------------------- + + ! local namelist variables + + character(len=256) :: indir = '.' + integer :: ierr + integer :: NSOIL ! number of soil layers + integer :: forcing_timestep + integer :: noah_timestep + integer :: start_year + integer :: start_month + integer :: start_day + integer :: start_hour + integer :: start_min + character(len=256) :: outdir = "." + character(len=256) :: restart_filename_requested = " " + integer :: restart_frequency_hours + integer :: output_timestep + integer :: spinup_loops = 0 + integer :: sf_urban_physics = 0 + integer :: use_wudapt_lcz = 0 ! add for LCZ urban + integer :: num_urban_ndm = 2 + integer :: num_urban_ng = 10 + integer :: num_urban_nwr = 10 + integer :: num_urban_ngb = 10 + integer :: num_urban_nf = 10 + integer :: num_urban_nz = 18 + integer :: num_urban_nbui = 15 + integer :: num_urban_hi = 15 + integer :: num_urban_ngr = 10 ! = ngr_u in bep_bem.F + integer :: noahmp_output = 0 + real(kind=kind_noahmp) :: urban_atmosphere_thickness = 2.0 + real(kind=kind_noahmp) :: soil_timestep = 0.0 ! soil timestep (default=0: same as main noahmp timestep) + + ! derived urban dimensions + character(len=256) :: forcing_name_T = "T2D" + character(len=256) :: forcing_name_Q = "Q2D" + character(len=256) :: forcing_name_U = "U2D" + character(len=256) :: forcing_name_V = "V2D" + character(len=256) :: forcing_name_P = "PSFC" + character(len=256) :: forcing_name_LW = "LWDOWN" + character(len=256) :: forcing_name_SW = "SWDOWN" + character(len=256) :: forcing_name_PR = "RAINRATE" + character(len=256) :: forcing_name_SN = "" + integer :: dynamic_veg_option = 4 + integer :: canopy_stomatal_resistance_option = 1 + integer :: btr_option = 1 + integer :: surface_runoff_option = 3 + integer :: subsurface_runoff_option = 3 + integer :: surface_drag_option = 1 + integer :: supercooled_water_option = 1 + integer :: frozen_soil_option = 1 + integer :: radiative_transfer_option = 3 + integer :: snow_albedo_option = 1 + integer :: snow_thermal_conductivity = 1 + integer :: pcp_partition_option = 1 + integer :: tbot_option = 2 + integer :: temp_time_scheme_option = 1 + integer :: glacier_option = 1 + integer :: surface_resistance_option = 1 + integer :: soil_data_option = 1 + integer :: pedotransfer_option = 1 + integer :: crop_option = 0 + integer :: irrigation_option = 0 + integer :: irrigation_method = 0 + integer :: dvic_infiltration_option = 1 + integer :: tile_drainage_option = 0 + integer :: split_output_count = 1 + logical :: skip_first_output = .false. + integer :: khour = -9999 + integer :: kday = -9999 + real(kind=kind_noahmp) :: zlvl = 10. + character(len=256) :: hrldas_setup_file = " " + character(len=256) :: spatial_filename = " " + character(len=256) :: external_veg_filename_template = " " + character(len=256) :: external_lai_filename_template = " " + character(len=256) :: agdata_flnm = " " + character(len=256) :: tdinput_flnm = " " + integer, parameter :: MAX_SOIL_LEVELS = 10 ! maximum soil levels in namelist + real(kind=kind_noahmp), dimension(MAX_SOIL_LEVELS) :: soil_thick_input ! depth to soil interfaces from namelist [m] + + namelist / NOAHLSM_OFFLINE / & +#ifdef WRF_HYDRO + finemesh,finemesh_factor,forc_typ, snow_assim , GEO_STATIC_FLNM, HRLDAS_ini_typ, & +#endif + indir, nsoil, soil_thick_input, forcing_timestep, noah_timestep, soil_timestep, & + start_year, start_month, start_day, start_hour, start_min, & + outdir, skip_first_output, noahmp_output, & + restart_filename_requested, restart_frequency_hours, output_timestep, & + spinup_loops, & + forcing_name_T,forcing_name_Q,forcing_name_U,forcing_name_V,forcing_name_P, & + forcing_name_LW,forcing_name_SW,forcing_name_PR,forcing_name_SN, & + dynamic_veg_option, canopy_stomatal_resistance_option, & + btr_option, surface_drag_option, supercooled_water_option, & + frozen_soil_option, radiative_transfer_option, snow_albedo_option, & + snow_thermal_conductivity, surface_runoff_option, subsurface_runoff_option, & + pcp_partition_option, tbot_option, temp_time_scheme_option, & + glacier_option, surface_resistance_option, & + irrigation_option, irrigation_method, dvic_infiltration_option, & + tile_drainage_option,soil_data_option, pedotransfer_option, crop_option, & + sf_urban_physics,use_wudapt_lcz,num_urban_hi,urban_atmosphere_thickness, & + num_urban_ndm,num_urban_ng,num_urban_nwr ,num_urban_ngb , & + num_urban_nf ,num_urban_nz,num_urban_nbui,num_urban_ngr , & + split_output_count, & + khour, kday, zlvl, hrldas_setup_file, & + spatial_filename, agdata_flnm, tdinput_flnm, & + external_veg_filename_template, external_lai_filename_template + + + !--------------------------------------------------------------- + ! Initialize namelist variables to dummy values, so we can tell + ! if they have not been set properly. + !--------------------------------------------------------------- + if (.not. allocated(NoahmpIO%soil_thick_input)) allocate(NoahmpIO%soil_thick_input(1:MAX_SOIL_LEVELS)) + NoahmpIO%nsoil = undefined_int + NoahmpIO%soil_thick_input = undefined_real + NoahmpIO%DTBL = undefined_real + NoahmpIO%soiltstep = undefined_real + NoahmpIO%start_year = undefined_int + NoahmpIO%start_month = undefined_int + NoahmpIO%start_day = undefined_int + NoahmpIO%start_hour = undefined_int + NoahmpIO%start_min = undefined_int + NoahmpIO%khour = undefined_int + NoahmpIO%kday = undefined_int + NoahmpIO%zlvl = undefined_real + NoahmpIO%forcing_timestep = undefined_int + NoahmpIO%noah_timestep = undefined_int + NoahmpIO%output_timestep = undefined_int + NoahmpIO%restart_frequency_hours = undefined_int + NoahmpIO%spinup_loops = 0 + NoahmpIO%noahmp_output = 0 + + !--------------------------------------------------------------- + ! read namelist.input + !--------------------------------------------------------------- + + open(30, file="namelist.hrldas", form="FORMATTED") + read(30, NOAHLSM_OFFLINE, iostat=ierr) + if (ierr /= 0) then + write(*,'(/," ***** ERROR: Problem reading namelist NOAHLSM_OFFLINE",/)') + rewind(30) + read(30, NOAHLSM_OFFLINE) + stop " ***** ERROR: Problem reading namelist NOAHLSM_OFFLINE" + endif + close(30) + + NoahmpIO%DTBL = real(noah_timestep) + NoahmpIO%soiltstep = soil_timestep + NoahmpIO%NSOIL = nsoil + + !--------------------------------------------------------------------- + ! NAMELIST end + !--------------------------------------------------------------------- + + !--------------------------------------------------------------------- + ! NAMELIST check begin + !--------------------------------------------------------------------- + NoahmpIO%update_lai = .true. ! default: use LAI if present in forcing file + if(dynamic_veg_option == 1 .or. dynamic_veg_option == 2 .or. & + dynamic_veg_option == 3 .or. dynamic_veg_option == 4 .or. & + dynamic_veg_option == 5 .or. dynamic_veg_option == 6) & ! remove dveg=10 and add dveg=1,3,4 into the update_lai flag false condition + NoahmpIO%update_lai = .false. + + NoahmpIO%update_veg = .false. ! default: don't use VEGFRA if present in forcing file + if (dynamic_veg_option == 1 .or. dynamic_veg_option == 6 .or. dynamic_veg_option == 7) & + NoahmpIO%update_veg = .true. + + if (nsoil < 0) then + stop " ***** ERROR: NSOIL must be set in the namelist." + endif + + if ((khour < 0) .and. (kday < 0)) then + write(*, '(" ***** Namelist error: ************************************")') + write(*, '(" ***** ")') + write(*, '(" ***** Either KHOUR or KDAY must be defined.")') + write(*, '(" ***** ")') + stop + else if (( khour < 0 ) .and. (kday > 0)) then + khour = kday * 24 + else if ((khour > 0) .and. (kday > 0)) then + write(*, '("Namelist warning: KHOUR and KDAY both defined.")') + else + ! all is well. KHOUR defined + endif + + if (forcing_timestep < 0) then + write(*, *) + write(*, '(" ***** Namelist error: *****************************************")') + write(*, '(" ***** ")') + write(*, '(" ***** FORCING_TIMESTEP needs to be set greater than zero.")') + write(*, '(" ***** ")') + write(*, *) + stop + endif + + if (noah_timestep < 0) then + write(*, *) + write(*, '(" ***** Namelist error: *****************************************")') + write(*, '(" ***** ")') + write(*, '(" ***** NOAH_TIMESTEP needs to be set greater than zero.")') + write(*, '(" ***** 900 seconds is recommended. ")') + write(*, '(" ***** ")') + write(*, *) + stop + endif + + ! + ! Check that OUTPUT_TIMESTEP fits into NOAH_TIMESTEP: + ! + if (output_timestep /= 0) then + if (mod(output_timestep, noah_timestep) > 0) then + write(*, *) + write(*, '(" ***** Namelist error: *********************************************************")') + write(*, '(" ***** ")') + write(*, '(" ***** OUTPUT_TIMESTEP should set to an integer multiple of NOAH_TIMESTEP.")') + write(*, '(" ***** OUTPUT_TIMESTEP = ", I12, " seconds")') output_timestep + write(*, '(" ***** NOAH_TIMESTEP = ", I12, " seconds")') noah_timestep + write(*, '(" ***** ")') + write(*, *) + stop + endif + endif + + ! + ! Check that RESTART_FREQUENCY_HOURS fits into NOAH_TIMESTEP: + ! + if (restart_frequency_hours /= 0) then + if (mod(restart_frequency_hours*3600, noah_timestep) > 0) then + write(*, *) + write(*, '(" ***** Namelist error: ******************************************************")') + write(*, '(" ***** ")') + write(*, '(" ***** RESTART_FREQUENCY_HOURS (converted to seconds) should set to an ")') + write(*, '(" ***** integer multiple of NOAH_TIMESTEP.")') + write(*, '(" ***** RESTART_FREQUENCY_HOURS = ", I12, " hours: ", I12, " seconds")') & + restart_frequency_hours, restart_frequency_hours*3600 + write(*, '(" ***** NOAH_TIMESTEP = ", I12, " seconds")') noah_timestep + write(*, '(" ***** ")') + write(*, *) + stop + endif + endif + + if (dynamic_veg_option == 2 .or. dynamic_veg_option == 5 .or. dynamic_veg_option == 6) then + if ( canopy_stomatal_resistance_option /= 1) then + write(*, *) + write(*, '(" ***** Namelist error: ******************************************************")') + write(*, '(" ***** ")') + write(*, '(" ***** CANOPY_STOMATAL_RESISTANCE_OPTION must be 1 when DYNAMIC_VEG_OPTION == 2/5/6")') + write(*, *) + stop + endif + endif + + if (soil_data_option == 4 .and. spatial_filename == " ") then + write(*, *) + write(*, '(" ***** Namelist error: ******************************************************")') + write(*, '(" ***** ")') + write(*, '(" ***** SPATIAL_FILENAME must be provided when SOIL_DATA_OPTION == 4")') + write(*, *) + stop + endif + + if (sf_urban_physics == 2 .or. sf_urban_physics == 3) then + if ( urban_atmosphere_thickness <= 0.0) then + write(*, *) + write(*, '(" ***** Namelist error: ******************************************************")') + write(*, '(" ***** ")') + write(*, '(" ***** When running BEP/BEM, URBAN_ATMOSPHERE_LEVELS must contain at least 3 levels")') + write(*, *) + stop + endif + NoahmpIO%num_urban_atmosphere = int(zlvl/urban_atmosphere_thickness) + if (zlvl - NoahmpIO%num_urban_atmosphere*urban_atmosphere_thickness >= 0.5*urban_atmosphere_thickness) & + NoahmpIO%num_urban_atmosphere = NoahmpIO%num_urban_atmosphere + 1 + if ( NoahmpIO%num_urban_atmosphere <= 2) then + write(*, *) + write(*, '(" ***** Namelist error: ******************************************************")') + write(*, '(" ***** ")') + write(*, '(" ***** When running BEP/BEM, num_urban_atmosphere must contain at least 3 levels, ")') + write(*, '(" ***** decrease URBAN_ATMOSPHERE_THICKNESS")') + write(*, *) + stop + endif + endif + + !--------------------------------------------------------------------- + ! Transfer Namelist locals to input data structure + !--------------------------------------------------------------------- + ! physics option + NoahmpIO%IOPT_DVEG = dynamic_veg_option + NoahmpIO%IOPT_CRS = canopy_stomatal_resistance_option + NoahmpIO%IOPT_BTR = btr_option + NoahmpIO%IOPT_RUNSRF = surface_runoff_option + NoahmpIO%IOPT_RUNSUB = subsurface_runoff_option + NoahmpIO%IOPT_SFC = surface_drag_option + NoahmpIO%IOPT_FRZ = supercooled_water_option + NoahmpIO%IOPT_INF = frozen_soil_option + NoahmpIO%IOPT_RAD = radiative_transfer_option + NoahmpIO%IOPT_ALB = snow_albedo_option + NoahmpIO%IOPT_SNF = pcp_partition_option + NoahmpIO%IOPT_TKSNO = snow_thermal_conductivity + NoahmpIO%IOPT_TBOT = tbot_option + NoahmpIO%IOPT_STC = temp_time_scheme_option + NoahmpIO%IOPT_GLA = glacier_option + NoahmpIO%IOPT_RSF = surface_resistance_option + NoahmpIO%IOPT_SOIL = soil_data_option + NoahmpIO%IOPT_PEDO = pedotransfer_option + NoahmpIO%IOPT_CROP = crop_option + NoahmpIO%IOPT_IRR = irrigation_option + NoahmpIO%IOPT_IRRM = irrigation_method + NoahmpIO%IOPT_INFDV = dvic_infiltration_option + NoahmpIO%IOPT_TDRN = tile_drainage_option + ! basic model setup variables + NoahmpIO%indir = indir + NoahmpIO%forcing_timestep = forcing_timestep + NoahmpIO%noah_timestep = noah_timestep + NoahmpIO%start_year = start_year + NoahmpIO%start_month = start_month + NoahmpIO%start_day = start_day + NoahmpIO%start_hour = start_hour + NoahmpIO%start_min = start_min + NoahmpIO%outdir = outdir + NoahmpIO%noahmp_output = noahmp_output + NoahmpIO%restart_filename_requested = restart_filename_requested + NoahmpIO%restart_frequency_hours = restart_frequency_hours + NoahmpIO%output_timestep = output_timestep + NoahmpIO%spinup_loops = spinup_loops + NoahmpIO%sf_urban_physics = sf_urban_physics + NoahmpIO%use_wudapt_lcz = use_wudapt_lcz + NoahmpIO%num_urban_ndm = num_urban_ndm + NoahmpIO%num_urban_ng = num_urban_ng + NoahmpIO%num_urban_nwr = num_urban_nwr + NoahmpIO%num_urban_ngb = num_urban_ngb + NoahmpIO%num_urban_nf = num_urban_nf + NoahmpIO%num_urban_nz = num_urban_nz + NoahmpIO%num_urban_nbui = num_urban_nbui + NoahmpIO%num_urban_hi = num_urban_hi + NoahmpIO%urban_atmosphere_thickness = urban_atmosphere_thickness + NoahmpIO%num_urban_ngr = num_urban_ngr + NoahmpIO%forcing_name_T = forcing_name_T + NoahmpIO%forcing_name_Q = forcing_name_Q + NoahmpIO%forcing_name_U = forcing_name_U + NoahmpIO%forcing_name_V = forcing_name_V + NoahmpIO%forcing_name_P = forcing_name_P + NoahmpIO%forcing_name_LW = forcing_name_LW + NoahmpIO%forcing_name_SW = forcing_name_SW + NoahmpIO%forcing_name_PR = forcing_name_PR + NoahmpIO%forcing_name_SN = forcing_name_SN + NoahmpIO%split_output_count = split_output_count + NoahmpIO%skip_first_output = skip_first_output + NoahmpIO%khour = khour + NoahmpIO%kday = kday + NoahmpIO%zlvl = zlvl + NoahmpIO%hrldas_setup_file = hrldas_setup_file + NoahmpIO%spatial_filename = spatial_filename + NoahmpIO%external_veg_filename_template = external_veg_filename_template + NoahmpIO%external_lai_filename_template = external_lai_filename_template + NoahmpIO%agdata_flnm = agdata_flnm + NoahmpIO%tdinput_flnm = tdinput_flnm + NoahmpIO%MAX_SOIL_LEVELS = MAX_SOIL_LEVELS + NoahmpIO%soil_thick_input = soil_thick_input + +!--------------------------------------------------------------------- +! NAMELIST check end +!--------------------------------------------------------------------- + + end subroutine NoahmpReadNamelist + +end module NoahmpReadNamelistMod diff --git a/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpReadTableMod.F90 b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpReadTableMod.F90 new file mode 100644 index 000000000..eb01ceb2f --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpReadTableMod.F90 @@ -0,0 +1,1182 @@ +module NoahmpReadTableMod + +!!! Initialize Noah-MP look-up table variables +!!! Table variables should be first defined in NoahmpIOVarType.F90 + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use Machine + use NoahmpIOVarType + + implicit none + +contains + +!=== read Noahmp Table values + + subroutine NoahmpReadTable(NoahmpIO) + + implicit none + + type(NoahmpIO_type), intent(inout) :: NoahmpIO + + !------------------------------------------------------- + !=== define key dimensional variables + !------------------------------------------------------- + integer, parameter :: MVT = 27 ! number of vegetation types + integer, parameter :: MBAND = 2 ! number of radiation bands + integer, parameter :: MSC = 8 ! number of soil texture + integer, parameter :: MAX_SOILTYP = 30 ! max number of soil types + integer, parameter :: NCROP = 5 ! number of crop types + integer, parameter :: NSTAGE = 8 ! number of crop growth stages + integer, parameter :: NUM_SLOPE = 9 ! number of slope + + !------------------------------------------------------- + !=== define local variables to store NoahmpTable values + !------------------------------------------------------- + + ! vegetation parameters + character(len=256) :: DATASET_IDENTIFIER + character(len=256) :: VEG_DATASET_DESCRIPTION + logical :: file_named + integer :: ierr, IK, IM + integer :: NVEG, ISURBAN, ISWATER, ISBARREN, ISICE, ISCROP, EBLFOREST, NATURAL, URBTYPE_beg + integer :: LCZ_1, LCZ_2, LCZ_3, LCZ_4, LCZ_5, LCZ_6, LCZ_7, LCZ_8, LCZ_9, LCZ_10, LCZ_11 + real(kind=kind_noahmp), dimension(MVT) :: SAI_JAN, SAI_FEB, SAI_MAR, SAI_APR, SAI_MAY, SAI_JUN, SAI_JUL, SAI_AUG, & + SAI_SEP, SAI_OCT, SAI_NOV, SAI_DEC, LAI_JAN, LAI_FEB, LAI_MAR, LAI_APR, & + LAI_MAY, LAI_JUN, LAI_JUL, LAI_AUG, LAI_SEP, LAI_OCT, LAI_NOV, LAI_DEC, & + RHOL_VIS, RHOL_NIR, RHOS_VIS, RHOS_NIR, TAUL_VIS, TAUL_NIR, TAUS_VIS, TAUS_NIR,& + CH2OP, DLEAF, Z0MVT, HVT, HVB, DEN, RC, MFSNO, SCFFAC, XL, CWPVT, C3PSN, KC25, & + AKC, KO25, AKO, AVCMX, AQE, LTOVRC, DILEFC, DILEFW, RMF25, SLA, FRAGR, TMIN, & + VCMX25, TDLEF, BP, MP, QE25, RMS25, RMR25, ARM, FOLNMX, WDPOOL, WRRAT, MRP, & + NROOT, RGL, RS, HS, TOPT, RSMAX, RTOVRC, RSWOODC, BF, WSTRC, LAIMIN, CBIOM, & + XSAMIN + namelist / noahmp_usgs_veg_categories / VEG_DATASET_DESCRIPTION, NVEG + namelist / noahmp_usgs_parameters / ISURBAN, ISWATER, ISBARREN, ISICE, ISCROP, EBLFOREST, NATURAL, URBTYPE_beg, & + LCZ_1, LCZ_2, LCZ_3, LCZ_4, LCZ_5, LCZ_6, LCZ_7, LCZ_8, LCZ_9, LCZ_10, LCZ_11, & + CH2OP, DLEAF, Z0MVT, HVT, HVB, DEN, RC, MFSNO, SCFFAC, XL, CWPVT, C3PSN, KC25, & + AKC, KO25, AKO, AVCMX, AQE, LTOVRC, DILEFC, DILEFW, RMF25, SLA, FRAGR, TMIN, & + VCMX25, TDLEF, BP, MP, QE25, RMS25, RMR25, ARM, FOLNMX, WDPOOL, WRRAT, MRP, & + NROOT, RGL, RS, HS, TOPT, RSMAX, RTOVRC, RSWOODC, BF, WSTRC, LAIMIN, CBIOM, & + XSAMIN, SAI_JAN, SAI_FEB, SAI_MAR, SAI_APR, SAI_MAY, & + SAI_JUN, SAI_JUL, SAI_AUG, SAI_SEP, SAI_OCT, SAI_NOV, SAI_DEC, LAI_JAN, & + LAI_FEB, LAI_MAR, LAI_APR, LAI_MAY, LAI_JUN, LAI_JUL, LAI_AUG, LAI_SEP, & + LAI_OCT, LAI_NOV, LAI_DEC, RHOL_VIS, RHOL_NIR, RHOS_VIS, RHOS_NIR, TAUL_VIS, & + TAUL_NIR, TAUS_VIS, TAUS_NIR + namelist / noahmp_modis_veg_categories / VEG_DATASET_DESCRIPTION, NVEG + namelist / noahmp_modis_parameters / ISURBAN, ISWATER, ISBARREN, ISICE, ISCROP, EBLFOREST, NATURAL, URBTYPE_beg, & + LCZ_1, LCZ_2, LCZ_3, LCZ_4, LCZ_5, LCZ_6, LCZ_7, LCZ_8, LCZ_9, LCZ_10, LCZ_11, & + CH2OP, DLEAF, Z0MVT, HVT, HVB, DEN, RC, MFSNO, SCFFAC, XL, CWPVT, C3PSN, KC25, & + AKC, KO25, AKO, AVCMX, AQE, LTOVRC, DILEFC, DILEFW, RMF25, SLA, FRAGR, TMIN, & + VCMX25, TDLEF, BP, MP, QE25, RMS25, RMR25, ARM, FOLNMX, WDPOOL, WRRAT, MRP, & + NROOT, RGL, RS, HS, TOPT, RSMAX, RTOVRC, RSWOODC, BF, WSTRC, LAIMIN, CBIOM, & + XSAMIN, SAI_JAN, SAI_FEB, SAI_MAR, SAI_APR, SAI_MAY, & + SAI_JUN, SAI_JUL, SAI_AUG, SAI_SEP, SAI_OCT, SAI_NOV, SAI_DEC, LAI_JAN, & + LAI_FEB, LAI_MAR, LAI_APR, LAI_MAY, LAI_JUN, LAI_JUL, LAI_AUG, LAI_SEP, & + LAI_OCT, LAI_NOV, LAI_DEC, RHOL_VIS, RHOL_NIR, RHOS_VIS, RHOS_NIR, TAUL_VIS, & + TAUL_NIR, TAUS_VIS, TAUS_NIR + + ! soil parameters + character(len=256) :: message + character(len=10) :: SLTYPE + integer :: SLCATS + real(kind=kind_noahmp), dimension(MAX_SOILTYP) :: BB, DRYSMC, MAXSMC, REFSMC, SATPSI, SATDK, SATDW, WLTSMC, QTZ, & + BVIC, AXAJ, BXAJ, XXAJ, BDVIC, BBVIC, GDVIC, HC + namelist / noahmp_stas_soil_categories / SLTYPE, SLCATS + namelist / noahmp_soil_stas_parameters / BB, DRYSMC, MAXSMC, REFSMC, SATPSI, SATDK, SATDW, WLTSMC, QTZ, & + BVIC, AXAJ, BXAJ, XXAJ, BDVIC, BBVIC, GDVIC + namelist / noahmp_soil_stas_ruc_parameters / BB, DRYSMC, HC, MAXSMC, REFSMC, SATPSI, SATDK, SATDW, WLTSMC, QTZ, & + BVIC, AXAJ, BXAJ, XXAJ, BDVIC, BBVIC, GDVIC + + ! general parameters + real(kind=kind_noahmp) :: CSOIL_DATA, REFDK_DATA, REFKDT_DATA, FRZK_DATA, ZBOT_DATA, CZIL_DATA + real(kind=kind_noahmp), dimension(NUM_SLOPE) :: SLOPE_DATA + namelist / noahmp_general_parameters / SLOPE_DATA, CSOIL_DATA, REFDK_DATA, REFKDT_DATA, FRZK_DATA, ZBOT_DATA, & + CZIL_DATA + + ! radiation parameters + real(kind=kind_noahmp) :: BETADS, BETAIS, EICE + real(kind=kind_noahmp), dimension(MBAND) :: ALBICE, ALBLAK, OMEGAS + real(kind=kind_noahmp), dimension(2) :: EG + real(kind=kind_noahmp), dimension(MSC) :: ALBSAT_VIS, ALBSAT_NIR, ALBDRY_VIS, ALBDRY_NIR + namelist / noahmp_rad_parameters / ALBSAT_VIS, ALBSAT_NIR, ALBDRY_VIS, ALBDRY_NIR, ALBICE, ALBLAK, OMEGAS, & + BETADS, BETAIS, EG, EICE + + ! global parameters + real(kind=kind_noahmp) :: CO2, O2, TIMEAN, FSATMX, Z0SNO, SSI, SNOW_RET_FAC ,SNOW_EMIS, SWEMX, TAU0, & + GRAIN_GROWTH, EXTRA_GROWTH, DIRT_SOOT, BATS_COSZ, BATS_VIS_NEW, & + BATS_NIR_NEW, BATS_VIS_AGE, BATS_NIR_AGE, BATS_VIS_DIR, BATS_NIR_DIR, & + RSURF_SNOW, RSURF_EXP, C2_SNOWCOMPACT, C3_SNOWCOMPACT, C4_SNOWCOMPACT, & + C5_SNOWCOMPACT, DM_SNOWCOMPACT, ETA0_SNOWCOMPACT, SNLIQMAXFRAC, SWEMAXGLA, & + WSLMAX, ROUS, CMIC, SNOWDEN_MAX, CLASS_ALB_REF, CLASS_SNO_AGE, CLASS_ALB_NEW,& + PSIWLT, Z0SOIL, Z0LAKE + namelist / noahmp_global_parameters / CO2, O2, TIMEAN, FSATMX, Z0SNO, SSI, SNOW_RET_FAC ,SNOW_EMIS, SWEMX, TAU0, & + GRAIN_GROWTH, EXTRA_GROWTH, DIRT_SOOT, BATS_COSZ, BATS_VIS_NEW, & + BATS_NIR_NEW, BATS_VIS_AGE, BATS_NIR_AGE, BATS_VIS_DIR, BATS_NIR_DIR, & + RSURF_SNOW, RSURF_EXP, C2_SNOWCOMPACT, C3_SNOWCOMPACT, C4_SNOWCOMPACT, & + C5_SNOWCOMPACT, DM_SNOWCOMPACT, ETA0_SNOWCOMPACT, SNLIQMAXFRAC, SWEMAXGLA, & + WSLMAX, ROUS, CMIC, SNOWDEN_MAX, CLASS_ALB_REF, CLASS_SNO_AGE, CLASS_ALB_NEW,& + PSIWLT, Z0SOIL, Z0LAKE + + ! irrigation parameters + integer :: IRR_HAR + real(kind=kind_noahmp) :: IRR_FRAC, IRR_LAI, IRR_MAD, FILOSS, SPRIR_RATE, MICIR_RATE, FIRTFAC, IR_RAIN + namelist / noahmp_irrigation_parameters / IRR_FRAC, IRR_HAR, IRR_LAI, IRR_MAD, FILOSS, SPRIR_RATE, MICIR_RATE, FIRTFAC,& + IR_RAIN + + ! crop parameters + integer :: DEFAULT_CROP + integer , dimension(NCROP) :: PLTDAY, HSDAY + real(kind=kind_noahmp), dimension(NCROP) :: PLANTPOP, IRRI, GDDTBASE, GDDTCUT, GDDS1, GDDS2, GDDS3, GDDS4, GDDS5, C3PSNI,& + KC25I, AKCI, KO25I, AKOI, AVCMXI, VCMX25I, BPI, MPI, FOLNMXI, QE25I, AREF, & + PSNRF, I2PAR, TASSIM0, TASSIM1, TASSIM2, K, EPSI, Q10MR, LEFREEZ, & + DILE_FC_S1, DILE_FC_S2, DILE_FC_S3, DILE_FC_S4, DILE_FC_S5, DILE_FC_S6, & + DILE_FC_S7, DILE_FC_S8, DILE_FW_S1, DILE_FW_S2, DILE_FW_S3, DILE_FW_S4, & + DILE_FW_S5, DILE_FW_S6, DILE_FW_S7, DILE_FW_S8, FRA_GR, LF_OVRC_S1, & + LF_OVRC_S2, LF_OVRC_S3, LF_OVRC_S4, LF_OVRC_S5, LF_OVRC_S6, LF_OVRC_S7, & + LF_OVRC_S8, ST_OVRC_S1, ST_OVRC_S2, ST_OVRC_S3, ST_OVRC_S4, ST_OVRC_S5, & + ST_OVRC_S6, ST_OVRC_S7, ST_OVRC_S8, RT_OVRC_S1, RT_OVRC_S2, RT_OVRC_S3, & + RT_OVRC_S4, RT_OVRC_S5, RT_OVRC_S6, RT_OVRC_S7, RT_OVRC_S8, LFMR25, STMR25, & + RTMR25, GRAINMR25, LFPT_S1, LFPT_S2, LFPT_S3, LFPT_S4, LFPT_S5, LFPT_S6, & + LFPT_S7, LFPT_S8, STPT_S1, STPT_S2, STPT_S3, STPT_S4, STPT_S5, STPT_S6, & + STPT_S7, STPT_S8, RTPT_S1, RTPT_S2, RTPT_S3, RTPT_S4, RTPT_S5, RTPT_S6, & + RTPT_S7, RTPT_S8, GRAINPT_S1, GRAINPT_S2, GRAINPT_S3, GRAINPT_S4, GRAINPT_S5,& + GRAINPT_S6, GRAINPT_S7, GRAINPT_S8, LFCT_S1, LFCT_S2, LFCT_S3, LFCT_S4, & + LFCT_S5, LFCT_S6, LFCT_S7, LFCT_S8, STCT_S1, STCT_S2, STCT_S3, STCT_S4, & + STCT_S5, STCT_S6, STCT_S7, STCT_S8, RTCT_S1, RTCT_S2, RTCT_S3, RTCT_S4, & + RTCT_S5, RTCT_S6, RTCT_S7, RTCT_S8, BIO2LAI + namelist / noahmp_crop_parameters / DEFAULT_CROP, PLTDAY, HSDAY, PLANTPOP, IRRI, GDDTBASE, GDDTCUT, GDDS1, GDDS2,& + GDDS3, GDDS4, GDDS5, C3PSNI, KC25I, AKCI, KO25I, AKOI, AVCMXI, VCMX25I, BPI, & + MPI, FOLNMXI, QE25I, AREF, PSNRF, I2PAR, TASSIM0, TASSIM1, TASSIM2, K, & + EPSI,Q10MR, LEFREEZ, DILE_FC_S1, DILE_FC_S2, DILE_FC_S3, DILE_FC_S4, & + DILE_FC_S5, DILE_FC_S6, DILE_FC_S7, DILE_FC_S8, DILE_FW_S1, DILE_FW_S2, & + DILE_FW_S3, DILE_FW_S4, DILE_FW_S5, DILE_FW_S6, DILE_FW_S7, DILE_FW_S8, & + FRA_GR, LF_OVRC_S1, LF_OVRC_S2, LF_OVRC_S3, LF_OVRC_S4, LF_OVRC_S5, & + LF_OVRC_S6, LF_OVRC_S7, LF_OVRC_S8, ST_OVRC_S1, ST_OVRC_S2, ST_OVRC_S3, & + ST_OVRC_S4, ST_OVRC_S5, ST_OVRC_S6, ST_OVRC_S7, ST_OVRC_S8, RT_OVRC_S1, & + RT_OVRC_S2, RT_OVRC_S3, RT_OVRC_S4, RT_OVRC_S5, RT_OVRC_S6, RT_OVRC_S7, & + RT_OVRC_S8, LFMR25, STMR25, RTMR25, GRAINMR25, LFPT_S1, LFPT_S2, LFPT_S3, & + LFPT_S4, LFPT_S5, LFPT_S6, LFPT_S7, LFPT_S8, STPT_S1, STPT_S2, STPT_S3, & + STPT_S4, STPT_S5, STPT_S6, STPT_S7, STPT_S8, RTPT_S1, RTPT_S2, RTPT_S3, & + RTPT_S4, RTPT_S5, RTPT_S6, RTPT_S7, RTPT_S8, GRAINPT_S1, GRAINPT_S2, & + GRAINPT_S3, GRAINPT_S4, GRAINPT_S5, GRAINPT_S6, GRAINPT_S7, GRAINPT_S8, & + LFCT_S1, LFCT_S2, LFCT_S3, LFCT_S4, LFCT_S5, LFCT_S6, LFCT_S7, LFCT_S8, & + STCT_S1, STCT_S2, STCT_S3, STCT_S4, STCT_S5, STCT_S6, STCT_S7, STCT_S8, & + RTCT_S1, RTCT_S2, RTCT_S3, RTCT_S4, RTCT_S5, RTCT_S6, RTCT_S7, RTCT_S8, & + BIO2LAI + + ! tile drainage parameters + integer :: NSOILTYPE, DRAIN_LAYER_OPT + integer , dimension(MAX_SOILTYP) :: TD_DEPTH + real(kind=kind_noahmp), dimension(MAX_SOILTYP) :: TDSMC_FAC, TD_DC, TD_DCOEF, TD_D, TD_ADEPTH, TD_RADI, TD_SPAC, & + TD_DDRAIN, KLAT_FAC + namelist / noahmp_tiledrain_parameters / NSOILTYPE, DRAIN_LAYER_OPT, TDSMC_FAC, TD_DEPTH, TD_DC, TD_DCOEF, TD_D,& + TD_ADEPTH, TD_RADI, TD_SPAC, TD_DDRAIN, KLAT_FAC + + ! optional parameters + real(kind=kind_noahmp) :: sr2006_theta_1500t_a, sr2006_theta_1500t_b, sr2006_theta_1500t_c, & + sr2006_theta_1500t_d, sr2006_theta_1500t_e, sr2006_theta_1500t_f, & + sr2006_theta_1500t_g, sr2006_theta_1500_a , sr2006_theta_1500_b, & + sr2006_theta_33t_a, sr2006_theta_33t_b, sr2006_theta_33t_c, & + sr2006_theta_33t_d, sr2006_theta_33t_e, sr2006_theta_33t_f, & + sr2006_theta_33t_g, sr2006_theta_33_a, sr2006_theta_33_b, & + sr2006_theta_33_c, sr2006_theta_s33t_a, sr2006_theta_s33t_b, & + sr2006_theta_s33t_c, sr2006_theta_s33t_d, sr2006_theta_s33t_e, & + sr2006_theta_s33t_f, sr2006_theta_s33t_g, sr2006_theta_s33_a, & + sr2006_theta_s33_b, sr2006_psi_et_a, sr2006_psi_et_b, sr2006_psi_et_c, & + sr2006_psi_et_d, sr2006_psi_et_e, sr2006_psi_et_f, sr2006_psi_et_g, & + sr2006_psi_e_a, sr2006_psi_e_b, sr2006_psi_e_c, sr2006_smcmax_a, & + sr2006_smcmax_b + namelist / noahmp_optional_parameters / sr2006_theta_1500t_a, sr2006_theta_1500t_b, sr2006_theta_1500t_c, & + sr2006_theta_1500t_d, sr2006_theta_1500t_e, sr2006_theta_1500t_f, & + sr2006_theta_1500t_g, sr2006_theta_1500_a, sr2006_theta_1500_b, & + sr2006_theta_33t_a, sr2006_theta_33t_b, sr2006_theta_33t_c, & + sr2006_theta_33t_d, sr2006_theta_33t_e, sr2006_theta_33t_f, & + sr2006_theta_33t_g, sr2006_theta_33_a, sr2006_theta_33_b, & + sr2006_theta_33_c, sr2006_theta_s33t_a, sr2006_theta_s33t_b, & + sr2006_theta_s33t_c, sr2006_theta_s33t_d, sr2006_theta_s33t_e, & + sr2006_theta_s33t_f, sr2006_theta_s33t_g, sr2006_theta_s33_a, & + sr2006_theta_s33_b, sr2006_psi_et_a, sr2006_psi_et_b, sr2006_psi_et_c, & + sr2006_psi_et_d, sr2006_psi_et_e, sr2006_psi_et_f, sr2006_psi_et_g, & + sr2006_psi_e_a, sr2006_psi_e_b, sr2006_psi_e_c, sr2006_smcmax_a, & + sr2006_smcmax_b + + !-------------------------------------------------- + !=== allocate multi-dim input table variables + !-------------------------------------------------- + + ! vegetation parameters + if ( .not. allocated (NoahmpIO%CH2OP_TABLE) ) allocate( NoahmpIO%CH2OP_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%DLEAF_TABLE) ) allocate( NoahmpIO%DLEAF_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%Z0MVT_TABLE) ) allocate( NoahmpIO%Z0MVT_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%HVT_TABLE) ) allocate( NoahmpIO%HVT_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%HVB_TABLE) ) allocate( NoahmpIO%HVB_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%DEN_TABLE) ) allocate( NoahmpIO%DEN_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%RC_TABLE) ) allocate( NoahmpIO%RC_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%MFSNO_TABLE) ) allocate( NoahmpIO%MFSNO_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%SCFFAC_TABLE) ) allocate( NoahmpIO%SCFFAC_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%CBIOM_TABLE) ) allocate( NoahmpIO%CBIOM_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%SAIM_TABLE) ) allocate( NoahmpIO%SAIM_TABLE (MVT,12) ) + if ( .not. allocated (NoahmpIO%LAIM_TABLE) ) allocate( NoahmpIO%LAIM_TABLE (MVT,12) ) + if ( .not. allocated (NoahmpIO%SLA_TABLE) ) allocate( NoahmpIO%SLA_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%DILEFC_TABLE) ) allocate( NoahmpIO%DILEFC_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%DILEFW_TABLE) ) allocate( NoahmpIO%DILEFW_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%FRAGR_TABLE) ) allocate( NoahmpIO%FRAGR_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%LTOVRC_TABLE) ) allocate( NoahmpIO%LTOVRC_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%C3PSN_TABLE) ) allocate( NoahmpIO%C3PSN_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%KC25_TABLE) ) allocate( NoahmpIO%KC25_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%AKC_TABLE) ) allocate( NoahmpIO%AKC_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%KO25_TABLE) ) allocate( NoahmpIO%KO25_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%AKO_TABLE) ) allocate( NoahmpIO%AKO_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%VCMX25_TABLE) ) allocate( NoahmpIO%VCMX25_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%AVCMX_TABLE) ) allocate( NoahmpIO%AVCMX_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%BP_TABLE) ) allocate( NoahmpIO%BP_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%MP_TABLE) ) allocate( NoahmpIO%MP_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%QE25_TABLE) ) allocate( NoahmpIO%QE25_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%AQE_TABLE) ) allocate( NoahmpIO%AQE_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%RMF25_TABLE) ) allocate( NoahmpIO%RMF25_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%RMS25_TABLE) ) allocate( NoahmpIO%RMS25_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%RMR25_TABLE) ) allocate( NoahmpIO%RMR25_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%ARM_TABLE) ) allocate( NoahmpIO%ARM_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%FOLNMX_TABLE) ) allocate( NoahmpIO%FOLNMX_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%TMIN_TABLE) ) allocate( NoahmpIO%TMIN_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%XL_TABLE) ) allocate( NoahmpIO%XL_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%RHOL_TABLE) ) allocate( NoahmpIO%RHOL_TABLE (MVT,MBAND) ) + if ( .not. allocated (NoahmpIO%RHOS_TABLE) ) allocate( NoahmpIO%RHOS_TABLE (MVT,MBAND) ) + if ( .not. allocated (NoahmpIO%TAUL_TABLE) ) allocate( NoahmpIO%TAUL_TABLE (MVT,MBAND) ) + if ( .not. allocated (NoahmpIO%TAUS_TABLE) ) allocate( NoahmpIO%TAUS_TABLE (MVT,MBAND) ) + if ( .not. allocated (NoahmpIO%MRP_TABLE) ) allocate( NoahmpIO%MRP_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%CWPVT_TABLE) ) allocate( NoahmpIO%CWPVT_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%WRRAT_TABLE) ) allocate( NoahmpIO%WRRAT_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%WDPOOL_TABLE) ) allocate( NoahmpIO%WDPOOL_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%TDLEF_TABLE) ) allocate( NoahmpIO%TDLEF_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%NROOT_TABLE) ) allocate( NoahmpIO%NROOT_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%RGL_TABLE) ) allocate( NoahmpIO%RGL_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%RS_TABLE) ) allocate( NoahmpIO%RS_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%HS_TABLE) ) allocate( NoahmpIO%HS_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%TOPT_TABLE) ) allocate( NoahmpIO%TOPT_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%RSMAX_TABLE) ) allocate( NoahmpIO%RSMAX_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%RTOVRC_TABLE) ) allocate( NoahmpIO%RTOVRC_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%RSWOODC_TABLE)) allocate( NoahmpIO%RSWOODC_TABLE(MVT) ) + if ( .not. allocated (NoahmpIO%BF_TABLE) ) allocate( NoahmpIO%BF_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%WSTRC_TABLE) ) allocate( NoahmpIO%WSTRC_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%LAIMIN_TABLE) ) allocate( NoahmpIO%LAIMIN_TABLE (MVT) ) + if ( .not. allocated (NoahmpIO%XSAMIN_TABLE) ) allocate( NoahmpIO%XSAMIN_TABLE (MVT) ) + + ! soil parameters + if ( .not. allocated (NoahmpIO%BEXP_TABLE) ) allocate( NoahmpIO%BEXP_TABLE (MAX_SOILTYP) ) + if ( .not. allocated (NoahmpIO%SMCDRY_TABLE) ) allocate( NoahmpIO%SMCDRY_TABLE(MAX_SOILTYP) ) + if ( .not. allocated (NoahmpIO%SMCMAX_TABLE) ) allocate( NoahmpIO%SMCMAX_TABLE(MAX_SOILTYP) ) + if ( .not. allocated (NoahmpIO%SMCREF_TABLE) ) allocate( NoahmpIO%SMCREF_TABLE(MAX_SOILTYP) ) + if ( .not. allocated (NoahmpIO%PSISAT_TABLE) ) allocate( NoahmpIO%PSISAT_TABLE(MAX_SOILTYP) ) + if ( .not. allocated (NoahmpIO%DKSAT_TABLE) ) allocate( NoahmpIO%DKSAT_TABLE (MAX_SOILTYP) ) + if ( .not. allocated (NoahmpIO%DWSAT_TABLE) ) allocate( NoahmpIO%DWSAT_TABLE (MAX_SOILTYP) ) + if ( .not. allocated (NoahmpIO%SMCWLT_TABLE) ) allocate( NoahmpIO%SMCWLT_TABLE(MAX_SOILTYP) ) + if ( .not. allocated (NoahmpIO%QUARTZ_TABLE) ) allocate( NoahmpIO%QUARTZ_TABLE(MAX_SOILTYP) ) + if ( .not. allocated (NoahmpIO%BVIC_TABLE) ) allocate( NoahmpIO%BVIC_TABLE (MAX_SOILTYP) ) + if ( .not. allocated (NoahmpIO%AXAJ_TABLE) ) allocate( NoahmpIO%AXAJ_TABLE (MAX_SOILTYP) ) + if ( .not. allocated (NoahmpIO%BXAJ_TABLE) ) allocate( NoahmpIO%BXAJ_TABLE (MAX_SOILTYP) ) + if ( .not. allocated (NoahmpIO%XXAJ_TABLE) ) allocate( NoahmpIO%XXAJ_TABLE (MAX_SOILTYP) ) + if ( .not. allocated (NoahmpIO%BDVIC_TABLE) ) allocate( NoahmpIO%BDVIC_TABLE (MAX_SOILTYP) ) + if ( .not. allocated (NoahmpIO%GDVIC_TABLE) ) allocate( NoahmpIO%GDVIC_TABLE (MAX_SOILTYP) ) + if ( .not. allocated (NoahmpIO%BBVIC_TABLE) ) allocate( NoahmpIO%BBVIC_TABLE (MAX_SOILTYP) ) + + ! general parameters + if ( .not. allocated (NoahmpIO%SLOPE_TABLE) ) allocate( NoahmpIO%SLOPE_TABLE(NUM_SLOPE) ) + + ! radiation parameters + if ( .not. allocated (NoahmpIO%ALBSAT_TABLE) ) allocate( NoahmpIO%ALBSAT_TABLE(MSC,MBAND) ) + if ( .not. allocated (NoahmpIO%ALBDRY_TABLE) ) allocate( NoahmpIO%ALBDRY_TABLE(MSC,MBAND) ) + if ( .not. allocated (NoahmpIO%ALBICE_TABLE) ) allocate( NoahmpIO%ALBICE_TABLE(MBAND) ) + if ( .not. allocated (NoahmpIO%ALBLAK_TABLE) ) allocate( NoahmpIO%ALBLAK_TABLE(MBAND) ) + if ( .not. allocated (NoahmpIO%OMEGAS_TABLE) ) allocate( NoahmpIO%OMEGAS_TABLE(MBAND) ) + if ( .not. allocated (NoahmpIO%EG_TABLE) ) allocate( NoahmpIO%EG_TABLE(2) ) + + ! tile drainage parameters + if ( .not. allocated (NoahmpIO%TDSMC_FAC_TABLE) ) allocate( NoahmpIO%TDSMC_FAC_TABLE(MAX_SOILTYP) ) + if ( .not. allocated (NoahmpIO%TD_DC_TABLE) ) allocate( NoahmpIO%TD_DC_TABLE (MAX_SOILTYP) ) + if ( .not. allocated (NoahmpIO%TD_DEPTH_TABLE) ) allocate( NoahmpIO%TD_DEPTH_TABLE (MAX_SOILTYP) ) + if ( .not. allocated (NoahmpIO%TD_DCOEF_TABLE) ) allocate( NoahmpIO%TD_DCOEF_TABLE (MAX_SOILTYP) ) + if ( .not. allocated (NoahmpIO%TD_D_TABLE) ) allocate( NoahmpIO%TD_D_TABLE (MAX_SOILTYP) ) + if ( .not. allocated (NoahmpIO%TD_ADEPTH_TABLE) ) allocate( NoahmpIO%TD_ADEPTH_TABLE(MAX_SOILTYP) ) + if ( .not. allocated (NoahmpIO%TD_RADI_TABLE) ) allocate( NoahmpIO%TD_RADI_TABLE (MAX_SOILTYP) ) + if ( .not. allocated (NoahmpIO%TD_SPAC_TABLE) ) allocate( NoahmpIO%TD_SPAC_TABLE (MAX_SOILTYP) ) + if ( .not. allocated (NoahmpIO%TD_DDRAIN_TABLE) ) allocate( NoahmpIO%TD_DDRAIN_TABLE(MAX_SOILTYP) ) + if ( .not. allocated (NoahmpIO%KLAT_FAC_TABLE) ) allocate( NoahmpIO%KLAT_FAC_TABLE (MAX_SOILTYP) ) + + ! crop parameters + if ( .not. allocated (NoahmpIO%PLTDAY_TABLE) ) allocate( NoahmpIO%PLTDAY_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%HSDAY_TABLE) ) allocate( NoahmpIO%HSDAY_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%PLANTPOP_TABLE) ) allocate( NoahmpIO%PLANTPOP_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%IRRI_TABLE) ) allocate( NoahmpIO%IRRI_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%GDDTBASE_TABLE) ) allocate( NoahmpIO%GDDTBASE_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%GDDTCUT_TABLE) ) allocate( NoahmpIO%GDDTCUT_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%GDDS1_TABLE) ) allocate( NoahmpIO%GDDS1_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%GDDS2_TABLE) ) allocate( NoahmpIO%GDDS2_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%GDDS3_TABLE) ) allocate( NoahmpIO%GDDS3_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%GDDS4_TABLE) ) allocate( NoahmpIO%GDDS4_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%GDDS5_TABLE) ) allocate( NoahmpIO%GDDS5_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%C3PSNI_TABLE) ) allocate( NoahmpIO%C3PSNI_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%KC25I_TABLE) ) allocate( NoahmpIO%KC25I_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%AKCI_TABLE) ) allocate( NoahmpIO%AKCI_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%KO25I_TABLE) ) allocate( NoahmpIO%KO25I_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%AKOI_TABLE) ) allocate( NoahmpIO%AKOI_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%VCMX25I_TABLE) ) allocate( NoahmpIO%VCMX25I_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%AVCMXI_TABLE) ) allocate( NoahmpIO%AVCMXI_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%BPI_TABLE) ) allocate( NoahmpIO%BPI_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%MPI_TABLE) ) allocate( NoahmpIO%MPI_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%QE25I_TABLE) ) allocate( NoahmpIO%QE25I_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%FOLNMXI_TABLE) ) allocate( NoahmpIO%FOLNMXI_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%AREF_TABLE) ) allocate( NoahmpIO%AREF_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%PSNRF_TABLE) ) allocate( NoahmpIO%PSNRF_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%I2PAR_TABLE) ) allocate( NoahmpIO%I2PAR_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%TASSIM0_TABLE) ) allocate( NoahmpIO%TASSIM0_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%TASSIM1_TABLE) ) allocate( NoahmpIO%TASSIM1_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%TASSIM2_TABLE) ) allocate( NoahmpIO%TASSIM2_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%K_TABLE) ) allocate( NoahmpIO%K_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%EPSI_TABLE) ) allocate( NoahmpIO%EPSI_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%Q10MR_TABLE) ) allocate( NoahmpIO%Q10MR_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%LEFREEZ_TABLE) ) allocate( NoahmpIO%LEFREEZ_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%DILE_FC_TABLE) ) allocate( NoahmpIO%DILE_FC_TABLE (NCROP,NSTAGE) ) + if ( .not. allocated (NoahmpIO%DILE_FW_TABLE) ) allocate( NoahmpIO%DILE_FW_TABLE (NCROP,NSTAGE) ) + if ( .not. allocated (NoahmpIO%FRA_GR_TABLE) ) allocate( NoahmpIO%FRA_GR_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%LF_OVRC_TABLE) ) allocate( NoahmpIO%LF_OVRC_TABLE (NCROP,NSTAGE) ) + if ( .not. allocated (NoahmpIO%ST_OVRC_TABLE) ) allocate( NoahmpIO%ST_OVRC_TABLE (NCROP,NSTAGE) ) + if ( .not. allocated (NoahmpIO%RT_OVRC_TABLE) ) allocate( NoahmpIO%RT_OVRC_TABLE (NCROP,NSTAGE) ) + if ( .not. allocated (NoahmpIO%LFMR25_TABLE) ) allocate( NoahmpIO%LFMR25_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%STMR25_TABLE) ) allocate( NoahmpIO%STMR25_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%RTMR25_TABLE) ) allocate( NoahmpIO%RTMR25_TABLE (NCROP) ) + if ( .not. allocated (NoahmpIO%GRAINMR25_TABLE) ) allocate( NoahmpIO%GRAINMR25_TABLE(NCROP) ) + if ( .not. allocated (NoahmpIO%LFPT_TABLE) ) allocate( NoahmpIO%LFPT_TABLE (NCROP,NSTAGE) ) + if ( .not. allocated (NoahmpIO%STPT_TABLE) ) allocate( NoahmpIO%STPT_TABLE (NCROP,NSTAGE) ) + if ( .not. allocated (NoahmpIO%RTPT_TABLE) ) allocate( NoahmpIO%RTPT_TABLE (NCROP,NSTAGE) ) + if ( .not. allocated (NoahmpIO%GRAINPT_TABLE) ) allocate( NoahmpIO%GRAINPT_TABLE (NCROP,NSTAGE) ) + if ( .not. allocated (NoahmpIO%LFCT_TABLE) ) allocate( NoahmpIO%LFCT_TABLE (NCROP,NSTAGE) ) + if ( .not. allocated (NoahmpIO%STCT_TABLE) ) allocate( NoahmpIO%STCT_TABLE (NCROP,NSTAGE) ) + if ( .not. allocated (NoahmpIO%RTCT_TABLE) ) allocate( NoahmpIO%RTCT_TABLE (NCROP,NSTAGE) ) + if ( .not. allocated (NoahmpIO%BIO2LAI_TABLE) ) allocate( NoahmpIO%BIO2LAI_TABLE (NCROP) ) + + !--------------------------------------------------------------- + ! intialization to bad value, so that if the namelist read fails, + ! we come to a screeching halt as soon as we try to use anything + !--------------------------------------------------------------- + + ! vegetation parameters + NoahmpIO%ISURBAN_TABLE = undefined_int + NoahmpIO%ISWATER_TABLE = undefined_int + NoahmpIO%ISBARREN_TABLE = undefined_int + NoahmpIO%ISICE_TABLE = undefined_int + NoahmpIO%ISCROP_TABLE = undefined_int + NoahmpIO%EBLFOREST_TABLE = undefined_int + NoahmpIO%NATURAL_TABLE = undefined_int + NoahmpIO%URBTYPE_beg = undefined_int + NoahmpIO%LCZ_1_TABLE = undefined_int + NoahmpIO%LCZ_2_TABLE = undefined_int + NoahmpIO%LCZ_3_TABLE = undefined_int + NoahmpIO%LCZ_4_TABLE = undefined_int + NoahmpIO%LCZ_5_TABLE = undefined_int + NoahmpIO%LCZ_6_TABLE = undefined_int + NoahmpIO%LCZ_7_TABLE = undefined_int + NoahmpIO%LCZ_8_TABLE = undefined_int + NoahmpIO%LCZ_9_TABLE = undefined_int + NoahmpIO%LCZ_10_TABLE = undefined_int + NoahmpIO%LCZ_11_TABLE = undefined_int + NoahmpIO%CH2OP_TABLE = undefined_real + NoahmpIO%DLEAF_TABLE = undefined_real + NoahmpIO%Z0MVT_TABLE = undefined_real + NoahmpIO%HVT_TABLE = undefined_real + NoahmpIO%HVB_TABLE = undefined_real + NoahmpIO%DEN_TABLE = undefined_real + NoahmpIO%RC_TABLE = undefined_real + NoahmpIO%MFSNO_TABLE = undefined_real + NoahmpIO%SCFFAC_TABLE = undefined_real + NoahmpIO%CBIOM_TABLE = undefined_real + NoahmpIO%RHOL_TABLE = undefined_real + NoahmpIO%RHOS_TABLE = undefined_real + NoahmpIO%TAUL_TABLE = undefined_real + NoahmpIO%TAUS_TABLE = undefined_real + NoahmpIO%XL_TABLE = undefined_real + NoahmpIO%CWPVT_TABLE = undefined_real + NoahmpIO%C3PSN_TABLE = undefined_real + NoahmpIO%KC25_TABLE = undefined_real + NoahmpIO%AKC_TABLE = undefined_real + NoahmpIO%KO25_TABLE = undefined_real + NoahmpIO%AKO_TABLE = undefined_real + NoahmpIO%AVCMX_TABLE = undefined_real + NoahmpIO%AQE_TABLE = undefined_real + NoahmpIO%LTOVRC_TABLE = undefined_real + NoahmpIO%DILEFC_TABLE = undefined_real + NoahmpIO%DILEFW_TABLE = undefined_real + NoahmpIO%RMF25_TABLE = undefined_real + NoahmpIO%SLA_TABLE = undefined_real + NoahmpIO%FRAGR_TABLE = undefined_real + NoahmpIO%TMIN_TABLE = undefined_real + NoahmpIO%VCMX25_TABLE = undefined_real + NoahmpIO%TDLEF_TABLE = undefined_real + NoahmpIO%BP_TABLE = undefined_real + NoahmpIO%MP_TABLE = undefined_real + NoahmpIO%QE25_TABLE = undefined_real + NoahmpIO%RMS25_TABLE = undefined_real + NoahmpIO%RMR25_TABLE = undefined_real + NoahmpIO%ARM_TABLE = undefined_real + NoahmpIO%FOLNMX_TABLE = undefined_real + NoahmpIO%WDPOOL_TABLE = undefined_real + NoahmpIO%WRRAT_TABLE = undefined_real + NoahmpIO%MRP_TABLE = undefined_real + NoahmpIO%SAIM_TABLE = undefined_real + NoahmpIO%LAIM_TABLE = undefined_real + NoahmpIO%NROOT_TABLE = undefined_real + NoahmpIO%RGL_TABLE = undefined_real + NoahmpIO%RS_TABLE = undefined_real + NoahmpIO%HS_TABLE = undefined_real + NoahmpIO%TOPT_TABLE = undefined_real + NoahmpIO%RSMAX_TABLE = undefined_real + NoahmpIO%RTOVRC_TABLE = undefined_real + NoahmpIO%RSWOODC_TABLE = undefined_real + NoahmpIO%BF_TABLE = undefined_real + NoahmpIO%WSTRC_TABLE = undefined_real + NoahmpIO%LAIMIN_TABLE = undefined_real + NoahmpIO%XSAMIN_TABLE = undefined_real + + ! soil parameters + NoahmpIO%SLCATS_TABLE = undefined_int + NoahmpIO%BEXP_TABLE = undefined_real + NoahmpIO%SMCDRY_TABLE = undefined_real + NoahmpIO%SMCMAX_TABLE = undefined_real + NoahmpIO%SMCREF_TABLE = undefined_real + NoahmpIO%PSISAT_TABLE = undefined_real + NoahmpIO%DKSAT_TABLE = undefined_real + NoahmpIO%DWSAT_TABLE = undefined_real + NoahmpIO%SMCWLT_TABLE = undefined_real + NoahmpIO%QUARTZ_TABLE = undefined_real + NoahmpIO%BVIC_TABLE = undefined_real + NoahmpIO%AXAJ_TABLE = undefined_real + NoahmpIO%BXAJ_TABLE = undefined_real + NoahmpIO%XXAJ_TABLE = undefined_real + NoahmpIO%BDVIC_TABLE = undefined_real + NoahmpIO%GDVIC_TABLE = undefined_real + NoahmpIO%BBVIC_TABLE = undefined_real + + ! general parameters + NoahmpIO%SLOPE_TABLE = undefined_real + NoahmpIO%CSOIL_TABLE = undefined_real + NoahmpIO%REFDK_TABLE = undefined_real + NoahmpIO%REFKDT_TABLE = undefined_real + NoahmpIO%FRZK_TABLE = undefined_real + NoahmpIO%ZBOT_TABLE = undefined_real + NoahmpIO%CZIL_TABLE = undefined_real + + ! radiation parameters + NoahmpIO%ALBSAT_TABLE = undefined_real + NoahmpIO%ALBDRY_TABLE = undefined_real + NoahmpIO%ALBICE_TABLE = undefined_real + NoahmpIO%ALBLAK_TABLE = undefined_real + NoahmpIO%OMEGAS_TABLE = undefined_real + NoahmpIO%BETADS_TABLE = undefined_real + NoahmpIO%BETAIS_TABLE = undefined_real + NoahmpIO%EG_TABLE = undefined_real + NoahmpIO%EICE_TABLE = undefined_real + + ! global parameters + NoahmpIO%CO2_TABLE = undefined_real + NoahmpIO%O2_TABLE = undefined_real + NoahmpIO%TIMEAN_TABLE = undefined_real + NoahmpIO%FSATMX_TABLE = undefined_real + NoahmpIO%Z0SNO_TABLE = undefined_real + NoahmpIO%SSI_TABLE = undefined_real + NoahmpIO%SNOW_RET_FAC_TABLE = undefined_real + NoahmpIO%SNOW_EMIS_TABLE = undefined_real + NoahmpIO%SWEMX_TABLE = undefined_real + NoahmpIO%TAU0_TABLE = undefined_real + NoahmpIO%GRAIN_GROWTH_TABLE = undefined_real + NoahmpIO%EXTRA_GROWTH_TABLE = undefined_real + NoahmpIO%DIRT_SOOT_TABLE = undefined_real + NoahmpIO%BATS_COSZ_TABLE = undefined_real + NoahmpIO%BATS_VIS_NEW_TABLE = undefined_real + NoahmpIO%BATS_NIR_NEW_TABLE = undefined_real + NoahmpIO%BATS_VIS_AGE_TABLE = undefined_real + NoahmpIO%BATS_NIR_AGE_TABLE = undefined_real + NoahmpIO%BATS_VIS_DIR_TABLE = undefined_real + NoahmpIO%BATS_NIR_DIR_TABLE = undefined_real + NoahmpIO%RSURF_SNOW_TABLE = undefined_real + NoahmpIO%RSURF_EXP_TABLE = undefined_real + NoahmpIO%C2_SNOWCOMPACT_TABLE = undefined_real + NoahmpIO%C3_SNOWCOMPACT_TABLE = undefined_real + NoahmpIO%C4_SNOWCOMPACT_TABLE = undefined_real + NoahmpIO%C5_SNOWCOMPACT_TABLE = undefined_real + NoahmpIO%DM_SNOWCOMPACT_TABLE = undefined_real + NoahmpIO%ETA0_SNOWCOMPACT_TABLE = undefined_real + NoahmpIO%SNLIQMAXFRAC_TABLE = undefined_real + NoahmpIO%SWEMAXGLA_TABLE = undefined_real + NoahmpIO%WSLMAX_TABLE = undefined_real + NoahmpIO%ROUS_TABLE = undefined_real + NoahmpIO%CMIC_TABLE = undefined_real + NoahmpIO%SNOWDEN_MAX_TABLE = undefined_real + NoahmpIO%CLASS_ALB_REF_TABLE = undefined_real + NoahmpIO%CLASS_SNO_AGE_TABLE = undefined_real + NoahmpIO%CLASS_ALB_NEW_TABLE = undefined_real + NoahmpIO%PSIWLT_TABLE = undefined_real + NoahmpIO%Z0SOIL_TABLE = undefined_real + NoahmpIO%Z0LAKE_TABLE = undefined_real + + ! irrigation parameters + NoahmpIO%IRR_HAR_TABLE = undefined_int + NoahmpIO%IRR_FRAC_TABLE = undefined_real + NoahmpIO%IRR_LAI_TABLE = undefined_real + NoahmpIO%IRR_MAD_TABLE = undefined_real + NoahmpIO%FILOSS_TABLE = undefined_real + NoahmpIO%SPRIR_RATE_TABLE = undefined_real + NoahmpIO%MICIR_RATE_TABLE = undefined_real + NoahmpIO%FIRTFAC_TABLE = undefined_real + NoahmpIO%IR_RAIN_TABLE = undefined_real + + ! crop parameters + NoahmpIO%DEFAULT_CROP_TABLE = undefined_int + NoahmpIO%PLTDAY_TABLE = undefined_int + NoahmpIO%HSDAY_TABLE = undefined_int + NoahmpIO%PLANTPOP_TABLE = undefined_real + NoahmpIO%IRRI_TABLE = undefined_real + NoahmpIO%GDDTBASE_TABLE = undefined_real + NoahmpIO%GDDTCUT_TABLE = undefined_real + NoahmpIO%GDDS1_TABLE = undefined_real + NoahmpIO%GDDS2_TABLE = undefined_real + NoahmpIO%GDDS3_TABLE = undefined_real + NoahmpIO%GDDS4_TABLE = undefined_real + NoahmpIO%GDDS5_TABLE = undefined_real + NoahmpIO%C3PSNI_TABLE = undefined_real + NoahmpIO%KC25I_TABLE = undefined_real + NoahmpIO%AKCI_TABLE = undefined_real + NoahmpIO%KO25I_TABLE = undefined_real + NoahmpIO%AKOI_TABLE = undefined_real + NoahmpIO%AVCMXI_TABLE = undefined_real + NoahmpIO%VCMX25I_TABLE = undefined_real + NoahmpIO%BPI_TABLE = undefined_real + NoahmpIO%MPI_TABLE = undefined_real + NoahmpIO%FOLNMXI_TABLE = undefined_real + NoahmpIO%QE25I_TABLE = undefined_real + NoahmpIO%AREF_TABLE = undefined_real + NoahmpIO%PSNRF_TABLE = undefined_real + NoahmpIO%I2PAR_TABLE = undefined_real + NoahmpIO%TASSIM0_TABLE = undefined_real + NoahmpIO%TASSIM1_TABLE = undefined_real + NoahmpIO%TASSIM2_TABLE = undefined_real + NoahmpIO%K_TABLE = undefined_real + NoahmpIO%EPSI_TABLE = undefined_real + NoahmpIO%Q10MR_TABLE = undefined_real + NoahmpIO%LEFREEZ_TABLE = undefined_real + NoahmpIO%DILE_FC_TABLE = undefined_real + NoahmpIO%DILE_FW_TABLE = undefined_real + NoahmpIO%FRA_GR_TABLE = undefined_real + NoahmpIO%LF_OVRC_TABLE = undefined_real + NoahmpIO%ST_OVRC_TABLE = undefined_real + NoahmpIO%RT_OVRC_TABLE = undefined_real + NoahmpIO%LFMR25_TABLE = undefined_real + NoahmpIO%STMR25_TABLE = undefined_real + NoahmpIO%RTMR25_TABLE = undefined_real + NoahmpIO%GRAINMR25_TABLE = undefined_real + NoahmpIO%LFPT_TABLE = undefined_real + NoahmpIO%STPT_TABLE = undefined_real + NoahmpIO%RTPT_TABLE = undefined_real + NoahmpIO%GRAINPT_TABLE = undefined_real + NoahmpIO%LFCT_TABLE = undefined_real + NoahmpIO%STCT_TABLE = undefined_real + NoahmpIO%RTCT_TABLE = undefined_real + NoahmpIO%BIO2LAI_TABLE = undefined_real + + ! tile drainage parameters + NoahmpIO%DRAIN_LAYER_OPT_TABLE = undefined_int + NoahmpIO%TD_DEPTH_TABLE = undefined_int + NoahmpIO%TDSMC_FAC_TABLE = undefined_real + NoahmpIO%TD_DC_TABLE = undefined_real + NoahmpIO%TD_DCOEF_TABLE = undefined_real + NoahmpIO%TD_D_TABLE = undefined_real + NoahmpIO%TD_ADEPTH_TABLE = undefined_real + NoahmpIO%TD_RADI_TABLE = undefined_real + NoahmpIO%TD_SPAC_TABLE = undefined_real + NoahmpIO%TD_DDRAIN_TABLE = undefined_real + NoahmpIO%KLAT_FAC_TABLE = undefined_real + + ! optional parameters + NoahmpIO%sr2006_theta_1500t_a_TABLE = undefined_real + NoahmpIO%sr2006_theta_1500t_b_TABLE = undefined_real + NoahmpIO%sr2006_theta_1500t_c_TABLE = undefined_real + NoahmpIO%sr2006_theta_1500t_d_TABLE = undefined_real + NoahmpIO%sr2006_theta_1500t_e_TABLE = undefined_real + NoahmpIO%sr2006_theta_1500t_f_TABLE = undefined_real + NoahmpIO%sr2006_theta_1500t_g_TABLE = undefined_real + NoahmpIO%sr2006_theta_1500_a_TABLE = undefined_real + NoahmpIO%sr2006_theta_1500_b_TABLE = undefined_real + NoahmpIO%sr2006_theta_33t_a_TABLE = undefined_real + NoahmpIO%sr2006_theta_33t_b_TABLE = undefined_real + NoahmpIO%sr2006_theta_33t_c_TABLE = undefined_real + NoahmpIO%sr2006_theta_33t_d_TABLE = undefined_real + NoahmpIO%sr2006_theta_33t_e_TABLE = undefined_real + NoahmpIO%sr2006_theta_33t_f_TABLE = undefined_real + NoahmpIO%sr2006_theta_33t_g_TABLE = undefined_real + NoahmpIO%sr2006_theta_33_a_TABLE = undefined_real + NoahmpIO%sr2006_theta_33_b_TABLE = undefined_real + NoahmpIO%sr2006_theta_33_c_TABLE = undefined_real + NoahmpIO%sr2006_theta_s33t_a_TABLE = undefined_real + NoahmpIO%sr2006_theta_s33t_b_TABLE = undefined_real + NoahmpIO%sr2006_theta_s33t_c_TABLE = undefined_real + NoahmpIO%sr2006_theta_s33t_d_TABLE = undefined_real + NoahmpIO%sr2006_theta_s33t_e_TABLE = undefined_real + NoahmpIO%sr2006_theta_s33t_f_TABLE = undefined_real + NoahmpIO%sr2006_theta_s33t_g_TABLE = undefined_real + NoahmpIO%sr2006_theta_s33_a_TABLE = undefined_real + NoahmpIO%sr2006_theta_s33_b_TABLE = undefined_real + NoahmpIO%sr2006_psi_et_a_TABLE = undefined_real + NoahmpIO%sr2006_psi_et_b_TABLE = undefined_real + NoahmpIO%sr2006_psi_et_c_TABLE = undefined_real + NoahmpIO%sr2006_psi_et_d_TABLE = undefined_real + NoahmpIO%sr2006_psi_et_e_TABLE = undefined_real + NoahmpIO%sr2006_psi_et_f_TABLE = undefined_real + NoahmpIO%sr2006_psi_et_g_TABLE = undefined_real + NoahmpIO%sr2006_psi_e_a_TABLE = undefined_real + NoahmpIO%sr2006_psi_e_b_TABLE = undefined_real + NoahmpIO%sr2006_psi_e_c_TABLE = undefined_real + NoahmpIO%sr2006_smcmax_a_TABLE = undefined_real + NoahmpIO%sr2006_smcmax_b_TABLE = undefined_real + + !--------------------------------------------------------------- + ! transfer values from table to input variables + !--------------------------------------------------------------- + + !---------------- NoahmpTable.TBL vegetation parameters + + DATASET_IDENTIFIER = NoahmpIO%LLANDUSE + + inquire( file='NoahmpTable.TBL', exist=file_named ) + if ( file_named ) then + open(15, file="NoahmpTable.TBL", status='old', form='formatted', action='read', iostat=ierr) + else + open(15, status='old', form='formatted', action='read', iostat=ierr) + end if + if ( ierr /= 0 ) then + write(*,'("WARNING: Cannot find file NoahmpTable.TBL")') + endif + + if ( trim(DATASET_IDENTIFIER) == "USGS" ) then + read(15, noahmp_usgs_veg_categories) + read(15, noahmp_usgs_parameters) + elseif ( trim(DATASET_IDENTIFIER) == "MODIFIED_IGBP_MODIS_NOAH" ) then + read(15,noahmp_modis_veg_categories) + read(15,noahmp_modis_parameters) + else + write(*,'("WARNING: Unrecognized DATASET_IDENTIFIER in subroutine ReadNoahmpTable")') + write(*,'("WARNING: DATASET_IDENTIFIER = ''", A, "''")') trim(DATASET_IDENTIFIER) + endif + close(15) + + ! assign values + NoahmpIO%ISURBAN_TABLE = ISURBAN + NoahmpIO%ISWATER_TABLE = ISWATER + NoahmpIO%ISBARREN_TABLE = ISBARREN + NoahmpIO%ISICE_TABLE = ISICE + NoahmpIO%ISCROP_TABLE = ISCROP + NoahmpIO%EBLFOREST_TABLE = EBLFOREST + NoahmpIO%NATURAL_TABLE = NATURAL + NoahmpIO%URBTYPE_beg = URBTYPE_beg + NoahmpIO%LCZ_1_TABLE = LCZ_1 + NoahmpIO%LCZ_2_TABLE = LCZ_2 + NoahmpIO%LCZ_3_TABLE = LCZ_3 + NoahmpIO%LCZ_4_TABLE = LCZ_4 + NoahmpIO%LCZ_5_TABLE = LCZ_5 + NoahmpIO%LCZ_6_TABLE = LCZ_6 + NoahmpIO%LCZ_7_TABLE = LCZ_7 + NoahmpIO%LCZ_8_TABLE = LCZ_8 + NoahmpIO%LCZ_9_TABLE = LCZ_9 + NoahmpIO%LCZ_10_TABLE = LCZ_10 + NoahmpIO%LCZ_11_TABLE = LCZ_11 + NoahmpIO%CH2OP_TABLE (1:NVEG) = CH2OP (1:NVEG) + NoahmpIO%DLEAF_TABLE (1:NVEG) = DLEAF (1:NVEG) + NoahmpIO%Z0MVT_TABLE (1:NVEG) = Z0MVT (1:NVEG) + NoahmpIO%HVT_TABLE (1:NVEG) = HVT (1:NVEG) + NoahmpIO%HVB_TABLE (1:NVEG) = HVB (1:NVEG) + NoahmpIO%DEN_TABLE (1:NVEG) = DEN (1:NVEG) + NoahmpIO%RC_TABLE (1:NVEG) = RC (1:NVEG) + NoahmpIO%MFSNO_TABLE (1:NVEG) = MFSNO (1:NVEG) + NoahmpIO%SCFFAC_TABLE (1:NVEG) = SCFFAC (1:NVEG) + NoahmpIO%CBIOM_TABLE (1:NVEG) = CBIOM (1:NVEG) + NoahmpIO%XL_TABLE (1:NVEG) = XL (1:NVEG) + NoahmpIO%CWPVT_TABLE (1:NVEG) = CWPVT (1:NVEG) + NoahmpIO%C3PSN_TABLE (1:NVEG) = C3PSN (1:NVEG) + NoahmpIO%KC25_TABLE (1:NVEG) = KC25 (1:NVEG) + NoahmpIO%AKC_TABLE (1:NVEG) = AKC (1:NVEG) + NoahmpIO%KO25_TABLE (1:NVEG) = KO25 (1:NVEG) + NoahmpIO%AKO_TABLE (1:NVEG) = AKO (1:NVEG) + NoahmpIO%AVCMX_TABLE (1:NVEG) = AVCMX (1:NVEG) + NoahmpIO%AQE_TABLE (1:NVEG) = AQE (1:NVEG) + NoahmpIO%LTOVRC_TABLE (1:NVEG) = LTOVRC (1:NVEG) + NoahmpIO%DILEFC_TABLE (1:NVEG) = DILEFC (1:NVEG) + NoahmpIO%DILEFW_TABLE (1:NVEG) = DILEFW (1:NVEG) + NoahmpIO%RMF25_TABLE (1:NVEG) = RMF25 (1:NVEG) + NoahmpIO%SLA_TABLE (1:NVEG) = SLA (1:NVEG) + NoahmpIO%FRAGR_TABLE (1:NVEG) = FRAGR (1:NVEG) + NoahmpIO%TMIN_TABLE (1:NVEG) = TMIN (1:NVEG) + NoahmpIO%VCMX25_TABLE (1:NVEG) = VCMX25 (1:NVEG) + NoahmpIO%TDLEF_TABLE (1:NVEG) = TDLEF (1:NVEG) + NoahmpIO%BP_TABLE (1:NVEG) = BP (1:NVEG) + NoahmpIO%MP_TABLE (1:NVEG) = MP (1:NVEG) + NoahmpIO%QE25_TABLE (1:NVEG) = QE25 (1:NVEG) + NoahmpIO%RMS25_TABLE (1:NVEG) = RMS25 (1:NVEG) + NoahmpIO%RMR25_TABLE (1:NVEG) = RMR25 (1:NVEG) + NoahmpIO%ARM_TABLE (1:NVEG) = ARM (1:NVEG) + NoahmpIO%FOLNMX_TABLE (1:NVEG) = FOLNMX (1:NVEG) + NoahmpIO%WDPOOL_TABLE (1:NVEG) = WDPOOL (1:NVEG) + NoahmpIO%WRRAT_TABLE (1:NVEG) = WRRAT (1:NVEG) + NoahmpIO%MRP_TABLE (1:NVEG) = MRP (1:NVEG) + NoahmpIO%NROOT_TABLE (1:NVEG) = NROOT (1:NVEG) + NoahmpIO%RGL_TABLE (1:NVEG) = RGL (1:NVEG) + NoahmpIO%RS_TABLE (1:NVEG) = RS (1:NVEG) + NoahmpIO%HS_TABLE (1:NVEG) = HS (1:NVEG) + NoahmpIO%TOPT_TABLE (1:NVEG) = TOPT (1:NVEG) + NoahmpIO%RSMAX_TABLE (1:NVEG) = RSMAX (1:NVEG) + NoahmpIO%RTOVRC_TABLE (1:NVEG) = RTOVRC (1:NVEG) + NoahmpIO%RSWOODC_TABLE(1:NVEG) = RSWOODC(1:NVEG) + NoahmpIO%BF_TABLE (1:NVEG) = BF (1:NVEG) + NoahmpIO%WSTRC_TABLE (1:NVEG) = WSTRC (1:NVEG) + NoahmpIO%LAIMIN_TABLE (1:NVEG) = LAIMIN (1:NVEG) + NoahmpIO%XSAMIN_TABLE (1:NVEG) = XSAMIN (1:NVEG) + + NoahmpIO%SAIM_TABLE(1:NVEG, 1) = SAI_JAN(1:NVEG) + NoahmpIO%SAIM_TABLE(1:NVEG, 2) = SAI_FEB(1:NVEG) + NoahmpIO%SAIM_TABLE(1:NVEG, 3) = SAI_MAR(1:NVEG) + NoahmpIO%SAIM_TABLE(1:NVEG, 4) = SAI_APR(1:NVEG) + NoahmpIO%SAIM_TABLE(1:NVEG, 5) = SAI_MAY(1:NVEG) + NoahmpIO%SAIM_TABLE(1:NVEG, 6) = SAI_JUN(1:NVEG) + NoahmpIO%SAIM_TABLE(1:NVEG, 7) = SAI_JUL(1:NVEG) + NoahmpIO%SAIM_TABLE(1:NVEG, 8) = SAI_AUG(1:NVEG) + NoahmpIO%SAIM_TABLE(1:NVEG, 9) = SAI_SEP(1:NVEG) + NoahmpIO%SAIM_TABLE(1:NVEG,10) = SAI_OCT(1:NVEG) + NoahmpIO%SAIM_TABLE(1:NVEG,11) = SAI_NOV(1:NVEG) + NoahmpIO%SAIM_TABLE(1:NVEG,12) = SAI_DEC(1:NVEG) + NoahmpIO%LAIM_TABLE(1:NVEG, 1) = LAI_JAN(1:NVEG) + NoahmpIO%LAIM_TABLE(1:NVEG, 2) = LAI_FEB(1:NVEG) + NoahmpIO%LAIM_TABLE(1:NVEG, 3) = LAI_MAR(1:NVEG) + NoahmpIO%LAIM_TABLE(1:NVEG, 4) = LAI_APR(1:NVEG) + NoahmpIO%LAIM_TABLE(1:NVEG, 5) = LAI_MAY(1:NVEG) + NoahmpIO%LAIM_TABLE(1:NVEG, 6) = LAI_JUN(1:NVEG) + NoahmpIO%LAIM_TABLE(1:NVEG, 7) = LAI_JUL(1:NVEG) + NoahmpIO%LAIM_TABLE(1:NVEG, 8) = LAI_AUG(1:NVEG) + NoahmpIO%LAIM_TABLE(1:NVEG, 9) = LAI_SEP(1:NVEG) + NoahmpIO%LAIM_TABLE(1:NVEG,10) = LAI_OCT(1:NVEG) + NoahmpIO%LAIM_TABLE(1:NVEG,11) = LAI_NOV(1:NVEG) + NoahmpIO%LAIM_TABLE(1:NVEG,12) = LAI_DEC(1:NVEG) + NoahmpIO%RHOL_TABLE(1:NVEG,1) = RHOL_VIS(1:NVEG) !leaf reflectance: 1=vis, 2=nir + NoahmpIO%RHOL_TABLE(1:NVEG,2) = RHOL_NIR(1:NVEG) !leaf reflectance: 1=vis, 2=nir + NoahmpIO%RHOS_TABLE(1:NVEG,1) = RHOS_VIS(1:NVEG) !stem reflectance: 1=vis, 2=nir + NoahmpIO%RHOS_TABLE(1:NVEG,2) = RHOS_NIR(1:NVEG) !stem reflectance: 1=vis, 2=nir + NoahmpIO%TAUL_TABLE(1:NVEG,1) = TAUL_VIS(1:NVEG) !leaf transmittance: 1=vis, 2=nir + NoahmpIO%TAUL_TABLE(1:NVEG,2) = TAUL_NIR(1:NVEG) !leaf transmittance: 1=vis, 2=nir + NoahmpIO%TAUS_TABLE(1:NVEG,1) = TAUS_VIS(1:NVEG) !stem transmittance: 1=vis, 2=nir + NoahmpIO%TAUS_TABLE(1:NVEG,2) = TAUS_NIR(1:NVEG) !stem transmittance: 1=vis, 2=nir + + !---------------- NoahmpTable.TBL soil parameters + inquire( file='NoahmpTable.TBL', exist=file_named ) + if ( file_named ) then + open(15, file="NoahmpTable.TBL", status='old', form='formatted', action='read', iostat=ierr) + else + open(15, status='old', form='formatted', action='read', iostat=ierr) + end if + if ( ierr /= 0 ) then + write(*,'("WARNING: Cannot find file NoahmpTable.TBL")') + endif + read(15, noahmp_stas_soil_categories) + if ( trim(SLTYPE) == "STAS" ) then + read(15, noahmp_soil_stas_parameters) + elseif ( trim(SLTYPE) == "STAS_RUC" ) then + read(15, noahmp_soil_stas_ruc_parameters) + else + write(*,'("WARNING: Unrecognized SOILTYPE in subroutine ReadNoahmpTable")') + write(*,'("WARNING: DATASET_IDENTIFIER = ''", A, "''")') trim(SLTYPE) + endif + close(15) + + ! assign values + NoahmpIO%SLCATS_TABLE = SLCATS + NoahmpIO%BEXP_TABLE (1:SLCATS) = BB (1:SLCATS) + NoahmpIO%SMCDRY_TABLE(1:SLCATS) = DRYSMC(1:SLCATS) + NoahmpIO%SMCMAX_TABLE(1:SLCATS) = MAXSMC(1:SLCATS) + NoahmpIO%SMCREF_TABLE(1:SLCATS) = REFSMC(1:SLCATS) + NoahmpIO%PSISAT_TABLE(1:SLCATS) = SATPSI(1:SLCATS) + NoahmpIO%DKSAT_TABLE (1:SLCATS) = SATDK (1:SLCATS) + NoahmpIO%DWSAT_TABLE (1:SLCATS) = SATDW (1:SLCATS) + NoahmpIO%SMCWLT_TABLE(1:SLCATS) = WLTSMC(1:SLCATS) + NoahmpIO%QUARTZ_TABLE(1:SLCATS) = QTZ (1:SLCATS) + NoahmpIO%BVIC_TABLE (1:SLCATS) = BVIC (1:SLCATS) + NoahmpIO%AXAJ_TABLE (1:SLCATS) = AXAJ (1:SLCATS) + NoahmpIO%BXAJ_TABLE (1:SLCATS) = BXAJ (1:SLCATS) + NoahmpIO%XXAJ_TABLE (1:SLCATS) = XXAJ (1:SLCATS) + NoahmpIO%BDVIC_TABLE (1:SLCATS) = BDVIC (1:SLCATS) + NoahmpIO%GDVIC_TABLE (1:SLCATS) = GDVIC (1:SLCATS) + NoahmpIO%BBVIC_TABLE (1:SLCATS) = BBVIC (1:SLCATS) + + !---------------- NoahmpTable.TBL general parameters + inquire( file='NoahmpTable.TBL', exist=file_named ) + if ( file_named ) then + open(15, file="NoahmpTable.TBL", status='old', form='formatted', action='read', iostat=ierr) + else + open(15, status='old', form='formatted', action='read', iostat=ierr) + end if + if ( ierr /= 0 ) then + write(*,'("WARNING: Cannot find file NoahmpTable.TBL")') + endif + read(15, noahmp_general_parameters) + close(15) + + ! assign values + NoahmpIO%SLOPE_TABLE(1:NUM_SLOPE) = SLOPE_DATA(1:NUM_SLOPE) + NoahmpIO%CSOIL_TABLE = CSOIL_DATA + NoahmpIO%REFDK_TABLE = REFDK_DATA + NoahmpIO%REFKDT_TABLE = REFKDT_DATA + NoahmpIO%FRZK_TABLE = FRZK_DATA + NoahmpIO%ZBOT_TABLE = ZBOT_DATA + NoahmpIO%CZIL_TABLE = CZIL_DATA + + !---------------- NoahmpTable.TBL radiation parameters + inquire( file='NoahmpTable.TBL', exist=file_named ) + if ( file_named ) then + open(15, file="NoahmpTable.TBL", status='old', form='formatted', action='read', iostat=ierr) + else + open(15, status='old', form='formatted', action='read', iostat=ierr) + end if + if (ierr /= 0) then + write(*,'("WARNING: Cannot find file NoahmpTable.TBL")') + endif + read(15,noahmp_rad_parameters) + close(15) + + ! assign values + NoahmpIO%ALBSAT_TABLE(:,1) = ALBSAT_VIS ! saturated soil albedos: 1=vis, 2=nir + NoahmpIO%ALBSAT_TABLE(:,2) = ALBSAT_NIR ! saturated soil albedos: 1=vis, 2=nir + NoahmpIO%ALBDRY_TABLE(:,1) = ALBDRY_VIS ! dry soil albedos: 1=vis, 2=nir + NoahmpIO%ALBDRY_TABLE(:,2) = ALBDRY_NIR ! dry soil albedos: 1=vis, 2=nir + NoahmpIO%ALBICE_TABLE = ALBICE + NoahmpIO%ALBLAK_TABLE = ALBLAK + NoahmpIO%OMEGAS_TABLE = OMEGAS + NoahmpIO%BETADS_TABLE = BETADS + NoahmpIO%BETAIS_TABLE = BETAIS + NoahmpIO%EG_TABLE = EG + NoahmpIO%EICE_TABLE = EICE + + !---------------- NoahmpTable.TBL global parameters + inquire( file='NoahmpTable.TBL', exist=file_named ) + if ( file_named ) then + open(15, file="NoahmpTable.TBL", status='old', form='formatted', action='read', iostat=ierr) + else + open(15, status='old', form='formatted', action='read', iostat=ierr) + end if + if (ierr /= 0) then + write(*,'("WARNING: Cannot find file NoahmpTable.TBL")') + endif + read(15,noahmp_global_parameters) + close(15) + + ! assign values + NoahmpIO%CO2_TABLE = CO2 + NoahmpIO%O2_TABLE = O2 + NoahmpIO%TIMEAN_TABLE = TIMEAN + NoahmpIO%FSATMX_TABLE = FSATMX + NoahmpIO%Z0SNO_TABLE = Z0SNO + NoahmpIO%SSI_TABLE = SSI + NoahmpIO%SNOW_RET_FAC_TABLE = SNOW_RET_FAC + NoahmpIO%SNOW_EMIS_TABLE = SNOW_EMIS + NoahmpIO%SWEMX_TABLE = SWEMX + NoahmpIO%TAU0_TABLE = TAU0 + NoahmpIO%GRAIN_GROWTH_TABLE = GRAIN_GROWTH + NoahmpIO%EXTRA_GROWTH_TABLE = EXTRA_GROWTH + NoahmpIO%DIRT_SOOT_TABLE = DIRT_SOOT + NoahmpIO%BATS_COSZ_TABLE = BATS_COSZ + NoahmpIO%BATS_VIS_NEW_TABLE = BATS_VIS_NEW + NoahmpIO%BATS_NIR_NEW_TABLE = BATS_NIR_NEW + NoahmpIO%BATS_VIS_AGE_TABLE = BATS_VIS_AGE + NoahmpIO%BATS_NIR_AGE_TABLE = BATS_NIR_AGE + NoahmpIO%BATS_VIS_DIR_TABLE = BATS_VIS_DIR + NoahmpIO%BATS_NIR_DIR_TABLE = BATS_NIR_DIR + NoahmpIO%RSURF_SNOW_TABLE = RSURF_SNOW + NoahmpIO%RSURF_EXP_TABLE = RSURF_EXP + NoahmpIO%C2_SNOWCOMPACT_TABLE = C2_SNOWCOMPACT + NoahmpIO%C3_SNOWCOMPACT_TABLE = C3_SNOWCOMPACT + NoahmpIO%C4_SNOWCOMPACT_TABLE = C4_SNOWCOMPACT + NoahmpIO%C5_SNOWCOMPACT_TABLE = C5_SNOWCOMPACT + NoahmpIO%DM_SNOWCOMPACT_TABLE = DM_SNOWCOMPACT + NoahmpIO%ETA0_SNOWCOMPACT_TABLE = ETA0_SNOWCOMPACT + NoahmpIO%SNLIQMAXFRAC_TABLE = SNLIQMAXFRAC + NoahmpIO%SWEMAXGLA_TABLE = SWEMAXGLA + NoahmpIO%WSLMAX_TABLE = WSLMAX + NoahmpIO%ROUS_TABLE = ROUS + NoahmpIO%CMIC_TABLE = CMIC + NoahmpIO%SNOWDEN_MAX_TABLE = SNOWDEN_MAX + NoahmpIO%CLASS_ALB_REF_TABLE = CLASS_ALB_REF + NoahmpIO%CLASS_SNO_AGE_TABLE = CLASS_SNO_AGE + NoahmpIO%CLASS_ALB_NEW_TABLE = CLASS_ALB_NEW + NoahmpIO%PSIWLT_TABLE = PSIWLT + NoahmpIO%Z0SOIL_TABLE = Z0SOIL + NoahmpIO%Z0LAKE_TABLE = Z0LAKE + + !---------------- NoahmpTable.TBL irrigation parameters + inquire( file='NoahmpTable.TBL', exist=file_named ) + if ( file_named ) then + open(15, file="NoahmpTable.TBL", status='old', form='formatted', action='read', iostat=ierr) + else + open(15, status='old', form='formatted', action='read', iostat=ierr) + end if + if (ierr /= 0) then + write(*,'("WARNING: Cannot find file NoahmpTable.TBL")') + endif + read(15,noahmp_irrigation_parameters) + close(15) + if ( (FILOSS < 0.0) .or. (FILOSS > 0.99) ) then + write(*,'("WARNING: FILOSS should be >=0.0 and <=0.99")') + stop "STOP in NoahMP_irrigation_parameters" + endif + + ! assign values + NoahmpIO%IRR_FRAC_TABLE = IRR_FRAC + NoahmpIO%IRR_HAR_TABLE = IRR_HAR + NoahmpIO%IRR_LAI_TABLE = IRR_LAI + NoahmpIO%IRR_MAD_TABLE = IRR_MAD + NoahmpIO%FILOSS_TABLE = FILOSS + NoahmpIO%SPRIR_RATE_TABLE = SPRIR_RATE + NoahmpIO%MICIR_RATE_TABLE = MICIR_RATE + NoahmpIO%FIRTFAC_TABLE = FIRTFAC + NoahmpIO%IR_RAIN_TABLE = IR_RAIN + + !---------------- NoahmpTable.TBL crop parameters + inquire( file='NoahmpTable.TBL', exist=file_named ) + if ( file_named ) then + open(15, file="NoahmpTable.TBL", status='old', form='formatted', action='read', iostat=ierr) + else + open(15, status='old', form='formatted', action='read', iostat=ierr) + end if + if (ierr /= 0) then + write(*,'("WARNING: Cannot find file NoahmpTable.TBL")') + endif + read(15,noahmp_crop_parameters) + close(15) + + ! assign values + NoahmpIO%DEFAULT_CROP_TABLE = DEFAULT_CROP + NoahmpIO%PLTDAY_TABLE = PLTDAY + NoahmpIO%HSDAY_TABLE = HSDAY + NoahmpIO%PLANTPOP_TABLE = PLANTPOP + NoahmpIO%IRRI_TABLE = IRRI + NoahmpIO%GDDTBASE_TABLE = GDDTBASE + NoahmpIO%GDDTCUT_TABLE = GDDTCUT + NoahmpIO%GDDS1_TABLE = GDDS1 + NoahmpIO%GDDS2_TABLE = GDDS2 + NoahmpIO%GDDS3_TABLE = GDDS3 + NoahmpIO%GDDS4_TABLE = GDDS4 + NoahmpIO%GDDS5_TABLE = GDDS5 + NoahmpIO%C3PSNI_TABLE (1:5) = C3PSNI (1:5) + NoahmpIO%KC25I_TABLE (1:5) = KC25I (1:5) + NoahmpIO%AKCI_TABLE (1:5) = AKCI (1:5) + NoahmpIO%KO25I_TABLE (1:5) = KO25I (1:5) + NoahmpIO%AKOI_TABLE (1:5) = AKOI (1:5) + NoahmpIO%AVCMXI_TABLE (1:5) = AVCMXI (1:5) + NoahmpIO%VCMX25I_TABLE(1:5) = VCMX25I(1:5) + NoahmpIO%BPI_TABLE (1:5) = BPI (1:5) + NoahmpIO%MPI_TABLE (1:5) = MPI (1:5) + NoahmpIO%FOLNMXI_TABLE(1:5) = FOLNMXI(1:5) + NoahmpIO%QE25I_TABLE (1:5) = QE25I (1:5) + NoahmpIO%AREF_TABLE = AREF + NoahmpIO%PSNRF_TABLE = PSNRF + NoahmpIO%I2PAR_TABLE = I2PAR + NoahmpIO%TASSIM0_TABLE = TASSIM0 + NoahmpIO%TASSIM1_TABLE = TASSIM1 + NoahmpIO%TASSIM2_TABLE = TASSIM2 + NoahmpIO%K_TABLE = K + NoahmpIO%EPSI_TABLE = EPSI + NoahmpIO%Q10MR_TABLE = Q10MR + NoahmpIO%LEFREEZ_TABLE = LEFREEZ + NoahmpIO%FRA_GR_TABLE = FRA_GR + NoahmpIO%LFMR25_TABLE = LFMR25 + NoahmpIO%STMR25_TABLE = STMR25 + NoahmpIO%RTMR25_TABLE = RTMR25 + NoahmpIO%GRAINMR25_TABLE = GRAINMR25 + NoahmpIO%BIO2LAI_TABLE = BIO2LAI + NoahmpIO%DILE_FC_TABLE(:,1) = DILE_FC_S1 + NoahmpIO%DILE_FC_TABLE(:,2) = DILE_FC_S2 + NoahmpIO%DILE_FC_TABLE(:,3) = DILE_FC_S3 + NoahmpIO%DILE_FC_TABLE(:,4) = DILE_FC_S4 + NoahmpIO%DILE_FC_TABLE(:,5) = DILE_FC_S5 + NoahmpIO%DILE_FC_TABLE(:,6) = DILE_FC_S6 + NoahmpIO%DILE_FC_TABLE(:,7) = DILE_FC_S7 + NoahmpIO%DILE_FC_TABLE(:,8) = DILE_FC_S8 + NoahmpIO%DILE_FW_TABLE(:,1) = DILE_FW_S1 + NoahmpIO%DILE_FW_TABLE(:,2) = DILE_FW_S2 + NoahmpIO%DILE_FW_TABLE(:,3) = DILE_FW_S3 + NoahmpIO%DILE_FW_TABLE(:,4) = DILE_FW_S4 + NoahmpIO%DILE_FW_TABLE(:,5) = DILE_FW_S5 + NoahmpIO%DILE_FW_TABLE(:,6) = DILE_FW_S6 + NoahmpIO%DILE_FW_TABLE(:,7) = DILE_FW_S7 + NoahmpIO%DILE_FW_TABLE(:,8) = DILE_FW_S8 + NoahmpIO%LF_OVRC_TABLE(:,1) = LF_OVRC_S1 + NoahmpIO%LF_OVRC_TABLE(:,2) = LF_OVRC_S2 + NoahmpIO%LF_OVRC_TABLE(:,3) = LF_OVRC_S3 + NoahmpIO%LF_OVRC_TABLE(:,4) = LF_OVRC_S4 + NoahmpIO%LF_OVRC_TABLE(:,5) = LF_OVRC_S5 + NoahmpIO%LF_OVRC_TABLE(:,6) = LF_OVRC_S6 + NoahmpIO%LF_OVRC_TABLE(:,7) = LF_OVRC_S7 + NoahmpIO%LF_OVRC_TABLE(:,8) = LF_OVRC_S8 + NoahmpIO%ST_OVRC_TABLE(:,1) = ST_OVRC_S1 + NoahmpIO%ST_OVRC_TABLE(:,2) = ST_OVRC_S2 + NoahmpIO%ST_OVRC_TABLE(:,3) = ST_OVRC_S3 + NoahmpIO%ST_OVRC_TABLE(:,4) = ST_OVRC_S4 + NoahmpIO%ST_OVRC_TABLE(:,5) = ST_OVRC_S5 + NoahmpIO%ST_OVRC_TABLE(:,6) = ST_OVRC_S6 + NoahmpIO%ST_OVRC_TABLE(:,7) = ST_OVRC_S7 + NoahmpIO%ST_OVRC_TABLE(:,8) = ST_OVRC_S8 + NoahmpIO%RT_OVRC_TABLE(:,1) = RT_OVRC_S1 + NoahmpIO%RT_OVRC_TABLE(:,2) = RT_OVRC_S2 + NoahmpIO%RT_OVRC_TABLE(:,3) = RT_OVRC_S3 + NoahmpIO%RT_OVRC_TABLE(:,4) = RT_OVRC_S4 + NoahmpIO%RT_OVRC_TABLE(:,5) = RT_OVRC_S5 + NoahmpIO%RT_OVRC_TABLE(:,6) = RT_OVRC_S6 + NoahmpIO%RT_OVRC_TABLE(:,7) = RT_OVRC_S7 + NoahmpIO%RT_OVRC_TABLE(:,8) = RT_OVRC_S8 + NoahmpIO%LFPT_TABLE (:,1) = LFPT_S1 + NoahmpIO%LFPT_TABLE (:,2) = LFPT_S2 + NoahmpIO%LFPT_TABLE (:,3) = LFPT_S3 + NoahmpIO%LFPT_TABLE (:,4) = LFPT_S4 + NoahmpIO%LFPT_TABLE (:,5) = LFPT_S5 + NoahmpIO%LFPT_TABLE (:,6) = LFPT_S6 + NoahmpIO%LFPT_TABLE (:,7) = LFPT_S7 + NoahmpIO%LFPT_TABLE (:,8) = LFPT_S8 + NoahmpIO%STPT_TABLE (:,1) = STPT_S1 + NoahmpIO%STPT_TABLE (:,2) = STPT_S2 + NoahmpIO%STPT_TABLE (:,3) = STPT_S3 + NoahmpIO%STPT_TABLE (:,4) = STPT_S4 + NoahmpIO%STPT_TABLE (:,5) = STPT_S5 + NoahmpIO%STPT_TABLE (:,6) = STPT_S6 + NoahmpIO%STPT_TABLE (:,7) = STPT_S7 + NoahmpIO%STPT_TABLE (:,8) = STPT_S8 + NoahmpIO%RTPT_TABLE (:,1) = RTPT_S1 + NoahmpIO%RTPT_TABLE (:,2) = RTPT_S2 + NoahmpIO%RTPT_TABLE (:,3) = RTPT_S3 + NoahmpIO%RTPT_TABLE (:,4) = RTPT_S4 + NoahmpIO%RTPT_TABLE (:,5) = RTPT_S5 + NoahmpIO%RTPT_TABLE (:,6) = RTPT_S6 + NoahmpIO%RTPT_TABLE (:,7) = RTPT_S7 + NoahmpIO%RTPT_TABLE (:,8) = RTPT_S8 + NoahmpIO%GRAINPT_TABLE(:,1) = GRAINPT_S1 + NoahmpIO%GRAINPT_TABLE(:,2) = GRAINPT_S2 + NoahmpIO%GRAINPT_TABLE(:,3) = GRAINPT_S3 + NoahmpIO%GRAINPT_TABLE(:,4) = GRAINPT_S4 + NoahmpIO%GRAINPT_TABLE(:,5) = GRAINPT_S5 + NoahmpIO%GRAINPT_TABLE(:,6) = GRAINPT_S6 + NoahmpIO%GRAINPT_TABLE(:,7) = GRAINPT_S7 + NoahmpIO%GRAINPT_TABLE(:,8) = GRAINPT_S8 + NoahmpIO%LFCT_TABLE (:,1) = LFCT_S1 + NoahmpIO%LFCT_TABLE (:,2) = LFCT_S2 + NoahmpIO%LFCT_TABLE (:,3) = LFCT_S3 + NoahmpIO%LFCT_TABLE (:,4) = LFCT_S4 + NoahmpIO%LFCT_TABLE (:,5) = LFCT_S5 + NoahmpIO%LFCT_TABLE (:,6) = LFCT_S6 + NoahmpIO%LFCT_TABLE (:,7) = LFCT_S7 + NoahmpIO%LFCT_TABLE (:,8) = LFCT_S8 + NoahmpIO%STCT_TABLE (:,1) = STCT_S1 + NoahmpIO%STCT_TABLE (:,2) = STCT_S2 + NoahmpIO%STCT_TABLE (:,3) = STCT_S3 + NoahmpIO%STCT_TABLE (:,4) = STCT_S4 + NoahmpIO%STCT_TABLE (:,5) = STCT_S5 + NoahmpIO%STCT_TABLE (:,6) = STCT_S6 + NoahmpIO%STCT_TABLE (:,7) = STCT_S7 + NoahmpIO%STCT_TABLE (:,8) = STCT_S8 + NoahmpIO%RTCT_TABLE (:,1) = RTCT_S1 + NoahmpIO%RTCT_TABLE (:,2) = RTCT_S2 + NoahmpIO%RTCT_TABLE (:,3) = RTCT_S3 + NoahmpIO%RTCT_TABLE (:,4) = RTCT_S4 + NoahmpIO%RTCT_TABLE (:,5) = RTCT_S5 + NoahmpIO%RTCT_TABLE (:,6) = RTCT_S6 + NoahmpIO%RTCT_TABLE (:,7) = RTCT_S7 + NoahmpIO%RTCT_TABLE (:,8) = RTCT_S8 + + !---------------- NoahmpTable.TBL tile drainage parameters + inquire( file='NoahmpTable.TBL', exist=file_named ) + if ( file_named ) then + open(15, file="NoahmpTable.TBL", status='old', form='formatted', action='read', iostat=ierr) + else + open(15, status='old', form='formatted', action='read', iostat=ierr) + end if + if (ierr /= 0) then + write(*,'("WARNING: Cannot find file NoahmpTable.TBL")') + endif + read(15,noahmp_tiledrain_parameters) + close(15) + + ! assign values + NoahmpIO%DRAIN_LAYER_OPT_TABLE = DRAIN_LAYER_OPT + NoahmpIO%TDSMC_FAC_TABLE(1:NSOILTYPE) = TDSMC_FAC(1:NSOILTYPE) + NoahmpIO%TD_DEPTH_TABLE (1:NSOILTYPE) = TD_DEPTH (1:NSOILTYPE) + NoahmpIO%TD_DC_TABLE (1:NSOILTYPE) = TD_DC (1:NSOILTYPE) + NoahmpIO%TD_DCOEF_TABLE (1:NSOILTYPE) = TD_DCOEF (1:NSOILTYPE) + NoahmpIO%TD_D_TABLE (1:NSOILTYPE) = TD_D (1:NSOILTYPE) + NoahmpIO%TD_ADEPTH_TABLE(1:NSOILTYPE) = TD_ADEPTH(1:NSOILTYPE) + NoahmpIO%TD_RADI_TABLE (1:NSOILTYPE) = TD_RADI (1:NSOILTYPE) + NoahmpIO%TD_SPAC_TABLE (1:NSOILTYPE) = TD_SPAC (1:NSOILTYPE) + NoahmpIO%TD_DDRAIN_TABLE(1:NSOILTYPE) = TD_DDRAIN(1:NSOILTYPE) + NoahmpIO%KLAT_FAC_TABLE (1:NSOILTYPE) = KLAT_FAC (1:NSOILTYPE) + + !---------------- NoahmpTable.TBL optional parameters + inquire( file='NoahmpTable.TBL', exist=file_named ) + if ( file_named ) then + open(15, file="NoahmpTable.TBL", status='old', form='formatted', action='read', iostat=ierr) + else + open(15, status='old', form='formatted', action='read', iostat=ierr) + end if + if (ierr /= 0) then + write(*,'("WARNING: Cannot find file NoahmpTable.TBL")') + endif + read(15,noahmp_optional_parameters) + close(15) + + ! assign values + NoahmpIO%sr2006_theta_1500t_a_TABLE = sr2006_theta_1500t_a + NoahmpIO%sr2006_theta_1500t_b_TABLE = sr2006_theta_1500t_b + NoahmpIO%sr2006_theta_1500t_c_TABLE = sr2006_theta_1500t_c + NoahmpIO%sr2006_theta_1500t_d_TABLE = sr2006_theta_1500t_d + NoahmpIO%sr2006_theta_1500t_e_TABLE = sr2006_theta_1500t_e + NoahmpIO%sr2006_theta_1500t_f_TABLE = sr2006_theta_1500t_f + NoahmpIO%sr2006_theta_1500t_g_TABLE = sr2006_theta_1500t_g + NoahmpIO%sr2006_theta_1500_a_TABLE = sr2006_theta_1500_a + NoahmpIO%sr2006_theta_1500_b_TABLE = sr2006_theta_1500_b + NoahmpIO%sr2006_theta_33t_a_TABLE = sr2006_theta_33t_a + NoahmpIO%sr2006_theta_33t_b_TABLE = sr2006_theta_33t_b + NoahmpIO%sr2006_theta_33t_c_TABLE = sr2006_theta_33t_c + NoahmpIO%sr2006_theta_33t_d_TABLE = sr2006_theta_33t_d + NoahmpIO%sr2006_theta_33t_e_TABLE = sr2006_theta_33t_e + NoahmpIO%sr2006_theta_33t_f_TABLE = sr2006_theta_33t_f + NoahmpIO%sr2006_theta_33t_g_TABLE = sr2006_theta_33t_g + NoahmpIO%sr2006_theta_33_a_TABLE = sr2006_theta_33_a + NoahmpIO%sr2006_theta_33_b_TABLE = sr2006_theta_33_b + NoahmpIO%sr2006_theta_33_c_TABLE = sr2006_theta_33_c + NoahmpIO%sr2006_theta_s33t_a_TABLE = sr2006_theta_s33t_a + NoahmpIO%sr2006_theta_s33t_b_TABLE = sr2006_theta_s33t_b + NoahmpIO%sr2006_theta_s33t_c_TABLE = sr2006_theta_s33t_c + NoahmpIO%sr2006_theta_s33t_d_TABLE = sr2006_theta_s33t_d + NoahmpIO%sr2006_theta_s33t_e_TABLE = sr2006_theta_s33t_e + NoahmpIO%sr2006_theta_s33t_f_TABLE = sr2006_theta_s33t_f + NoahmpIO%sr2006_theta_s33t_g_TABLE = sr2006_theta_s33t_g + NoahmpIO%sr2006_theta_s33_a_TABLE = sr2006_theta_s33_a + NoahmpIO%sr2006_theta_s33_b_TABLE = sr2006_theta_s33_b + NoahmpIO%sr2006_psi_et_a_TABLE = sr2006_psi_et_a + NoahmpIO%sr2006_psi_et_b_TABLE = sr2006_psi_et_b + NoahmpIO%sr2006_psi_et_c_TABLE = sr2006_psi_et_c + NoahmpIO%sr2006_psi_et_d_TABLE = sr2006_psi_et_d + NoahmpIO%sr2006_psi_et_e_TABLE = sr2006_psi_et_e + NoahmpIO%sr2006_psi_et_f_TABLE = sr2006_psi_et_f + NoahmpIO%sr2006_psi_et_g_TABLE = sr2006_psi_et_g + NoahmpIO%sr2006_psi_e_a_TABLE = sr2006_psi_e_a + NoahmpIO%sr2006_psi_e_b_TABLE = sr2006_psi_e_b + NoahmpIO%sr2006_psi_e_c_TABLE = sr2006_psi_e_c + NoahmpIO%sr2006_smcmax_a_TABLE = sr2006_smcmax_a + NoahmpIO%sr2006_smcmax_b_TABLE = sr2006_smcmax_b + + end subroutine NoahmpReadTable + +end module NoahmpReadTableMod diff --git a/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpSnowInitMod.F90 b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpSnowInitMod.F90 new file mode 100644 index 000000000..56a9aeb96 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/NoahmpSnowInitMod.F90 @@ -0,0 +1,115 @@ + module NoahmpSnowInitMod + +! Module to initialize Noah-MP Snow variables + + use Machine + use NoahmpIOVarType + + implicit none + + contains + + subroutine NoahmpSnowInitMain(NoahmpIO) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: SNOW_INIT +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(NoahmpIO_type), intent(inout) :: NoahmpIO + +!local variables + integer :: i,its,ite,iz + real(kind=kind_noahmp), dimension(-NoahmpIO%nsnow+1: 0) :: dzsno + real(kind=kind_noahmp), dimension(-NoahmpIO%nsnow+1:NoahmpIO%nsoil) :: dzsnso + +!------------------------------------------------------------------------------------------ +! Initialize snow arrays for Noah-MP LSM, based in input SNOWDEP, NSNOW +! ISNOWXY is an index array, indicating the index of the top snow layer. Valid indices +! for snow layers range from 0 (no snow) and -1 (shallow snow) to (-NSNOW)+1 (deep snow). +! TSNOXY holds the temperature of the snow layer. Snow layers are initialized with +! temperature = ground temperature [?]. Snow-free levels in the array have value 0.0 +! SNICEXY is the frozen content of a snow layer. Initial estimate based on SNOWH and SNOW +! SNLIQXY is the liquid content of a snow layer. Initialized to 0.0 +! ZNSNOXY is the layer depth from the surface. +!------------------------------------------------------------------------------------------ + + its = NoahmpIO%its + ite = NoahmpIO%ite + + do i = its, ite + + ! initialize snow layers and thickness + ! no explicit snow layer + if ( NoahmpIO%snowh(i) < 0.025 ) then + NoahmpIO%isnowxy(i) = 0 + dzsno(-NoahmpIO%nsnow+1:0) = 0.0 + else + ! 1 layer snow + if ( (NoahmpIO%snowh(i) >= 0.025) .and. (NoahmpIO%snowh(i) <= 0.05) ) then + NoahmpIO%isnowxy(i) = -1 + dzsno(0) = NoahmpIO%snowh(i) + ! 2 layer snow + elseif ( (NoahmpIO%snowh(i) > 0.05) .and. (NoahmpIO%snowh(i) <= 0.10) ) then + NoahmpIO%isnowxy(i) = -2 + dzsno(-1) = NoahmpIO%snowh(i) / 2.0 + dzsno( 0) = NoahmpIO%snowh(i) / 2.0 + ! 2 layer thick snow + elseif ( (NoahmpIO%snowh(i) > 0.10) .and. (NoahmpIO%snowh(i) <= 0.25) ) then + NoahmpIO%isnowxy(i) = -2 + dzsno(-1) = 0.05 + dzsno( 0) = NoahmpIO%snowh(i) - dzsno(-1) + ! 3 layer snow + elseif ( (NoahmpIO%snowh(i) > 0.25) .and. (NoahmpIO%snowh(i) <= 0.45) ) then + NoahmpIO%isnowxy(i) = -3 + dzsno(-2) = 0.05 + dzsno(-1) = 0.5 * (NoahmpIO%snowh(i)-dzsno(-2)) + dzsno( 0) = 0.5 * (NoahmpIO%snowh(i)-dzsno(-2)) + ! 3 layer thick snow + elseif ( NoahmpIO%snowh(i) > 0.45 ) then + NoahmpIO%isnowxy(i) = -3 + dzsno(-2) = 0.05 + dzsno(-1) = 0.20 + dzsno( 0) = NoahmpIO%snowh(i) - dzsno(-1) - dzsno(-2) + else + print*, "problem with the logic assigning snow layers." + stop + endif + endif + + ! initialize snow temperatuer and ice/liquid content + NoahmpIO%tsnoxy (i,-NoahmpIO%nsnow+1:0) = 0.0 + NoahmpIO%snicexy(i,-NoahmpIO%nsnow+1:0) = 0.0 + NoahmpIO%snliqxy(i,-NoahmpIO%nsnow+1:0) = 0.0 + do iz = NoahmpIO%isnowxy(i)+1, 0 + NoahmpIO%tsnoxy(i,iz) = NoahmpIO%tgxy(i) + NoahmpIO%snliqxy(i,iz) = 0.0 + NoahmpIO%snicexy(i,iz) = 1.0 * dzsno(iz) * (NoahmpIO%snow(i)/NoahmpIO%snowh(i)) + enddo + + ! assign local variable dzsnso, the soil/snow layer thicknesses, for snow layers + do iz = NoahmpIO%isnowxy(i)+1, 0 + dzsnso(iz) = -dzsno(iz) + enddo + + ! assign local variable dzsnso, the soil/snow layer thicknesses, for soil layers + dzsnso(1) = NoahmpIO%zsoil(1) + do iz = 2, NoahmpIO%nsoil + dzsnso(iz) = NoahmpIO%zsoil(iz) - NoahmpIO%zsoil(iz-1) + enddo + + ! assign zsnsoxy, the layer depths, for soil and snow layers + NoahmpIO%zsnsoxy(i,NoahmpIO%isnowxy(i)+1) = dzsnso(NoahmpIO%isnowxy(i)+1) + do iz = NoahmpIO%isnowxy(i)+2, NoahmpIO%nsoil + NoahmpIO%zsnsoxy(i,iz) = NoahmpIO%zsnsoxy(i,iz-1) + dzsnso(iz) + enddo + + enddo + + end subroutine NoahmpSnowInitMain + + end module NoahmpSnowInitMod + diff --git a/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/PedoTransferSR2006Mod.F90 b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/PedoTransferSR2006Mod.F90 new file mode 100644 index 000000000..02090e82a --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/PedoTransferSR2006Mod.F90 @@ -0,0 +1,210 @@ +module PedoTransferSR2006Mod + +!!! Compute soil water infiltration based on different soil composition + + use Machine + use NoahmpIOVarType + use NoahmpVarType + + implicit none + +contains + + subroutine PedoTransferSR2006(NoahmpIO, noahmp, Sand, Clay, Orgm) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: PEDOTRANSFER_SR2006 +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(NoahmpIO_type), intent(inout) :: NoahmpIO + type(noahmp_type) , intent(inout) :: noahmp + + real(kind=kind_noahmp), dimension(1:NoahmpIO%NSOIL), intent(inout) :: Sand + real(kind=kind_noahmp), dimension(1:NoahmpIO%NSOIL), intent(inout) :: Clay + real(kind=kind_noahmp), dimension(1:NoahmpIO%NSOIL), intent(inout) :: Orgm + +! local + integer :: k + real(kind=kind_noahmp), dimension( 1:NoahmpIO%NSOIL ) :: theta_1500t + real(kind=kind_noahmp), dimension( 1:NoahmpIO%NSOIL ) :: theta_1500 + real(kind=kind_noahmp), dimension( 1:NoahmpIO%NSOIL ) :: theta_33t + real(kind=kind_noahmp), dimension( 1:NoahmpIO%NSOIL ) :: theta_33 + real(kind=kind_noahmp), dimension( 1:NoahmpIO%NSOIL ) :: theta_s33t + real(kind=kind_noahmp), dimension( 1:NoahmpIO%NSOIL ) :: theta_s33 + real(kind=kind_noahmp), dimension( 1:NoahmpIO%NSOIL ) :: psi_et + real(kind=kind_noahmp), dimension( 1:NoahmpIO%NSOIL ) :: psi_e + real(kind=kind_noahmp), dimension( 1:NoahmpIO%NSOIL ) :: smcmax + real(kind=kind_noahmp), dimension( 1:NoahmpIO%NSOIL ) :: smcref + real(kind=kind_noahmp), dimension( 1:NoahmpIO%NSOIL ) :: smcwlt + real(kind=kind_noahmp), dimension( 1:NoahmpIO%NSOIL ) :: smcdry + real(kind=kind_noahmp), dimension( 1:NoahmpIO%NSOIL ) :: bexp + real(kind=kind_noahmp), dimension( 1:NoahmpIO%NSOIL ) :: psisat + real(kind=kind_noahmp), dimension( 1:NoahmpIO%NSOIL ) :: dksat + real(kind=kind_noahmp), dimension( 1:NoahmpIO%NSOIL ) :: dwsat + real(kind=kind_noahmp), dimension( 1:NoahmpIO%NSOIL ) :: quartz + +! ------------------------------------------------------------------------------ + associate( & + sr2006_theta_1500t_a => NoahmpIO%sr2006_theta_1500t_a_TABLE ,& + sr2006_theta_1500t_b => NoahmpIO%sr2006_theta_1500t_b_TABLE ,& + sr2006_theta_1500t_c => NoahmpIO%sr2006_theta_1500t_c_TABLE ,& + sr2006_theta_1500t_d => NoahmpIO%sr2006_theta_1500t_d_TABLE ,& + sr2006_theta_1500t_e => NoahmpIO%sr2006_theta_1500t_e_TABLE ,& + sr2006_theta_1500t_f => NoahmpIO%sr2006_theta_1500t_f_TABLE ,& + sr2006_theta_1500t_g => NoahmpIO%sr2006_theta_1500t_g_TABLE ,& + sr2006_theta_1500_a => NoahmpIO%sr2006_theta_1500_a_TABLE ,& + sr2006_theta_1500_b => NoahmpIO%sr2006_theta_1500_b_TABLE ,& + sr2006_theta_33t_a => NoahmpIO%sr2006_theta_33t_a_TABLE ,& + sr2006_theta_33t_b => NoahmpIO%sr2006_theta_33t_b_TABLE ,& + sr2006_theta_33t_c => NoahmpIO%sr2006_theta_33t_c_TABLE ,& + sr2006_theta_33t_d => NoahmpIO%sr2006_theta_33t_d_TABLE ,& + sr2006_theta_33t_e => NoahmpIO%sr2006_theta_33t_e_TABLE ,& + sr2006_theta_33t_f => NoahmpIO%sr2006_theta_33t_f_TABLE ,& + sr2006_theta_33t_g => NoahmpIO%sr2006_theta_33t_g_TABLE ,& + sr2006_theta_33_a => NoahmpIO%sr2006_theta_33_a_TABLE ,& + sr2006_theta_33_b => NoahmpIO%sr2006_theta_33_b_TABLE ,& + sr2006_theta_33_c => NoahmpIO%sr2006_theta_33_c_TABLE ,& + sr2006_theta_s33t_a => NoahmpIO%sr2006_theta_s33t_a_TABLE ,& + sr2006_theta_s33t_b => NoahmpIO%sr2006_theta_s33t_b_TABLE ,& + sr2006_theta_s33t_c => NoahmpIO%sr2006_theta_s33t_c_TABLE ,& + sr2006_theta_s33t_d => NoahmpIO%sr2006_theta_s33t_d_TABLE ,& + sr2006_theta_s33t_e => NoahmpIO%sr2006_theta_s33t_e_TABLE ,& + sr2006_theta_s33t_f => NoahmpIO%sr2006_theta_s33t_f_TABLE ,& + sr2006_theta_s33t_g => NoahmpIO%sr2006_theta_s33t_g_TABLE ,& + sr2006_theta_s33_a => NoahmpIO%sr2006_theta_s33_a_TABLE ,& + sr2006_theta_s33_b => NoahmpIO%sr2006_theta_s33_b_TABLE ,& + sr2006_psi_et_a => NoahmpIO%sr2006_psi_et_a_TABLE ,& + sr2006_psi_et_b => NoahmpIO%sr2006_psi_et_b_TABLE ,& + sr2006_psi_et_c => NoahmpIO%sr2006_psi_et_c_TABLE ,& + sr2006_psi_et_d => NoahmpIO%sr2006_psi_et_d_TABLE ,& + sr2006_psi_et_e => NoahmpIO%sr2006_psi_et_e_TABLE ,& + sr2006_psi_et_f => NoahmpIO%sr2006_psi_et_f_TABLE ,& + sr2006_psi_et_g => NoahmpIO%sr2006_psi_et_g_TABLE ,& + sr2006_psi_e_a => NoahmpIO%sr2006_psi_e_a_TABLE ,& + sr2006_psi_e_b => NoahmpIO%sr2006_psi_e_b_TABLE ,& + sr2006_psi_e_c => NoahmpIO%sr2006_psi_e_c_TABLE ,& + sr2006_smcmax_a => NoahmpIO%sr2006_smcmax_a_TABLE ,& + sr2006_smcmax_b => NoahmpIO%sr2006_smcmax_b_TABLE & + ) +! ------------------------------------------------------------------------------- + + ! initialize + smcmax = 0.0 + smcref = 0.0 + smcwlt = 0.0 + smcdry = 0.0 + bexp = 0.0 + psisat = 0.0 + dksat = 0.0 + dwsat = 0.0 + quartz = 0.0 + + do k = 1,4 + if(Sand(k) <= 0 .or. Clay(k) <= 0) then + Sand(k) = 0.41 + Clay(k) = 0.18 + end if + if(Orgm(k) <= 0 ) Orgm(k) = 0.0 + end do + + ! compute soil properties + theta_1500t = sr2006_theta_1500t_a*Sand & + + sr2006_theta_1500t_b*Clay & + + sr2006_theta_1500t_c*Orgm & + + sr2006_theta_1500t_d*Sand*Orgm & + + sr2006_theta_1500t_e*Clay*Orgm & + + sr2006_theta_1500t_f*Sand*Clay & + + sr2006_theta_1500t_g + + theta_1500 = theta_1500t & + + sr2006_theta_1500_a*theta_1500t & + + sr2006_theta_1500_b + + theta_33t = sr2006_theta_33t_a*Sand & + + sr2006_theta_33t_b*Clay & + + sr2006_theta_33t_c*Orgm & + + sr2006_theta_33t_d*Sand*Orgm & + + sr2006_theta_33t_e*Clay*Orgm & + + sr2006_theta_33t_f*Sand*Clay & + + sr2006_theta_33t_g + + theta_33 = theta_33t & + + sr2006_theta_33_a*theta_33t*theta_33t & + + sr2006_theta_33_b*theta_33t & + + sr2006_theta_33_c + + theta_s33t = sr2006_theta_s33t_a*Sand & + + sr2006_theta_s33t_b*Clay & + + sr2006_theta_s33t_c*Orgm & + + sr2006_theta_s33t_d*Sand*Orgm & + + sr2006_theta_s33t_e*Clay*Orgm & + + sr2006_theta_s33t_f*Sand*Clay & + + sr2006_theta_s33t_g + + theta_s33 = theta_s33t & + + sr2006_theta_s33_a*theta_s33t & + + sr2006_theta_s33_b + + psi_et = sr2006_psi_et_a*Sand & + + sr2006_psi_et_b*Clay & + + sr2006_psi_et_c*theta_s33 & + + sr2006_psi_et_d*Sand*theta_s33 & + + sr2006_psi_et_e*Clay*theta_s33 & + + sr2006_psi_et_f*Sand*Clay & + + sr2006_psi_et_g + + psi_e = psi_et & + + sr2006_psi_e_a*psi_et*psi_et & + + sr2006_psi_e_b*psi_et & + + sr2006_psi_e_c + + ! assign property values + smcwlt = theta_1500 + smcref = theta_33 + smcmax = theta_33 & + + theta_s33 & + + sr2006_smcmax_a*Sand & + + sr2006_smcmax_b + + bexp = 3.816712826 / (log(theta_33) - log(theta_1500) ) + psisat = psi_e + dksat = 1930.0 * (smcmax - theta_33) ** (3.0 - 1.0/bexp) + quartz = Sand + + ! Units conversion + psisat = max(0.1, psisat) ! arbitrarily impose a limit of 0.1kpa + psisat = 0.101997 * psisat ! convert kpa to m + dksat = dksat / 3600000.0 ! convert mm/h to m/s + dwsat = dksat * psisat * bexp / smcmax ! units should be m*m/s + smcdry = smcwlt + + ! Introducing somewhat arbitrary limits (based on NoahmpTable soil) to prevent bad things + smcmax = max(0.32 ,min(smcmax, 0.50 )) + smcref = max(0.17 ,min(smcref, smcmax)) + smcwlt = max(0.01 ,min(smcwlt, smcref)) + smcdry = max(0.01 ,min(smcdry, smcref)) + bexp = max(2.50 ,min(bexp, 12.0 )) + psisat = max(0.03 ,min(psisat, 1.00 )) + dksat = max(5.e-7,min(dksat, 1.e-5)) + dwsat = max(1.e-6,min(dwsat, 3.e-5)) + quartz = max(0.05 ,min(quartz, 0.95 )) + + noahmp%water%param%SoilMoistureWilt = smcwlt + noahmp%water%param%SoilMoistureFieldCap = smcref + noahmp%water%param%SoilMoistureSat = smcmax + noahmp%water%param%SoilMoistureDry = smcdry + noahmp%water%param%SoilExpCoeffB = bexp + noahmp%water%param%SoilMatPotentialSat = psisat + noahmp%water%param%SoilWatConductivitySat = dksat + noahmp%water%param%SoilWatDiffusivitySat = dwsat + noahmp%energy%param%SoilQuartzFrac = quartz + + end associate + + end subroutine PedoTransferSR2006 + +end module PedoTransferSR2006Mod diff --git a/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/WaterVarInTransferMod.F90 b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/WaterVarInTransferMod.F90 new file mode 100644 index 000000000..add4dcec5 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/WaterVarInTransferMod.F90 @@ -0,0 +1,241 @@ +module WaterVarInTransferMod + +!!! Transfer input 2-D NoahmpIO Water variables to 1-D column variable +!!! 1-D variables should be first defined in /src/WaterVarType.F90 +!!! 2-D variables should be first defined in NoahmpIOVarType.F90 + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use Machine + use NoahmpIOVarType + use NoahmpVarType + use PedoTransferSR2006Mod + + implicit none + +contains + +!=== initialize with input data or table values + + subroutine WaterVarInTransfer(noahmp, NoahmpIO) + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + type(NoahmpIO_type), intent(inout) :: NoahmpIO + + ! local variables + integer :: IndexSoilLayer + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilSand + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilClay + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilOrg + +! ------------------------------------------------------------------------- + associate( & + I => noahmp%config%domain%GridIndexI ,& + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& + VegType => noahmp%config%domain%VegType ,& + SoilType => noahmp%config%domain%SoilType ,& + FlagUrban => noahmp%config%domain%FlagUrban ,& + RunoffSlopeType => noahmp%config%domain%RunoffSlopeType ,& + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg & + ) +! ------------------------------------------------------------------------- + + ! water state variables + noahmp%water%state%CanopyLiqWater = NoahmpIO%CANLIQXY (I) + noahmp%water%state%CanopyIce = NoahmpIO%CANICEXY (I) + noahmp%water%state%CanopyWetFrac = NoahmpIO%FWETXY (I) + noahmp%water%state%SnowWaterEquiv = NoahmpIO%SNOW (I) + noahmp%water%state%SnowWaterEquivPrev = NoahmpIO%SNEQVOXY (I) + noahmp%water%state%SnowDepth = NoahmpIO%SNOWH (I) + noahmp%water%state%IrrigationFracFlood = NoahmpIO%FIFRACT (I) + noahmp%water%state%IrrigationAmtFlood = NoahmpIO%IRWATFI (I) + noahmp%water%state%IrrigationFracMicro = NoahmpIO%MIFRACT (I) + noahmp%water%state%IrrigationAmtMicro = NoahmpIO%IRWATMI (I) + noahmp%water%state%IrrigationFracSprinkler = NoahmpIO%SIFRACT (I) + noahmp%water%state%IrrigationAmtSprinkler = NoahmpIO%IRWATSI (I) + noahmp%water%state%WaterTableDepth = NoahmpIO%ZWTXY (I) + noahmp%water%state%SoilMoistureToWT = NoahmpIO%SMCWTDXY (I) + noahmp%water%state%TileDrainFrac = NoahmpIO%TD_FRACTION(I) + noahmp%water%state%WaterStorageAquifer = NoahmpIO%WAXY (I) + noahmp%water%state%WaterStorageSoilAqf = NoahmpIO%WTXY (I) + noahmp%water%state%WaterStorageLake = NoahmpIO%WSLAKEXY (I) + noahmp%water%state%IrrigationFracGrid = NoahmpIO%IRFRACT (I) + noahmp%water%state%IrrigationCntSprinkler = NoahmpIO%IRNUMSI (I) + noahmp%water%state%IrrigationCntMicro = NoahmpIO%IRNUMMI (I) + noahmp%water%state%IrrigationCntFlood = NoahmpIO%IRNUMFI (I) + noahmp%water%state%SnowIce (-NumSnowLayerMax+1:0) = NoahmpIO%SNICEXY (I,-NumSnowLayerMax+1:0) + noahmp%water%state%SnowLiqWater(-NumSnowLayerMax+1:0) = NoahmpIO%SNLIQXY (I,-NumSnowLayerMax+1:0) + noahmp%water%state%SoilLiqWater (1:NumSoilLayer) = NoahmpIO%SH2O (I,1:NumSoilLayer) + noahmp%water%state%SoilMoisture (1:NumSoilLayer) = NoahmpIO%SMOIS (I,1:NumSoilLayer) + noahmp%water%state%SoilMoistureEqui (1:NumSoilLayer) = NoahmpIO%SMOISEQ (I,1:NumSoilLayer) + noahmp%water%state%RechargeGwDeepWT = 0.0 + noahmp%water%state%RechargeGwShallowWT = 0.0 +#ifdef WRF_HYDRO + noahmp%water%state%WaterTableHydro = NoahmpIO%ZWATBLE2D (I) + noahmp%water%state%WaterHeadSfc = NoahmpIO%sfcheadrt (I) +#endif + + ! water flux variables + noahmp%water%flux%EvapSoilSfcLiqAcc = NoahmpIO%ACC_QSEVAXY (I) + noahmp%water%flux%SoilSfcInflowAcc = NoahmpIO%ACC_QINSURXY(I) + noahmp%water%flux%SfcWaterTotChgAcc = NoahmpIO%ACC_DWATERXY(I) + noahmp%water%flux%PrecipTotAcc = NoahmpIO%ACC_PRCPXY (I) + noahmp%water%flux%EvapCanopyNetAcc = NoahmpIO%ACC_ECANXY (I) + noahmp%water%flux%TranspirationAcc = NoahmpIO%ACC_ETRANXY (I) + noahmp%water%flux%EvapGroundNetAcc = NoahmpIO%ACC_EDIRXY (I) + noahmp%water%flux%TranspWatLossSoilAcc(1:NumSoilLayer)= NoahmpIO%ACC_ETRANIXY(I,1:NumSoilLayer) + + ! water parameter variables + noahmp%water%param%DrainSoilLayerInd = NoahmpIO%DRAIN_LAYER_OPT_TABLE + noahmp%water%param%CanopyLiqHoldCap = NoahmpIO%CH2OP_TABLE(VegType) + noahmp%water%param%SnowCompactBurdenFac = NoahmpIO%C2_SNOWCOMPACT_TABLE + noahmp%water%param%SnowCompactAgingFac1 = NoahmpIO%C3_SNOWCOMPACT_TABLE + noahmp%water%param%SnowCompactAgingFac2 = NoahmpIO%C4_SNOWCOMPACT_TABLE + noahmp%water%param%SnowCompactAgingFac3 = NoahmpIO%C5_SNOWCOMPACT_TABLE + noahmp%water%param%SnowCompactAgingMax = NoahmpIO%DM_SNOWCOMPACT_TABLE + noahmp%water%param%SnowViscosityCoeff = NoahmpIO%ETA0_SNOWCOMPACT_TABLE + noahmp%water%param%SnowLiqFracMax = NoahmpIO%SNLIQMAXFRAC_TABLE + noahmp%water%param%SnowLiqHoldCap = NoahmpIO%SSI_TABLE + noahmp%water%param%SnowLiqReleaseFac = NoahmpIO%SNOW_RET_FAC_TABLE + noahmp%water%param%IrriFloodRateFac = NoahmpIO%FIRTFAC_TABLE + noahmp%water%param%IrriMicroRate = NoahmpIO%MICIR_RATE_TABLE + noahmp%water%param%SoilConductivityRef = NoahmpIO%REFDK_TABLE + noahmp%water%param%SoilInfilFacRef = NoahmpIO%REFKDT_TABLE + noahmp%water%param%GroundFrzCoeff = NoahmpIO%FRZK_TABLE + noahmp%water%param%GridTopoIndex = NoahmpIO%TIMEAN_TABLE + noahmp%water%param%SoilSfcSatFracMax = NoahmpIO%FSATMX_TABLE + noahmp%water%param%SpecYieldGw = NoahmpIO%ROUS_TABLE + noahmp%water%param%MicroPoreContent = NoahmpIO%CMIC_TABLE + noahmp%water%param%WaterStorageLakeMax = NoahmpIO%WSLMAX_TABLE + noahmp%water%param%SnoWatEqvMaxGlacier = NoahmpIO%SWEMAXGLA_TABLE + noahmp%water%param%IrriStopDayBfHarvest = NoahmpIO%IRR_HAR_TABLE + noahmp%water%param%IrriTriggerLaiMin = NoahmpIO%IRR_LAI_TABLE + noahmp%water%param%SoilWatDeficitAllow = NoahmpIO%IRR_MAD_TABLE + noahmp%water%param%IrriFloodLossFrac = NoahmpIO%FILOSS_TABLE + noahmp%water%param%IrriSprinklerRate = NoahmpIO%SPRIR_RATE_TABLE + noahmp%water%param%IrriFracThreshold = NoahmpIO%IRR_FRAC_TABLE + noahmp%water%param%IrriStopPrecipThr = NoahmpIO%IR_RAIN_TABLE + noahmp%water%param%SnowfallDensityMax = NoahmpIO%SNOWDEN_MAX_TABLE + noahmp%water%param%SnowMassFullCoverOld = NoahmpIO%SWEMX_TABLE + noahmp%water%param%SoilMatPotentialWilt = NoahmpIO%PSIWLT_TABLE + noahmp%water%param%SnowMeltFac = NoahmpIO%MFSNO_TABLE(VegType) + noahmp%water%param%SnowCoverFac = NoahmpIO%SCFFAC_TABLE(VegType) + noahmp%water%param%InfilFacVic = NoahmpIO%BVIC_TABLE(SoilType(1)) + noahmp%water%param%TensionWatDistrInfl = NoahmpIO%AXAJ_TABLE(SoilType(1)) + noahmp%water%param%TensionWatDistrShp = NoahmpIO%BXAJ_TABLE(SoilType(1)) + noahmp%water%param%FreeWatDistrShp = NoahmpIO%XXAJ_TABLE(SoilType(1)) + noahmp%water%param%InfilHeteroDynVic = NoahmpIO%BBVIC_TABLE(SoilType(1)) + noahmp%water%param%InfilCapillaryDynVic = NoahmpIO%GDVIC_TABLE(SoilType(1)) + noahmp%water%param%InfilFacDynVic = NoahmpIO%BDVIC_TABLE(SoilType(1)) + noahmp%water%param%TileDrainCoeffSp = NoahmpIO%TD_DC_TABLE(SoilType(1)) + noahmp%water%param%TileDrainTubeDepth = NoahmpIO%TD_DEPTH_TABLE(SoilType(1)) + noahmp%water%param%DrainFacSoilWat = NoahmpIO%TDSMC_FAC_TABLE(SoilType(1)) + noahmp%water%param%TileDrainCoeff = NoahmpIO%TD_DCOEF_TABLE(SoilType(1)) + noahmp%water%param%DrainDepthToImperv = NoahmpIO%TD_ADEPTH_TABLE(SoilType(1)) + noahmp%water%param%LateralWatCondFac = NoahmpIO%KLAT_FAC_TABLE(SoilType(1)) + noahmp%water%param%TileDrainDepth = NoahmpIO%TD_DDRAIN_TABLE(SoilType(1)) + noahmp%water%param%DrainTubeDist = NoahmpIO%TD_SPAC_TABLE(SoilType(1)) + noahmp%water%param%DrainTubeRadius = NoahmpIO%TD_RADI_TABLE(SoilType(1)) + noahmp%water%param%DrainWatDepToImperv = NoahmpIO%TD_D_TABLE(SoilType(1)) + noahmp%water%param%NumSoilLayerRoot = NoahmpIO%NROOT_TABLE(VegType) + noahmp%water%param%SoilDrainSlope = NoahmpIO%SLOPE_TABLE(RunoffSlopeType) + + do IndexSoilLayer = 1, size(SoilType) + noahmp%water%param%SoilMoistureSat (IndexSoilLayer) = NoahmpIO%SMCMAX_TABLE(SoilType(IndexSoilLayer)) + noahmp%water%param%SoilMoistureWilt (IndexSoilLayer) = NoahmpIO%SMCWLT_TABLE(SoilType(IndexSoilLayer)) + noahmp%water%param%SoilMoistureFieldCap (IndexSoilLayer) = NoahmpIO%SMCREF_TABLE(SoilType(IndexSoilLayer)) + noahmp%water%param%SoilMoistureDry (IndexSoilLayer) = NoahmpIO%SMCDRY_TABLE(SoilType(IndexSoilLayer)) + noahmp%water%param%SoilWatDiffusivitySat (IndexSoilLayer) = NoahmpIO%DWSAT_TABLE (SoilType(IndexSoilLayer)) + noahmp%water%param%SoilWatConductivitySat(IndexSoilLayer) = NoahmpIO%DKSAT_TABLE (SoilType(IndexSoilLayer)) + noahmp%water%param%SoilExpCoeffB (IndexSoilLayer) = NoahmpIO%BEXP_TABLE (SoilType(IndexSoilLayer)) + noahmp%water%param%SoilMatPotentialSat (IndexSoilLayer) = NoahmpIO%PSISAT_TABLE(SoilType(IndexSoilLayer)) + enddo + + ! spatial varying soil texture and properties directly from input + if ( noahmp%config%nmlist%OptSoilProperty == 4 ) then + ! 3D soil properties + noahmp%water%param%SoilExpCoeffB = NoahmpIO%BEXP_3D (I,1:NumSoilLayer) ! C-H B exponent + noahmp%water%param%SoilMoistureDry = NoahmpIO%SMCDRY_3D(I,1:NumSoilLayer) ! Soil Moisture Limit: Dry + noahmp%water%param%SoilMoistureWilt = NoahmpIO%SMCWLT_3D(I,1:NumSoilLayer) ! Soil Moisture Limit: Wilt + noahmp%water%param%SoilMoistureFieldCap = NoahmpIO%SMCREF_3D(I,1:NumSoilLayer) ! Soil Moisture Limit: Reference + noahmp%water%param%SoilMoistureSat = NoahmpIO%SMCMAX_3D(I,1:NumSoilLayer) ! Soil Moisture Limit: Max + noahmp%water%param%SoilWatConductivitySat = NoahmpIO%DKSAT_3D (I,1:NumSoilLayer) ! Saturated Soil Conductivity + noahmp%water%param%SoilWatDiffusivitySat = NoahmpIO%DWSAT_3D (I,1:NumSoilLayer) ! Saturated Soil Diffusivity + noahmp%water%param%SoilMatPotentialSat = NoahmpIO%PSISAT_3D(I,1:NumSoilLayer) ! Saturated Matric Potential + noahmp%water%param%SoilConductivityRef = NoahmpIO%REFDK_2D (I) ! Reference Soil Conductivity + noahmp%water%param%SoilInfilFacRef = NoahmpIO%REFKDT_2D(I) ! Soil Infiltration Parameter + ! 2D additional runoff6~8 parameters + noahmp%water%param%InfilFacVic = NoahmpIO%BVIC_2D (I) ! VIC model infiltration parameter + noahmp%water%param%TensionWatDistrInfl = NoahmpIO%AXAJ_2D (I) ! Xinanjiang: Tension water distribution inflection parameter + noahmp%water%param%TensionWatDistrShp = NoahmpIO%BXAJ_2D (I) ! Xinanjiang: Tension water distribution shape parameter + noahmp%water%param%FreeWatDistrShp = NoahmpIO%XXAJ_2D (I) ! Xinanjiang: Free water distribution shape parameter + noahmp%water%param%InfilFacDynVic = NoahmpIO%BDVIC_2D(I) ! VIC model infiltration parameter + noahmp%water%param%InfilCapillaryDynVic = NoahmpIO%GDVIC_2D(I) ! Mean Capillary Drive for infiltration models + noahmp%water%param%InfilHeteroDynVic = NoahmpIO%BBVIC_2D(I) ! DVIC heterogeniety parameter for infiltraton + ! 2D irrigation params + noahmp%water%param%IrriFracThreshold = NoahmpIO%IRR_FRAC_2D (I) ! irrigation Fraction + noahmp%water%param%IrriStopDayBfHarvest = NoahmpIO%IRR_HAR_2D (I) ! number of days before harvest date to stop irrigation + noahmp%water%param%IrriTriggerLaiMin = NoahmpIO%IRR_LAI_2D (I) ! Minimum lai to trigger irrigation + noahmp%water%param%SoilWatDeficitAllow = NoahmpIO%IRR_MAD_2D (I) ! management allowable deficit (0-1) + noahmp%water%param%IrriFloodLossFrac = NoahmpIO%FILOSS_2D (I) ! fraction of flood irrigation loss (0-1) + noahmp%water%param%IrriSprinklerRate = NoahmpIO%SPRIR_RATE_2D(I) ! mm/h, sprinkler irrigation rate + noahmp%water%param%IrriMicroRate = NoahmpIO%MICIR_RATE_2D(I) ! mm/h, micro irrigation rate + noahmp%water%param%IrriFloodRateFac = NoahmpIO%FIRTFAC_2D (I) ! flood application rate factor + noahmp%water%param%IrriStopPrecipThr = NoahmpIO%IR_RAIN_2D (I) ! maximum precipitation to stop irrigation trigger + ! 2D tile drainage parameters + noahmp%water%param%LateralWatCondFac = NoahmpIO%KLAT_FAC (I) ! factor multiplier to hydraulic conductivity + noahmp%water%param%DrainFacSoilWat = NoahmpIO%TDSMC_FAC(I) ! factor multiplier to field capacity + noahmp%water%param%TileDrainCoeffSp = NoahmpIO%TD_DC (I) ! drainage coefficient for simple + noahmp%water%param%TileDrainCoeff = NoahmpIO%TD_DCOEF (I) ! drainge coefficient for Hooghoudt + noahmp%water%param%TileDrainDepth = NoahmpIO%TD_DDRAIN(I) ! depth of drain + noahmp%water%param%DrainTubeRadius = NoahmpIO%TD_RADI (I) ! tile tube radius + noahmp%water%param%DrainTubeDist = NoahmpIO%TD_SPAC (I) ! tile spacing + endif + + ! derived water parameters + noahmp%water%param%SoilInfilMaxCoeff = noahmp%water%param%SoilInfilFacRef * & + noahmp%water%param%SoilWatConductivitySat(1) / & + noahmp%water%param%SoilConductivityRef + if ( FlagUrban .eqv. .true. ) then + noahmp%water%param%SoilMoistureSat = 0.45 + noahmp%water%param%SoilMoistureFieldCap = 0.42 + noahmp%water%param%SoilMoistureWilt = 0.40 + noahmp%water%param%SoilMoistureDry = 0.40 + endif + + if ( SoilType(1) /= 14 ) then + noahmp%water%param%SoilImpervFracCoeff = noahmp%water%param%GroundFrzCoeff * & + ((noahmp%water%param%SoilMoistureSat(1) / & + noahmp%water%param%SoilMoistureFieldCap(1)) * (0.412/0.468)) + endif + + noahmp%water%state%SnowIceFracPrev = 0.0 + noahmp%water%state%SnowIceFracPrev(NumSnowLayerNeg+1:0) = NoahmpIO%SNICEXY(I,NumSnowLayerNeg+1:0) / & + (NoahmpIO%SNICEXY(I,NumSnowLayerNeg+1:0) + & + NoahmpIO%SNLIQXY(I,NumSnowLayerNeg+1:0)) + + if ( (noahmp%config%nmlist%OptSoilProperty == 3) .and. (.not. noahmp%config%domain%FlagUrban) ) then + if (.not. allocated(SoilSand)) allocate( SoilSand(1:NumSoilLayer) ) + if (.not. allocated(SoilClay)) allocate( SoilClay(1:NumSoilLayer) ) + if (.not. allocated(SoilOrg) ) allocate( SoilOrg (1:NumSoilLayer) ) + SoilSand = 0.01 * NoahmpIO%soilcomp(I,1:NumSoilLayer) + SoilClay = 0.01 * NoahmpIO%soilcomp(I,(NumSoilLayer+1):(NumSoilLayer*2)) + SoilOrg = 0.0 + if (noahmp%config%nmlist%OptPedotransfer == 1) & + call PedoTransferSR2006(NoahmpIO,noahmp,SoilSand,SoilClay,SoilOrg) + deallocate(SoilSand) + deallocate(SoilClay) + deallocate(SoilOrg ) + endif + + end associate + + end subroutine WaterVarInTransfer + +end module WaterVarInTransferMod diff --git a/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/WaterVarOutTransferMod.F90 b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/WaterVarOutTransferMod.F90 new file mode 100644 index 000000000..feaa7e996 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/drivers/mpas/WaterVarOutTransferMod.F90 @@ -0,0 +1,153 @@ +module WaterVarOutTransferMod + +!!! Transfer column (1-D) Noah-MP water variables to 2D NoahmpIO for output + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use Machine + use NoahmpIOVarType + use NoahmpVarType + + implicit none + +contains + +!=== Transfer model states to output ===== + + subroutine WaterVarOutTransfer(noahmp, NoahmpIO) + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + type(NoahmpIO_type), intent(inout) :: NoahmpIO + +! ------------------------------------------------------------------------- + associate( & + I => noahmp%config%domain%GridIndexI ,& + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& + IndicatorIceSfc => noahmp%config%domain%IndicatorIceSfc & + ) +! ------------------------------------------------------------------------- + + ! special treatment for glacier point output + if ( IndicatorIceSfc == -1 ) then ! land ice point + noahmp%water%state%SnowCoverFrac = 1.0 + noahmp%water%flux%EvapCanopyNet = 0.0 + noahmp%water%flux%Transpiration = 0.0 + noahmp%water%flux%InterceptCanopySnow = 0.0 + noahmp%water%flux%InterceptCanopyRain = 0.0 + noahmp%water%flux%DripCanopySnow = 0.0 + noahmp%water%flux%DripCanopyRain = 0.0 + noahmp%water%flux%ThroughfallSnow = noahmp%water%flux%SnowfallRefHeight + noahmp%water%flux%ThroughfallRain = noahmp%water%flux%RainfallRefHeight + noahmp%water%flux%SublimCanopyIce = 0.0 + noahmp%water%flux%FrostCanopyIce = 0.0 + noahmp%water%flux%FreezeCanopyLiq = 0.0 + noahmp%water%flux%MeltCanopyIce = 0.0 + noahmp%water%flux%EvapCanopyLiq = 0.0 + noahmp%water%flux%DewCanopyLiq = 0.0 + noahmp%water%state%CanopyIce = 0.0 + noahmp%water%state%CanopyLiqWater = 0.0 + noahmp%water%flux%TileDrain = 0.0 + noahmp%water%flux%RunoffSurface = noahmp%water%flux%RunoffSurface * noahmp%config%domain%MainTimeStep + noahmp%water%flux%RunoffSubsurface = noahmp%water%flux%RunoffSubsurface * noahmp%config%domain%MainTimeStep + NoahmpIO%QFX(I) = noahmp%water%flux%EvapGroundNet + endif + + if ( IndicatorIceSfc == 0 ) then ! land soil point + NoahmpIO%QFX(I) = noahmp%water%flux%EvapCanopyNet + noahmp%water%flux%EvapGroundNet + & + noahmp%water%flux%Transpiration + noahmp%water%flux%EvapIrriSprinkler + endif + + NoahmpIO%SMSTAV (I) = 0.0 ! [maintained as Noah consistency] water + NoahmpIO%SMSTOT (I) = 0.0 ! [maintained as Noah consistency] water + NoahmpIO%SFCRUNOFF (I) = NoahmpIO%SFCRUNOFF(I) + noahmp%water%flux%RunoffSurface + NoahmpIO%UDRUNOFF (I) = NoahmpIO%UDRUNOFF (I) + noahmp%water%flux%RunoffSubsurface + NoahmpIO%QTDRAIN (I) = NoahmpIO%QTDRAIN (I) + noahmp%water%flux%TileDrain + NoahmpIO%SNOWC (I) = noahmp%water%state%SnowCoverFrac + NoahmpIO%SNOW (I) = noahmp%water%state%SnowWaterEquiv + NoahmpIO%SNOWH (I) = noahmp%water%state%SnowDepth + NoahmpIO%CANWAT (I) = noahmp%water%state%CanopyLiqWater + noahmp%water%state%CanopyIce + NoahmpIO%ACSNOW (I) = NoahmpIO%ACSNOW(I) + (NoahmpIO%RAINBL (I) * noahmp%water%state%FrozenPrecipFrac) + NoahmpIO%ACSNOM (I) = NoahmpIO%ACSNOM(I) + (noahmp%water%flux%MeltGroundSnow * NoahmpIO%DTBL) + & + noahmp%water%state%PondSfcThinSnwMelt + noahmp%water%state%PondSfcThinSnwComb + & + noahmp%water%state%PondSfcThinSnwTrans + NoahmpIO%CANLIQXY (I) = noahmp%water%state%CanopyLiqWater + NoahmpIO%CANICEXY (I) = noahmp%water%state%CanopyIce + NoahmpIO%FWETXY (I) = noahmp%water%state%CanopyWetFrac + NoahmpIO%SNEQVOXY (I) = noahmp%water%state%SnowWaterEquivPrev + NoahmpIO%QSNOWXY (I) = noahmp%water%flux%SnowfallGround + NoahmpIO%QRAINXY (I) = noahmp%water%flux%RainfallGround + NoahmpIO%WSLAKEXY (I) = noahmp%water%state%WaterStorageLake + NoahmpIO%ZWTXY (I) = noahmp%water%state%WaterTableDepth + NoahmpIO%WAXY (I) = noahmp%water%state%WaterStorageAquifer + NoahmpIO%WTXY (I) = noahmp%water%state%WaterStorageSoilAqf + NoahmpIO%RUNSFXY (I) = noahmp%water%flux%RunoffSurface + NoahmpIO%RUNSBXY (I) = noahmp%water%flux%RunoffSubsurface + NoahmpIO%ECANXY (I) = noahmp%water%flux%EvapCanopyNet + NoahmpIO%EDIRXY (I) = noahmp%water%flux%EvapGroundNet + NoahmpIO%ETRANXY (I) = noahmp%water%flux%Transpiration + NoahmpIO%QINTSXY (I) = noahmp%water%flux%InterceptCanopySnow + NoahmpIO%QINTRXY (I) = noahmp%water%flux%InterceptCanopyRain + NoahmpIO%QDRIPSXY (I) = noahmp%water%flux%DripCanopySnow + NoahmpIO%QDRIPRXY (I) = noahmp%water%flux%DripCanopyRain + NoahmpIO%QTHROSXY (I) = noahmp%water%flux%ThroughfallSnow + NoahmpIO%QTHRORXY (I) = noahmp%water%flux%ThroughfallRain + NoahmpIO%QSNSUBXY (I) = noahmp%water%flux%SublimSnowSfcIce + NoahmpIO%QSNFROXY (I) = noahmp%water%flux%FrostSnowSfcIce + NoahmpIO%QSUBCXY (I) = noahmp%water%flux%SublimCanopyIce + NoahmpIO%QFROCXY (I) = noahmp%water%flux%FrostCanopyIce + NoahmpIO%QEVACXY (I) = noahmp%water%flux%EvapCanopyLiq + NoahmpIO%QDEWCXY (I) = noahmp%water%flux%DewCanopyLiq + NoahmpIO%QFRZCXY (I) = noahmp%water%flux%FreezeCanopyLiq + NoahmpIO%QMELTCXY (I) = noahmp%water%flux%MeltCanopyIce + NoahmpIO%QSNBOTXY (I) = noahmp%water%flux%SnowBotOutflow + NoahmpIO%QMELTXY (I) = noahmp%water%flux%MeltGroundSnow + NoahmpIO%PONDINGXY (I) = noahmp%water%state%PondSfcThinSnwTrans + & + noahmp%water%state%PondSfcThinSnwComb + noahmp%water%state%PondSfcThinSnwMelt + NoahmpIO%FPICEXY (I) = noahmp%water%state%FrozenPrecipFrac + NoahmpIO%RAINLSM (I) = noahmp%water%flux%RainfallRefHeight + NoahmpIO%SNOWLSM (I) = noahmp%water%flux%SnowfallRefHeight + NoahmpIO%ACC_QINSURXY(I) = noahmp%water%flux%SoilSfcInflowAcc + NoahmpIO%ACC_QSEVAXY (I) = noahmp%water%flux%EvapSoilSfcLiqAcc + NoahmpIO%ACC_DWATERXY(I) = noahmp%water%flux%SfcWaterTotChgAcc + NoahmpIO%ACC_PRCPXY (I) = noahmp%water%flux%PrecipTotAcc + NoahmpIO%ACC_ECANXY (I) = noahmp%water%flux%EvapCanopyNetAcc + NoahmpIO%ACC_ETRANXY (I) = noahmp%water%flux%TranspirationAcc + NoahmpIO%ACC_EDIRXY (I) = noahmp%water%flux%EvapGroundNetAcc + NoahmpIO%RECHXY (I) = NoahmpIO%RECHXY(I) + (noahmp%water%state%RechargeGwShallowWT*1.0e3) + NoahmpIO%DEEPRECHXY (I) = NoahmpIO%DEEPRECHXY(I) + noahmp%water%state%RechargeGwDeepWT + NoahmpIO%SMCWTDXY (I) = noahmp%water%state%SoilMoistureToWT + NoahmpIO%SMOIS (I,1:NumSoilLayer) = noahmp%water%state%SoilMoisture(1:NumSoilLayer) + NoahmpIO%SH2O (I,1:NumSoilLayer) = noahmp%water%state%SoilLiqWater(1:NumSoilLayer) + NoahmpIO%ACC_ETRANIXY(I,1:NumSoilLayer) = noahmp%water%flux%TranspWatLossSoilAcc(1:NumSoilLayer) + NoahmpIO%SNICEXY (I,-NumSnowLayerMax+1:0) = noahmp%water%state%SnowIce(-NumSnowLayerMax+1:0) + NoahmpIO%SNLIQXY (I,-NumSnowLayerMax+1:0) = noahmp%water%state%SnowLiqWater(-NumSnowLayerMax+1:0) + + ! irrigation + NoahmpIO%IRNUMSI (I) = noahmp%water%state%IrrigationCntSprinkler + NoahmpIO%IRNUMMI (I) = noahmp%water%state%IrrigationCntMicro + NoahmpIO%IRNUMFI (I) = noahmp%water%state%IrrigationCntFlood + NoahmpIO%IRWATSI (I) = noahmp%water%state%IrrigationAmtSprinkler + NoahmpIO%IRWATMI (I) = noahmp%water%state%IrrigationAmtMicro + NoahmpIO%IRWATFI (I) = noahmp%water%state%IrrigationAmtFlood + NoahmpIO%IRSIVOL (I) = NoahmpIO%IRSIVOL(I)+(noahmp%water%flux%IrrigationRateSprinkler*1000.0) + NoahmpIO%IRMIVOL (I) = NoahmpIO%IRMIVOL(I)+(noahmp%water%flux%IrrigationRateMicro*1000.0) + NoahmpIO%IRFIVOL (I) = NoahmpIO%IRFIVOL(I)+(noahmp%water%flux%IrrigationRateFlood*1000.0) + NoahmpIO%IRELOSS (I) = NoahmpIO%IRELOSS(I)+(noahmp%water%flux%EvapIrriSprinkler*NoahmpIO%DTBL) + +#ifdef WRF_HYDRO + NoahmpIO%infxsrt (I) = max(noahmp%water%flux%RunoffSurface, 0.0) ! mm, surface runoff + NoahmpIO%soldrain (I) = max(noahmp%water%flux%RunoffSubsurface, 0.0) ! mm, underground runoff + NoahmpIO%qtiledrain(I) = max(noahmp%water%flux%TileDrain, 0.0) ! mm, tile drainage +#endif + + end associate + + end subroutine WaterVarOutTransfer + +end module WaterVarOutTransferMod diff --git a/src/core_atmosphere/physics/physics_noahmp/parameters/NoahmpTable.TBL b/src/core_atmosphere/physics/physics_noahmp/parameters/NoahmpTable.TBL new file mode 100644 index 000000000..c9d37c5b4 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/parameters/NoahmpTable.TBL @@ -0,0 +1,856 @@ +! ---------------- Noah-MP Parameter Look-up Table History ------------------------ +! Original Table: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Updated Table: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! Updated table reformats and merges original MPTABLE.TBL, SOILPARM.TBL, GENPARM.TBL +! ---------------------------------------------------------------------------------- + +&noahmp_usgs_veg_categories + VEG_DATASET_DESCRIPTION = "USGS" ! land type dataset + NVEG = 27 ! total number of land categories in USGS +/ + +&noahmp_usgs_parameters + ! NVEG = 27 + ! 1: Urban and Built-Up Land + ! 2: Dryland Cropland and Pasture + ! 3: Irrigated Cropland and Pasture + ! 4: Mixed Dryland/Irrigated Cropland and Pasture + ! 5: Cropland/Grassland Mosaic + ! 6: Cropland/Woodland Mosaic + ! 7: Grassland + ! 8: Shrubland + ! 9: Mixed Shrubland/Grassland + ! 10: Savanna + ! 11: Deciduous Broadleaf Forest + ! 12: Deciduous Needleleaf Forest + ! 13: Evergreen Broadleaf Forest + ! 14: Evergreen Needleleaf Forest + ! 15: Mixed Forest + ! 16: Water Bodies + ! 17: Herbaceous Wetland + ! 18: Wooded Wetland + ! 19: Barren or Sparsely Vegetated + ! 20: Herbaceous Tundra + ! 21: Wooded Tundra + ! 22: Mixed Tundra + ! 23: Bare Ground Tundra + ! 24: Snow or Ice + ! 25: Playa + ! 26: Lava + ! 27: White Sand + + ! specify some key land category indicators + ISURBAN = 1 ! urban land type in USGS + ISWATER = 16 ! water land type in USGS + ISBARREN = 19 ! bare soil land type in USGS + ISICE = 24 ! ice land type in USGS + ISCROP = 2 ! crop land type in USGS + EBLFOREST = 13 ! evergreen broadleaf forest land type in USGS + NATURAL = 5 ! natural vegation type in urban pixel in USGS + URBTYPE_beg = 50 ! land type number above which are urban (e.g., LCZ) + LCZ_1 = 51 ! urban local climate zone (LCZ) type 1: compact highrise + LCZ_2 = 52 ! urban local climate zone (LCZ) type 2: compact midrise + LCZ_3 = 53 ! urban local climate zone (LCZ) type 3: compact lowrise + LCZ_4 = 54 ! urban local climate zone (LCZ) type 4: open highrise + LCZ_5 = 55 ! urban local climate zone (LCZ) type 5: open midrise + LCZ_6 = 56 ! urban local climate zone (LCZ) type 6: open lowrise + LCZ_7 = 57 ! urban local climate zone (LCZ) type 7: lightweight lowrise + LCZ_8 = 58 ! urban local climate zone (LCZ) type 8: large lowrise + LCZ_9 = 59 ! urban local climate zone (LCZ) type 9: sparsely built + LCZ_10 = 60 ! urban local climate zone (LCZ) type 10: heavy industry + LCZ_11 = 61 ! urban local climate zone (LCZ) type 11: bare rock or paved + + ! start the vegetation-dependent parameters + !----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- + ! VegType: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 + !----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- + ! CH2OP: maximum intercepted h2o per unit lai+sai (mm) + CH2OP = 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, + ! DLEAF: characteristic leaf dimension (m) + DLEAF = 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, + ! Z0MVT: momentum roughness length (m) + Z0MVT = 1.00, 0.15, 0.15, 0.15, 0.14, 0.50, 0.12, 0.06, 0.09, 0.50, 0.80, 0.85, 1.10, 1.09, 0.80, 0.00, 0.12, 0.50, 0.00, 0.10, 0.30, 0.20, 0.03, 0.00, 0.01, 0.00, 0.00, + ! HVT: top of canopy (m) + HVT = 15.0, 2.00, 2.00, 2.00, 1.50, 8.00, 1.00, 1.10, 1.10, 10.0, 16.0, 18.0, 20.0, 20.0, 16.0, 0.00, 0.50, 10.0, 0.00, 0.50, 4.00, 2.00, 0.50, 0.00, 0.10, 0.00, 0.00, + ! HVB: bottom of canopy (m) + HVB = 1.00, 0.10, 0.10, 0.10, 0.10, 0.15, 0.05, 0.10, 0.10, 0.10, 11.5, 7.00, 8.00, 8.50, 10.0, 0.00, 0.05, 0.10, 0.00, 0.10, 0.10, 0.10, 0.10, 0.00, 0.10, 0.00, 0.00, + ! DEN: tree density (no. of trunks per m2) + DEN = 0.01, 25.0, 25.0, 25.0, 25.0, 25.0, 100., 10.0, 10.0, 0.02, 0.10, 0.28, 0.02, 0.28, 0.10, 0.01, 10.0, 0.10, 0.01, 1.00, 1.00, 1.00, 1.00, 0.00, 0.01, 0.01, 0.01, + ! RC: tree crown radius (m) + RC = 1.00, 0.08, 0.08, 0.08, 0.08, 0.08, 0.03, 0.12, 0.12, 3.00, 1.40, 1.20, 3.60, 1.20, 1.40, 0.01, 0.10, 1.40, 0.01, 0.30, 0.30, 0.30, 0.30, 0.00, 0.01, 0.01, 0.01, + ! MFSNO: snowmelt curve parameter, originally =2.5 everywhere, currently optimized dependent on land type based on SNOTEL SWE & MODIS SCF, surface albedo (He et al. 2019 JGR) + MFSNO = 4.00, 3.00, 3.00, 3.00, 4.00, 4.00, 2.00, 2.00, 2.00, 2.00, 1.00, 1.00, 1.00, 1.00, 1.00, 3.00, 3.00, 3.00, 3.00, 3.50, 3.50, 3.50, 3.50, 2.50, 3.50, 3.50, 3.50, + ! SCFFAC: snow cover factor (m) (replace original hard-coded 2.5*z0, z0=0.002m everywhere), currently optimized based on SNOTEL SWE & MODIS SCF, surface albedo (He et al. 2021 JGR) + SCFFAC = 0.042, 0.014, 0.014, 0.014, 0.026, 0.026, 0.020, 0.018, 0.016, 0.020, 0.008, 0.008, 0.008, 0.008, 0.008, 0.030, 0.020, 0.020, 0.016, 0.030, 0.030, 0.030, 0.030, 0.030, 0.030, 0.030, 0.030, + ! CBIOM: canopy biomass heat capacity parameter (m), C. He 12/23/2022 bring hard-coded parameter to here + CBIOM = 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, + ! RHOL_VIS: leaf reflectance at visible (VIS) band + RHOL_VIS = 0.00, 0.11, 0.11, 0.11, 0.11, 0.11, 0.11, 0.07, 0.10, 0.10, 0.10, 0.07, 0.10, 0.07, 0.10, 0.00, 0.11, 0.10, 0.00, 0.10, 0.10, 0.10, 0.10, 0.00, 0.10, 0.00, 0.00, + ! RHOL_NIR: leaf reflectance at near-infra (NIR) band + RHOL_NIR = 0.00, 0.58, 0.58, 0.58, 0.58, 0.58, 0.58, 0.35, 0.45, 0.45, 0.45, 0.35, 0.45, 0.35, 0.45, 0.00, 0.58, 0.45, 0.00, 0.45, 0.45, 0.45, 0.45, 0.00, 0.45, 0.00, 0.00, + ! RHOS_VIS: stem reflectance at visible (VIS) band + RHOS_VIS = 0.00, 0.36, 0.36, 0.36, 0.36, 0.36, 0.36, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.00, 0.36, 0.16, 0.00, 0.16, 0.16, 0.16, 0.16, 0.00, 0.16, 0.00, 0.00, + ! RHOS_NIR: stem reflectance at near-infra (NIR) band + RHOS_NIR = 0.00, 0.58, 0.58, 0.58, 0.58, 0.58, 0.58, 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.00, 0.58, 0.39, 0.00, 0.39, 0.39, 0.39, 0.39, 0.00, 0.39, 0.00, 0.00, + ! TAUL_VIS: leaf transmittance at visible (VIS) band + TAUL_VIS = 0.00, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.00, 0.07, 0.05, 0.00, 0.05, 0.05, 0.05, 0.05, 0.00, 0.05, 0.00, 0.00, + ! TAUL_NIR: leaf transmittance at near-infra (NIR) band + TAUL_NIR = 0.00, 0.25, 0.25, 0.25, 0.25, 0.25, 0.25, 0.10, 0.10, 0.25, 0.25, 0.10, 0.25, 0.10, 0.25, 0.00, 0.25, 0.25, 0.00, 0.25, 0.25, 0.25, 0.25, 0.00, 0.25, 0.00, 0.00, + ! TAUS_VIS: stem transmittance at visible (VIS) band + TAUS_VIS = 0.00, 0.220, 0.220, 0.220, 0.220, 0.220, 0.220, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.000, 0.220, 0.001, 0.000, 0.220, 0.001, 0.001, 0.001, 0.000, 0.001, 0.000, 0.000, + ! TAUS_NIR: stem transmittance at near-infra (NIR) band + TAUS_NIR = 0.00, 0.380, 0.380, 0.380, 0.380, 0.380, 0.380, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.000, 0.380, 0.001, 0.000, 0.380, 0.001, 0.001, 0.001, 0.000, 0.001, 0.000, 0.000, + ! XL: leaf/stem orientation index + XL = 0.000, -0.30, -0.30, -0.30, -0.30, -0.30, -0.30, 0.010, 0.250, 0.010, 0.250, 0.010, 0.010, 0.010, 0.250, 0.000, -0.30, 0.250, 0.000, -0.30, 0.250, 0.250, 0.250, 0.000, 0.250, 0.000, 0.000, + ! CWPVT: empirical canopy wind absorption parameter (J. Goudriaan, Crop Micrometeorology: A Simulation Study (Simulation monographs), 1977) + CWPVT = 0.18, 1.67, 1.67, 1.67, 1.67, 0.5, 5.0, 1.0, 2.0, 1.0, 0.67, 0.18, 0.67, 0.18, 0.29, 0.18, 1.67, 0.67, 0.18, 1.67, 0.67, 1.00, 0.18, 0.18, 0.18, 0.18, 0.18, + ! C3PSN: photosynthetic pathway: 0.0 = c4, 1.0 = c3 + C3PSN = 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, + ! KC25: CO2 michaelis-menten constant at 25degC (Pa) + KC25 = 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, + ! AKC: q10 for KC25, change in CO2 Michaelis-Menten constant for every 10-degC temperature change + AKC = 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, + ! KO25: O2 michaelis-menten constant at 25degC (Pa) + KO25 = 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, + ! AKO: q10 for KO25, change in O2 Michaelis-Menten constant for every 10-degC temperature change + AKO = 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, + ! VCMX25: maximum rate of carboxylation at 25 degC (umol CO2/m2/s) + VCMX25 = 0.00, 80.0, 80.0, 80.0, 60.0, 70.0, 40.0, 40.0, 40.0, 40.0, 60.0, 60.0, 60.0, 50.0, 55.0, 0.00, 50.0, 50.0, 0.00, 50.0, 50.0, 50.0, 50.0, 0.00, 50.0, 0.00, 0.00, + ! AVCMX: q10 for VCMX25, change in maximum rate of carboxylation at 25degC for every 10-degC temperature change + AVCMX = 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, + ! AQE: q10 for QE25, change in quantum efficiency at 25degC (umol CO2/umol photon) + AQE = 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, + ! LTOVRC: leaf turnover [1/s] + LTOVRC = 0.0, 1.2, 1.2, 1.2, 1.2, 1.30, 0.50, 0.65, 0.70, 0.65, 0.55, 0.2, 0.55, 0.5, 0.5, 0.0, 1.4, 1.4, 0.0, 1.2, 1.3, 1.4, 1.0, 0.0, 1.0, 0.0, 0.0, + ! DILEFC: coeficient for leaf stress death [1/s] + DILEFC = 0.00, 0.50, 0.50, 0.50, 0.35, 0.20, 0.20, 0.20, 0.50, 0.50, 0.60, 1.80, 0.50, 1.20, 0.80, 0.00, 0.40, 0.40, 0.00, 0.40, 0.30, 0.40, 0.30, 0.00, 0.30, 0.00, 0.00, + ! DILEFW: coeficient for leaf stress death [1/s] + DILEFW = 0.00, 0.20, 0.20, 0.20, 0.20, 0.20, 0.10, 0.20, 0.20, 0.50, 0.20, 0.20, 4.00, 0.20, 0.20, 0.00, 0.20, 0.20, 0.00, 0.20, 0.20, 0.20, 0.20, 0.00, 0.20, 0.00, 0.00, + ! RMF25: leaf maintenance respiration at 25degC (umol co2/m2/s) + RMF25 = 0.00, 1.00, 1.40, 1.45, 1.45, 1.45, 1.80, 0.26, 0.26, 0.80, 3.00, 4.00, 0.65, 3.00, 3.00, 0.00, 3.20, 3.20, 0.00, 3.20, 3.00, 3.00, 3.00, 0.00, 3.00, 0.00, 0.00, + ! SLA: single-side leaf area per mass [m2/kg] + SLA = 60, 80, 80, 80, 80, 80, 60, 60, 60, 50, 80, 80, 80, 80, 80, 0, 80, 80, 0, 80, 80, 80, 80, 0, 80, 0, 0, + ! FRAGR: fraction of growth respiration + FRAGR = 0.00, 0.20, 0.20, 0.20, 0.20, 0.20, 0.20, 0.20, 0.20, 0.20, 0.20, 0.10, 0.20, 0.10, 0.10, 0.00, 0.10, 0.10, 0.10, 0.10, 0.10, 0.10, 0.10, 0.00, 0.10, 0.00, 0.00, + ! TMIN: minimum temperature for photosynthesis (K) + TMIN = 0, 273, 273, 273, 273, 273, 273, 273, 273, 273, 273, 268, 273, 265, 268, 0, 268, 268, 0, 268, 268, 268, 268, 0, 268, 0, 0, + ! TDLEF: characteristic temperature for leaf freezing [K] + TDLEF = 278, 278, 278, 278, 278, 278, 278, 278, 278, 278, 278, 268, 278, 278, 268, 0, 268, 268, 0, 268, 268, 268, 268, 0, 268, 0, 0, + ! BP: minimum leaf conductance (umol/m2/s) + BP = 1.E15, 2.E3, 2.E3, 2.E3, 2.E3, 2.E3, 2.E3, 2.E3, 2.E3, 2.E3, 2.E3, 2.E3, 2.E3, 2.E3, 2.E3, 1.E15, 2.E3, 2.E3, 2.E3, 2.E3, 2.E3, 2.E3, 2.E3, 1.E15, 2.E3, 1.E15, 1.E15, + ! MP: slope of conductance-to-photosynthesis relationship + MP = 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, 6.0, 9.0, 6.0, 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, + ! QE25: quantum efficiency at 25degC (umol CO2/umol photon) + QE25 = 0.00, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.00, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.00, 0.06, 0.00, 0.00, + ! RMS25: stem maintenance respiration at 25c (umol CO2/Kg bio/s) + RMS25 = 0.00, 0.10, 0.10, 0.10, 0.10, 0.10, 0.10, 0.10, 0.10, 0.32, 0.10, 0.64, 0.30, 0.90, 0.80, 0.00, 0.10, 0.10, 0.00, 0.10, 0.10, 0.10, 0.00, 0.00, 0.00, 0.00, 0.00, + ! RMR25: root maintenance respiration at 25c (umol CO2/Kg bio/s) + RMR25 = 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 1.20, 0.00, 0.00, 0.01, 0.01, 0.05, 0.05, 0.36, 0.03, 0.00, 0.00, 0.00, 0.00, 2.11, 2.11, 2.11, 0.00, 0.00, 0.00, 0.00, 0.00, + ! ARM: q10 for maintenance respiration, change in maintenance respiration for every 10-degC temperature change + ARM = 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, + ! FOLNMX: foliage nitrogen concentration when f(n)=1 (%) + FOLNMX = 0.0, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 0.00, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 0.00, 1.5, 0.0, 0.0, + ! WDPOOL: ood pool (switch 1 or 0) depending on woody or not + WDPOOL = 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 0.00, 0.00, 1.00, 0.00, 0.00, 1.00, 1.00, 0.00, 0.00, 0.00, 0.00, 0.00, + ! WRRAT: wood to non-wood ratio + WRRAT = 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 3.00, 3.00, 3.00, 30.0, 30.0, 30.0, 30.0, 30.0, 0.00, 0.00, 30.0, 0.00, 0.00, 3.00, 3.00, 0.00, 0.00, 0.00, 0.00, 0.00, + ! MRP: microbial respiration parameter (umol CO2/kgC/s) + MRP = 0.00, 0.23, 0.23, 0.23, 0.23, 0.23, 0.17, 0.19, 0.19, 0.40, 0.40, 0.37, 0.23, 0.37, 0.30, 0.00, 0.17, 0.40, 0.00, 0.17, 0.23, 0.20, 0.00, 0.00, 0.20, 0.00, 0.00, + ! NROOT: number of soil layers with root present + NROOT = 1, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, 4, 4, 0, 2, 2, 1, 3, 3, 3, 2, 1, 1, 0, 0, + ! RGL: Parameter used in radiation stress function + RGL = 999.0, 100.0, 100.0, 100.0, 100.0, 65.0, 100.0, 100.0, 100.0, 65.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 100.0, 30.0, 999.0, 100.0, 100.0, 100.0, 100.0, 999.0, 100.0, 999.0, 999.0, + ! RS: Minimum stomatal resistance (s/m) + RS = 200.0, 40.0, 40.0, 40.0, 40.0, 70.0, 40.0, 300.0, 170.0, 70.0, 100.0, 150.0, 150.0, 125.0, 125.0, 100.0, 40.0, 100.0, 999.0, 150.0, 150.0, 150.0, 200.0, 999.0, 40.0, 999.0, 999.0, + ! HS: Parameter used in vapor pressure deficit function + HS = 999.0, 36.25, 36.25, 36.25, 36.25, 44.14, 36.35, 42.00, 39.18, 54.53, 54.53, 47.35, 41.69, 47.35, 51.93, 51.75, 60.00, 51.93, 999.0, 42.00, 42.00, 42.00, 42.00, 999.0, 36.25, 999.0, 999.0, + ! TOPT: Optimum transpiration air temperature [K] + TOPT = 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, + ! RSMAX: Maximal stomatal resistance [s/m] + RSMAX = 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., + ! RTOVRC: root turnover coefficient [1/s] + RTOVRC = 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, + ! RSWOODC: wood respiration coeficient [1/s] + RSWOODC = 3.E-10,3.E-10,3.E-10,3.E-10,3.E-10,3.E-10,3.E-10,3.E-10,3.E-10,3.E-10,3.E-10,3.E-10,3.E-10,3.E-10,3.E-10,3.E-10,3.E-10,3.E-10,3.E-10,3.E-10,3.E-10,3.E-10,3.E-10,3.E-10,3.E-10,3.E-10,3.E-10, + ! BF: parameter for present wood allocation + BF = 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, + ! WSTRC: water stress coeficient + WSTRC = 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, + ! LAIMIN: minimum leaf area index [m2/m2] + LAIMIN = 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, + ! XSAMIN: minimum stem area index [m2/m2] + XSAMIN = 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, + ! SAI: MODIS monthly climatology (2000-2008) stem area index (one row for each month) (Yang et al., 2011) + SAI_JAN = 0.0, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.2, 0.2, 0.3, 0.4, 0.3, 0.5, 0.4, 0.4, 0.0, 0.2, 0.3, 0.0, 0.1, 0.2, 0.1, 0.0, 0.0, 0.0, 0.0, 0.0, + SAI_FEB = 0.0, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.2, 0.2, 0.3, 0.4, 0.3, 0.5, 0.4, 0.4, 0.0, 0.2, 0.3, 0.0, 0.1, 0.2, 0.1, 0.0, 0.0, 0.0, 0.0, 0.0, + SAI_MAR = 0.0, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.2, 0.2, 0.3, 0.4, 0.3, 0.5, 0.4, 0.4, 0.0, 0.2, 0.3, 0.0, 0.1, 0.2, 0.1, 0.0, 0.0, 0.0, 0.0, 0.0, + SAI_APR = 0.0, 0.3, 0.3, 0.3, 0.3, 0.3, 0.3, 0.2, 0.2, 0.3, 0.4, 0.4, 0.5, 0.3, 0.4, 0.0, 0.2, 0.3, 0.0, 0.1, 0.2, 0.1, 0.0, 0.0, 0.0, 0.0, 0.0, + SAI_MAY = 0.0, 0.2, 0.2, 0.2, 0.3, 0.3, 0.3, 0.2, 0.2, 0.3, 0.4, 0.4, 0.5, 0.4, 0.4, 0.0, 0.3, 0.3, 0.0, 0.1, 0.2, 0.1, 0.0, 0.0, 0.0, 0.0, 0.0, + SAI_JUN = 0.0, 0.3, 0.3, 0.3, 0.4, 0.4, 0.4, 0.2, 0.3, 0.4, 0.4, 0.7, 0.5, 0.5, 0.4, 0.0, 0.4, 0.4, 0.0, 0.2, 0.2, 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, + SAI_JUL = 0.0, 0.4, 0.4, 0.4, 0.6, 0.6, 0.8, 0.4, 0.6, 0.8, 0.9, 1.3, 0.5, 0.5, 0.7, 0.0, 0.6, 0.6, 0.0, 0.4, 0.4, 0.4, 0.0, 0.0, 0.0, 0.0, 0.0, + SAI_AUG = 0.0, 0.5, 0.5, 0.5, 0.9, 0.9, 1.3, 0.6, 0.9, 1.2, 1.2, 1.2, 0.5, 0.6, 0.8, 0.0, 0.9, 0.9, 0.0, 0.6, 0.6, 0.6, 0.0, 0.0, 0.0, 0.0, 0.0, + SAI_SEP = 0.0, 0.4, 0.4, 0.4, 0.7, 1.0, 1.1, 0.8, 1.0, 1.3, 1.6, 1.0, 0.5, 0.6, 1.0, 0.0, 0.7, 1.0, 0.0, 0.7, 0.8, 0.7, 0.0, 0.0, 0.0, 0.0, 0.0, + SAI_OCT = 0.0, 0.3, 0.3, 0.3, 0.3, 0.8, 0.4, 0.7, 0.6, 0.7, 1.4, 0.8, 0.5, 0.7, 1.0, 0.0, 0.3, 0.8, 0.0, 0.5, 0.7, 0.5, 0.0, 0.0, 0.0, 0.0, 0.0, + SAI_NOV = 0.0, 0.3, 0.3, 0.3, 0.3, 0.4, 0.4, 0.3, 0.3, 0.4, 0.6, 0.6, 0.5, 0.6, 0.5, 0.0, 0.3, 0.4, 0.0, 0.3, 0.3, 0.3, 0.0, 0.0, 0.0, 0.0, 0.0, + SAI_DEC = 0.0, 0.3, 0.3, 0.3, 0.3, 0.3, 0.4, 0.2, 0.3, 0.4, 0.4, 0.5, 0.5, 0.5, 0.4, 0.0, 0.3, 0.4, 0.0, 0.2, 0.2, 0.2, 0.0, 0.0, 0.0, 0.0, 0.0, + ! LAI: MODIS monthly climatology (2000-2008) leaf area index (one row for each month) (Yang et al., 2011) + LAI_JAN = 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.4, 0.0, 0.2, 0.3, 0.0, 0.0, 4.5, 4.0, 2.0, 0.0, 0.2, 0.2, 0.0, 0.2, 1.0, 0.6, 0.0, 0.0, 0.0, 0.0, 0.0, + LAI_FEB = 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.5, 0.0, 0.3, 0.3, 0.0, 0.0, 4.5, 4.0, 2.0, 0.0, 0.3, 0.3, 0.0, 0.3, 1.0, 0.6, 0.0, 0.0, 0.0, 0.0, 0.0, + LAI_MAR = 0.0, 0.0, 0.0, 0.0, 0.3, 0.2, 0.6, 0.2, 0.4, 0.5, 0.3, 0.0, 4.5, 4.0, 2.2, 0.0, 0.3, 0.3, 0.0, 0.3, 1.1, 0.7, 0.0, 0.0, 0.0, 0.0, 0.0, + LAI_APR = 0.0, 0.0, 0.0, 0.0, 0.4, 0.6, 0.7, 0.6, 0.7, 0.8, 1.2, 0.6, 4.5, 4.0, 2.6, 0.0, 0.4, 0.6, 0.0, 0.4, 1.3, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, + LAI_MAY = 0.0, 1.0, 1.0, 1.0, 1.1, 2.0, 1.2, 1.5, 1.4, 1.8, 3.0, 1.2, 4.5, 4.0, 3.5, 0.0, 1.1, 2.0, 0.0, 0.6, 1.7, 1.2, 0.0, 0.0, 0.0, 0.0, 0.0, + LAI_JUN = 0.0, 2.0, 2.0, 2.0, 2.5, 3.3, 3.0, 2.3, 2.6, 3.6, 4.7, 2.0, 4.5, 4.0, 4.3, 0.0, 2.5, 3.3, 0.0, 1.5, 2.1, 1.8, 0.0, 0.0, 0.0, 0.0, 0.0, + LAI_JUL = 0.0, 3.0, 3.0, 3.0, 3.2, 3.7, 3.5, 2.3, 2.9, 3.8, 4.5, 2.6, 4.5, 4.0, 4.3, 0.0, 3.2, 3.7, 0.0, 1.7, 2.1, 1.8, 0.0, 0.0, 0.0, 0.0, 0.0, + LAI_AUG = 0.0, 3.0, 3.0, 3.0, 2.2, 3.2, 1.5, 1.7, 1.6, 2.1, 3.4, 1.7, 4.5, 4.0, 3.7, 0.0, 2.2, 3.2, 0.0, 0.8, 1.8, 1.3, 0.0, 0.0, 0.0, 0.0, 0.0, + LAI_SEP = 0.0, 1.5, 1.5, 1.5, 1.1, 1.3, 0.7, 0.6, 0.7, 0.9, 1.2, 1.0, 4.5, 4.0, 2.6, 0.0, 1.1, 1.3, 0.0, 0.4, 1.3, 0.8, 0.0, 0.0, 0.0, 0.0, 0.0, + LAI_OCT = 0.0, 0.0, 0.0, 0.0, 0.3, 0.2, 0.6, 0.2, 0.4, 0.5, 0.3, 0.5, 4.5, 4.0, 2.2, 0.0, 0.3, 0.3, 0.0, 0.3, 1.1, 0.7, 0.0, 0.0, 0.0, 0.0, 0.0, + LAI_NOV = 0.0, 0.0, 0.0, 0.0, 0.3, 0.0, 0.5, 0.0, 0.3, 0.3, 0.0, 0.2, 4.5, 4.0, 2.0, 0.0, 0.3, 0.3, 0.0, 0.2, 1.0, 0.6, 0.0, 0.0, 0.0, 0.0, 0.0, + LAI_DEC = 0.0, 0.0, 0.0, 0.0, 0.2, 0.0, 0.4, 0.0, 0.2, 0.3, 0.0, 0.0, 4.5, 4.0, 2.0, 0.0, 0.2, 0.2, 0.0, 0.2, 1.0, 0.6, 0.0, 0.0, 0.0, 0.0, 0.0, +/ + +&noahmp_modis_veg_categories + VEG_DATASET_DESCRIPTION = "modified igbp modis noah" ! land type dataset + NVEG = 20 ! total number of land categories in MODIS (no lake) +/ + +&noahmp_modis_parameters + ! 1, 'Evergreen Needleleaf Forest' -> USGS 14 "Evergreen Needleleaf Forest" + ! 2, 'Evergreen Broadleaf Forest' -> USGS 13 "Evergreen Broadleaf Forest" + ! 3, 'Deciduous Needleleaf Forest' -> USGS 12 "Deciduous Needleleaf Forest" + ! 4, 'Deciduous Broadleaf Forest' -> USGS 11 "Deciduous Broadleaf Forest" + ! 5, 'Mixed Forests' -> USGS 15 "Mixed Forest" + ! 6, 'Closed Shrublands' -> USGS 8 "shrubland" + ! 7, 'Open Shrublands' -> USGS 9 "mixed shrubland/grassland" + ! 8, 'Woody Savannas' -> USGS 8 "shrubland" + ! 9, 'Savannas' -> USGS 10 "Savanna" + ! 10, 'Grasslands' -> USGS 7 "Grassland" + ! 11 'Permanent wetlands' -> USGS 17 & 18 mean "Herbaceous & wooded wetland" + ! 12, 'Croplands' -> USGS 2 "dryland cropland" + ! 13, 'Urban and Built-Up' -> USGS 1 "Urban and Built-Up Land" + ! 14 'cropland/natural vegetation mosaic' -> USGS 5 "Cropland/Grassland Mosaic" + ! 15, 'Snow and Ice' -> USGS 24 "Snow or Ice" + ! 16, 'Barren or Sparsely Vegetated' -> USGS 19 "Barren or Sparsely Vegetated" + ! 17, 'Water' -> USGS 16 "Water Bodies" + ! 18, 'Wooded Tundra' -> USGS 21 "Wooded Tundra" + ! 19, 'Mixed Tundra' -> USGS 22 "Mixed Tundra" + ! 20, 'Barren Tundra' -> USGS 23 "Bare Ground Tundra" + + ! specify some key land category indicators + ISURBAN = 13 ! urban land type in MODIS + ISWATER = 17 ! water land type in MODIS + ISBARREN = 16 ! bare soil land type in MODIS + ISICE = 15 ! ice land type in MODIS + ISCROP = 12 ! crop land type in MODIS + EBLFOREST = 2 ! evergreen broadleaf forest land type in MODIS + NATURAL = 14 ! natural vegation type in urban pixel in MODIS + URBTYPE_beg = 50 ! land type number above which are urban (e.g., LCZ) + LCZ_1 = 51 ! urban local climate zone (LCZ) type 1: compact highrise + LCZ_2 = 52 ! urban local climate zone (LCZ) type 2: compact midrise + LCZ_3 = 53 ! urban local climate zone (LCZ) type 3: compact lowrise + LCZ_4 = 54 ! urban local climate zone (LCZ) type 4: open highrise + LCZ_5 = 55 ! urban local climate zone (LCZ) type 5: open midrise + LCZ_6 = 56 ! urban local climate zone (LCZ) type 6: open lowrise + LCZ_7 = 57 ! urban local climate zone (LCZ) type 7: lightweight lowrise + LCZ_8 = 58 ! urban local climate zone (LCZ) type 8: large lowrise + LCZ_9 = 59 ! urban local climate zone (LCZ) type 9: sparsely built + LCZ_10 = 60 ! urban local climate zone (LCZ) type 10: heavy industry + LCZ_11 = 61 ! urban local climate zone (LCZ) type 11: bare rock or paved + + ! start the vegetation-dependent parameters + !----------------------------------------------------------------------------------------------------------------------------------------------------------------------- + ! VegType: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 + !----------------------------------------------------------------------------------------------------------------------------------------------------------------------- + ! CH2OP: maximum intercepted h2o per unit lai+sai (mm) + CH2OP = 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, 0.1, + ! DLEAF: characteristic leaf dimension (m) + DLEAF = 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, 0.04, + ! Z0MVT: momentum roughness length (m) + Z0MVT = 1.09, 1.10, 0.85, 0.80, 0.80, 0.20, 0.06, 0.60, 0.50, 0.12, 0.30, 0.15, 1.00, 0.14, 0.00, 0.00, 0.00, 0.30, 0.20, 0.03, + ! HVT: top of canopy (m) + HVT = 20.0, 20.0, 18.0, 16.0, 16.0, 1.10, 1.10, 13.0, 10.0, 1.00, 5.00, 2.00, 15.0, 1.50, 0.00, 0.00, 0.00, 4.00, 2.00, 0.50, + ! HVB: bottom of canopy (m) + HVB = 8.50, 8.00, 7.00, 11.5, 10.0, 0.10, 0.10, 0.10, 0.10, 0.05, 0.10, 0.10, 1.00, 0.10, 0.00, 0.00, 0.00, 0.30, 0.20, 0.10, + ! DEN: tree density (no. of trunks per m2) + DEN = 0.28, 0.02, 0.28, 0.10, 0.10, 10.0, 10.0, 10.0, 0.02, 100., 5.05, 25.0, 0.01, 25.0, 0.00, 0.01, 0.01, 1.00, 1.00, 1.00, + ! RC: tree crown radius (m) + RC = 1.20, 3.60, 1.20, 1.40, 1.40, 0.12, 0.12, 0.12, 3.00, 0.03, 0.75, 0.08, 1.00, 0.08, 0.00, 0.01, 0.01, 0.30, 0.30, 0.30, + ! MFSNO: snowmelt curve parameter, originally =2.5 everywhere, currently optimized dependent on land type based on SNOTEL SWE & MODIS SCF, surface albedo (He et al. 2019 JGR) + MFSNO = 1.00, 1.00, 1.00, 1.00, 1.00, 2.00, 2.00, 2.00, 2.00, 2.00, 3.00, 3.00, 4.00, 4.00, 2.50, 3.00, 3.00, 3.50, 3.50, 3.50, + ! SCFFAC: snow cover factor (m) (replace original hard-coded 2.5*z0, z0=0.002m everywhere), currently optimized based on SNOTEL SWE & MODIS SCF, surface albedo (He et al. 2021 JGR) + SCFFAC = 0.008, 0.008, 0.008, 0.008, 0.008, 0.016, 0.016, 0.020, 0.020, 0.020, 0.020, 0.014, 0.042, 0.026, 0.030, 0.016, 0.030, 0.030, 0.030, 0.030, + ! CBIOM: canopy biomass heat capacity parameter (m), C. He 12/23/2022 bring hard-coded parameter to here + CBIOM = 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, + ! RHOL_VIS: leaf reflectance at visible (VIS) band + RHOL_VIS = 0.07, 0.10, 0.07, 0.10, 0.10, 0.07, 0.07, 0.07, 0.10, 0.11, 0.105, 0.11, 0.00, 0.11, 0.00, 0.00, 0.00, 0.10, 0.10, 0.10, + ! RHOL_NIR: leaf reflectance at near-infra (NIR) band + RHOL_NIR = 0.35, 0.45, 0.35, 0.45, 0.45, 0.35, 0.35, 0.35, 0.45, 0.58, 0.515, 0.58, 0.00, 0.58, 0.00, 0.00, 0.00, 0.45, 0.45, 0.45, + ! RHOS_VIS: stem reflectance at visible (VIS) band + RHOS_VIS = 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.16, 0.36, 0.26, 0.36, 0.00, 0.36, 0.00, 0.00, 0.00, 0.16, 0.16, 0.16, + ! RHOS_NIR: stem reflectance at near-infra (NIR) band + RHOS_NIR = 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.39, 0.58, 0.485, 0.58, 0.00, 0.58, 0.00, 0.00, 0.00, 0.39, 0.39, 0.39, + ! TAUL_VIS: leaf transmittance at visible (VIS) band + TAUL_VIS = 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.07, 0.06, 0.07, 0.00, 0.07, 0.00, 0.00, 0.00, 0.05, 0.05, 0.05, + ! TAUL_NIR: leaf transmittance at near-infra (NIR) band + TAUL_NIR = 0.10, 0.25, 0.10, 0.25, 0.25, 0.10, 0.10, 0.10, 0.25, 0.25, 0.25, 0.25, 0.00, 0.25, 0.00, 0.00, 0.00, 0.25, 0.25, 0.25, + ! TAUS_VIS: stem transmittance at visible (VIS) band + TAUS_VIS = 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.220, 0.1105, 0.220, 0.000, 0.220, 0.000, 0.000, 0.000, 0.001, 0.001, 0.001, + ! TAUS_NIR: stem transmittance at near-infra (NIR) band + TAUS_NIR = 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.001, 0.380, 0.1905, 0.380, 0.000, 0.380, 0.000, 0.000, 0.000, 0.001, 0.001, 0.001, + ! XL: leaf/stem orientation index + XL = 0.010, 0.010, 0.010, 0.250, 0.250, 0.010, 0.010, 0.010, 0.010, -0.30, -0.025, -0.30, 0.000, -0.30, 0.000, 0.000, 0.000, 0.250, 0.250, 0.250, + ! CWPVT: empirical canopy wind absorption parameter (J. Goudriaan, Crop Micrometeorology: A Simulation Study (Simulation monographs), 1977) + CWPVT = 0.18, 0.67, 0.18, 0.67, 0.29, 1.0, 2.0, 1.3, 1.0, 5.0, 1.17, 1.67, 1.67, 1.67, 0.18, 0.18, 0.18, 0.67, 1.0, 0.18, + ! C3PSN: photosynthetic pathway: 0.0 = c4, 1.0 = c3 + C3PSN = 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, + ! KC25: CO2 michaelis-menten constant at 25degC (Pa) + KC25 = 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, 30.0, + ! AKC: q10 for KC25, change in CO2 Michaelis-Menten constant for every 10-degC temperature change + AKC = 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, 2.1, + ! KO25: O2 michaelis-menten constant at 25degC (Pa) + KO25 = 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, + ! AKO: q10 for KO25, change in O2 Michaelis-Menten constant for every 10-degC temperature change + AKO = 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, 1.2, + ! AVCMX: q10 for VCMX25, change in maximum rate of carboxylation at 25degC for every 10-degC temperature change + AVCMX = 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, 2.4, + ! AQE: q10 for QE25, change in quantum efficiency at 25degC (umol CO2/umol photon) + AQE = 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, 1.0, + ! LTOVRC: leaf turnover [1/s] + LTOVRC = 0.5, 0.55, 0.2, 0.55, 0.5, 0.65, 0.65, 0.65, 0.65, 0.50, 1.4, 1.6, 0.0, 1.2, 0.0, 0.0, 0.0, 1.3, 1.4, 1.0, + ! DILEFC: coeficient for leaf stress death [1/s] + DILEFC = 1.20, 0.50, 1.80, 0.60, 0.80, 0.20, 0.20, 0.20, 0.50, 0.20, 0.4, 0.50, 0.00, 0.35, 0.00, 0.00, 0.00, 0.30, 0.40, 0.30, + ! DILEFW: coeficient for leaf stress death [1/s] + DILEFW = 0.20, 4.00, 0.20, 0.20, 0.20, 0.20, 0.20, 0.20, 0.50, 0.10, 0.2, 0.20, 0.00, 0.20, 0.00, 0.00, 0.00, 0.20, 0.20, 0.20, + ! RMF25: leaf maintenance respiration at 25degC (umol co2/m2/s) + RMF25 = 3.00, 0.65, 4.00, 3.00, 3.00, 0.26, 0.26, 0.26, 0.80, 1.80, 3.2, 1.00, 0.00, 1.45, 0.00, 0.00, 0.00, 3.00, 3.00, 3.00, + ! SLA: single-side leaf area per mass [m2/kg] + SLA = 80, 80, 80, 80, 80, 60, 60, 60, 50, 60, 80, 80, 60, 80, 0, 0, 0, 80, 80, 80, + ! FRAGR: fraction of growth respiration + FRAGR = 0.10, 0.20, 0.10, 0.20, 0.10, 0.20, 0.20, 0.20, 0.20, 0.20, 0.1, 0.20, 0.00, 0.20, 0.00, 0.10, 0.00, 0.10, 0.10, 0.10, + ! TMIN: minimum temperature for photosynthesis (K) + TMIN = 265, 273, 268, 273, 268, 273, 273, 273, 273, 273, 268, 273, 0, 273, 0, 0, 0, 268, 268, 268, + ! VCMX25: maximum rate of carboxylation at 25 degC (umol CO2/m2/s) + VCMX25 = 50.0, 60.0, 60.0, 60.0, 55.0, 40.0, 40.0, 40.0, 40.0, 40.0, 50.0, 80.0, 0.00, 60.0, 0.00, 0.00, 0.00, 50.0, 50.0, 50.0, + ! TDLEF: characteristic temperature for leaf freezing [K] + TDLEF = 278, 278, 268, 278, 268, 278, 278, 278, 278, 278, 268, 278, 278, 278, 0, 0, 0, 268, 268, 268, + ! BP: minimum leaf conductance (umol/m2/s) + BP = 2.E3, 2.E3, 2.E3, 2.E3, 2.E3, 2.E3, 2.E3, 2.E3, 2.E3, 2.E3, 2.E3, 2.E3, 1.E15, 2.E3, 1.E15, 2.E3, 1.E15, 2.E3, 2.E3, 2.E3, + ! MP: slope of conductance-to-photosynthesis relationship + MP = 6.0, 9.0, 6.0, 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, 9.0, + ! QE25: quantum efficiency at 25degC (umol CO2/umol photon) + QE25 = 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.06, 0.00, 0.06, 0.00, 0.06, 0.00, 0.06, 0.06, 0.06, + ! RMS25: stem maintenance respiration at 25c (umol CO2/Kg bio/s) + RMS25 = 0.90, 0.30, 0.64, 0.10, 0.80, 0.10, 0.10, 0.10, 0.32, 0.10, 0.10, 0.10, 0.00, 0.10, 0.00, 0.00, 0.00, 0.10, 0.10, 0.00, + ! RMR25: root maintenance respiration at 25c (umol CO2/Kg bio/s) + RMR25 = 0.36, 0.05, 0.05, 0.01, 0.03, 0.00, 0.00, 0.00, 0.01, 1.20, 0.0, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 2.11, 2.11, 0.00, + ! ARM: q10 for maintenance respiration, change in maintenance respiration for every 10-degC temperature change + ARM = 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, 2.0, + ! FOLNMX: foliage nitrogen concentration when f(n)=1 (%) + FOLNMX = 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 1.5, 0.00, 1.5, 0.00, 1.5, 0.00, 1.5, 1.5, 1.5, + ! WDPOOL: ood pool (switch 1 or 0) depending on woody or not + WDPOOL = 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 0.00, 0.5, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 1.00, 1.00, 0.00, + ! WRRAT: wood to non-wood ratio + WRRAT = 30.0, 30.0, 30.0, 30.0, 30.0, 3.00, 3.00, 3.00, 3.00, 0.00, 15.0, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 3.00, 3.00, 0.00, + ! MRP: microbial respiration parameter (umol CO2/kgC/s) + MRP = 0.37, 0.23, 0.37, 0.40, 0.30, 0.19, 0.19, 0.19, 0.40, 0.17, 0.285, 0.23, 0.00, 0.23, 0.00, 0.00, 0.00, 0.23, 0.20, 0.00, + ! NROOT: number of soil layers with root present + NROOT = 4, 4, 4, 4, 4, 3, 3, 3, 3, 3, 2, 3, 1, 3, 1, 1, 0, 3, 3, 2, + ! RGL: Parameter used in radiation stress function + RGL = 30.0, 30.0, 30.0, 30.0, 30.0, 100.0, 100.0, 100.0, 65.0, 100.0, 65.0, 100.0, 999.0, 100.0, 999.0, 999.0, 30.0, 100.0, 100.0, 100.0, + ! RS: Minimum stomatal resistance (s/m) + RS = 125.0, 150.0, 150.0, 100.0, 125.0, 300.0, 170.0, 300.0, 70.0, 40.0, 70.0, 40.0, 200.0, 40.0, 999.0, 999.0, 100.0, 150.0, 150.0, 200.0, + ! HS: Parameter used in vapor pressure deficit function + HS = 47.35, 41.69, 47.35, 54.53, 51.93, 42.00, 39.18, 42.00, 54.53, 36.35, 55.97, 36.25, 999.0, 36.25, 999.0, 999.0, 51.75, 42.00, 42.00, 42.00, + ! TOPT: Optimum transpiration air temperature [K] + TOPT = 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, 298.0, + ! RSMAX: Maximal stomatal resistance [s/m] + RSMAX = 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., 5000., + ! RTOVRC: root turnover coefficient [1/s] + RTOVRC = 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, 2.E-8, + ! RSWOODC: wood respiration coeficient [1/s] + RSWOODC = 3.E-10,3.E-10, 3.E-10, 3.E-10, 3.E-10, 3.E-10, 3.E-10, 3.E-10, 3.E-10, 3.E-10, 3.E-10, 3.E-10, 3.E-10, 3.E-10, 3.E-10, 3.E-10, 3.E-10, 3.E-10, 3.E-10, 3.E-10, + ! BF: parameter for present wood allocation + BF = 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, + ! WSTRC: water stress coeficient + WSTRC = 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, 100.0, + ! LAIMIN: minimum leaf area index [m2/m2] + LAIMIN = 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, + ! XSAMIN: minimum stem area index [m2/m2] + XSAMIN = 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, 0.05, + ! SAI: MODIS monthly climatology (2000-2008) stem area index (one row for each month) (Yang et al., 2011) + SAI_JAN = 0.4, 0.5, 0.3, 0.4, 0.4, 0.3, 0.2, 0.4, 0.3, 0.3, 0.3, 0.3, 0.0, 0.3, 0.0, 0.0, 0.0, 0.2, 0.1, 0.0, + SAI_FEB = 0.4, 0.5, 0.3, 0.4, 0.4, 0.3, 0.2, 0.4, 0.3, 0.3, 0.3, 0.3, 0.0, 0.3, 0.0, 0.0, 0.0, 0.2, 0.1, 0.0, + SAI_MAR = 0.4, 0.5, 0.3, 0.4, 0.4, 0.3, 0.2, 0.4, 0.3, 0.3, 0.3, 0.3, 0.0, 0.3, 0.0, 0.0, 0.0, 0.2, 0.1, 0.0, + SAI_APR = 0.3, 0.5, 0.4, 0.4, 0.4, 0.3, 0.2, 0.4, 0.3, 0.3, 0.3, 0.3, 0.0, 0.3, 0.0, 0.0, 0.0, 0.2, 0.1, 0.0, + SAI_MAY = 0.4, 0.5, 0.4, 0.4, 0.4, 0.3, 0.2, 0.4, 0.3, 0.3, 0.3, 0.3, 0.0, 0.3, 0.0, 0.0, 0.0, 0.2, 0.1, 0.0, + SAI_JUN = 0.5, 0.5, 0.7, 0.4, 0.4, 0.3, 0.2, 0.4, 0.4, 0.4, 0.4, 0.3, 0.0, 0.4, 0.0, 0.0, 0.0, 0.2, 0.2, 0.0, + SAI_JUL = 0.5, 0.5, 1.3, 0.9, 0.7, 0.6, 0.4, 0.7, 0.8, 0.8, 0.6, 0.4, 0.0, 0.6, 0.0, 0.0, 0.0, 0.4, 0.4, 0.0, + SAI_AUG = 0.6, 0.5, 1.2, 1.2, 0.8, 0.9, 0.6, 1.2, 1.2, 1.3, 0.9, 0.5, 0.0, 0.9, 0.0, 0.0, 0.0, 0.6, 0.6, 0.0, + SAI_SEP = 0.6, 0.5, 1.0, 1.6, 1.0, 1.2, 0.8, 1.4, 1.3, 1.1, 0.9, 0.4, 0.0, 0.7, 0.0, 0.0, 0.0, 0.8, 0.7, 0.0, + SAI_OCT = 0.7, 0.5, 0.8, 1.4, 1.0, 0.9, 0.7, 1.1, 0.7, 0.4, 0.6, 0.3, 0.0, 0.3, 0.0, 0.0, 0.0, 0.7, 0.5, 0.0, + SAI_NOV = 0.6, 0.5, 0.6, 0.6, 0.5, 0.4, 0.3, 0.5, 0.4, 0.4, 0.4, 0.3, 0.0, 0.3, 0.0, 0.0, 0.0, 0.3, 0.3, 0.0, + SAI_DEC = 0.5, 0.5, 0.5, 0.4, 0.4, 0.3, 0.2, 0.4, 0.4, 0.4, 0.3, 0.3, 0.0, 0.3, 0.0, 0.0, 0.0, 0.2, 0.2, 0.0, + ! LAI: MODIS monthly climatology (2000-2008) leaf area index (one row for each month) (Yang et al., 2011) + LAI_JAN = 4.0, 4.5, 0.0, 0.0, 2.0, 0.0, 0.0, 0.2, 0.3, 0.4, 0.2, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0, 1.0, 0.6, 0.0, + LAI_FEB = 4.0, 4.5, 0.0, 0.0, 2.0, 0.0, 0.0, 0.2, 0.3, 0.5, 0.3, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0, 1.0, 0.6, 0.0, + LAI_MAR = 4.0, 4.5, 0.0, 0.3, 2.2, 0.3, 0.2, 0.4, 0.5, 0.6, 0.3, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0, 1.1, 0.7, 0.0, + LAI_APR = 4.0, 4.5, 0.6, 1.2, 2.6, 0.9, 0.6, 1.0, 0.8, 0.7, 0.5, 0.0, 0.0, 0.4, 0.0, 0.0, 0.0, 1.3, 0.8, 0.0, + LAI_MAY = 4.0, 4.5, 1.2, 3.0, 3.5, 2.2, 1.5, 2.4, 1.8, 1.2, 1.5, 1.0, 0.0, 1.1, 0.0, 0.0, 0.0, 1.7, 1.2, 0.0, + LAI_JUN = 4.0, 4.5, 2.0, 4.7, 4.3, 3.5, 2.3, 4.1, 3.6, 3.0, 2.9, 2.0, 0.0, 2.5, 0.0, 0.0, 0.0, 2.1, 1.8, 0.0, + LAI_JUL = 4.0, 4.5, 2.6, 4.5, 4.3, 3.5, 2.3, 4.1, 3.8, 3.5, 3.5, 3.0, 0.0, 3.2, 0.0, 0.0, 0.0, 2.1, 1.8, 0.0, + LAI_AUG = 4.0, 4.5, 1.7, 3.4, 3.7, 2.5, 1.7, 2.7, 2.1, 1.5, 2.7, 3.0, 0.0, 2.2, 0.0, 0.0, 0.0, 1.8, 1.3, 0.0, + LAI_SEP = 4.0, 4.5, 1.0, 1.2, 2.6, 0.9, 0.6, 1.0, 0.9, 0.7, 1.2, 1.5, 0.0, 1.1, 0.0, 0.0, 0.0, 1.3, 0.8, 0.0, + LAI_OCT = 4.0, 4.5, 0.5, 0.3, 2.2, 0.3, 0.2, 0.4, 0.5, 0.6, 0.3, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0, 1.1, 0.7, 0.0, + LAI_NOV = 4.0, 4.5, 0.2, 0.0, 2.0, 0.0, 0.0, 0.2, 0.3, 0.5, 0.3, 0.0, 0.0, 0.3, 0.0, 0.0, 0.0, 1.0, 0.6, 0.0, + LAI_DEC = 4.0, 4.5, 0.0, 0.0, 2.0, 0.0, 0.0, 0.2, 0.3, 0.4, 0.2, 0.0, 0.0, 0.2, 0.0, 0.0, 0.0, 1.0, 0.6, 0.0, +/ + +&noahmp_rad_parameters + !------------------------------------------------------------------------------ + ! soil color: 1 2 3 4 5 6 7 8 soil color index for soil albedo + !------------------------------------------------------------------------------ + ALBSAT_VIS = 0.15, 0.11, 0.10, 0.09, 0.08, 0.07, 0.06, 0.05 ! saturated soil albedo at visible band + ALBSAT_NIR = 0.30, 0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10 ! saturated soil albedo at NIR band + ALBDRY_VIS = 0.27, 0.22, 0.20, 0.18, 0.16, 0.14, 0.12, 0.10 ! dry soil albedo at visible band + ALBDRY_NIR = 0.54, 0.44, 0.40, 0.36, 0.32, 0.28, 0.24, 0.20 ! dry soil albedo at NIR band + ALBICE = 0.80, 0.55 ! albedo land ice: 1=vis, 2=nir + ALBLAK = 0.60, 0.40 ! albedo frozen lakes: 1=vis, 2=nir + OMEGAS = 0.8 , 0.4 ! two-stream parameter omega for snow + BETADS = 0.5 ! two-stream parameter betad for snow + BETAIS = 0.5 ! two-stream parameter betaI for snow + EG = 0.97, 0.98 ! emissivity soil surface 1-soil;2-lake + EICE = 0.98 ! emissivity ice surface +/ + +&noahmp_global_parameters + ! atmospheric constituants + CO2 = 395.0e-06 ! CO2 partial pressure + O2 = 0.209 ! O2 partial pressure + ! runoff parameters used for SIMTOP and SIMGM + TIMEAN = 10.5 ! gridcell mean topgraphic index (global mean) + FSATMX = 0.38 ! maximum surface saturated fraction (global mean) + ROUS = 0.20 ! specific yield [-] for Niu et al. 2007 groundwater scheme (OptRunoffSubsurface=1) + CMIC = 0.80 ! microprore content (0.0-1.0), 0.0: close to free drainage + ! parameters for snow processes + SSI = 0.03 ! liquid water holding capacity for snowpack (m3/m3) + SNOW_RET_FAC = 5.0e-5 ! snowpack water release timescale factor (1/s) + SNOW_EMIS = 0.95 ! snow emissivity + SWEMX = 1.00 ! new snow mass to fully cover old snow (mm), equivalent to 10mm depth (density = 100 kg/m3) + TAU0 = 1.0e6 ! tau0 from Yang97 eqn. 10a for BATS snow aging + GRAIN_GROWTH = 5000.0 ! growth from vapor diffusion Yang97 eqn. 10b for BATS snow aging + EXTRA_GROWTH = 10.0 ! extra growth near freezing Yang97 eqn. 10c for BATS snow aging + DIRT_SOOT = 0.3 ! dirt and soot term Yang97 eqn. 10d for BATS snow aging + BATS_COSZ = 2.0 ! zenith angle snow albedo adjustment; b in Yang97 eqn. 15 for BATS snow albedo + BATS_VIS_NEW = 0.95 ! new snow visible albedo for BATS snow albedo + BATS_NIR_NEW = 0.65 ! new snow NIR albedo for BATS snow albedo + BATS_VIS_AGE = 0.2 ! age factor for diffuse visible snow albedo Yang97 eqn. 17 for BATS snow albedo + BATS_NIR_AGE = 0.5 ! age factor for diffuse NIR snow albedo Yang97 eqn. 18 for BATS snow albedo + BATS_VIS_DIR = 0.4 ! cosz factor for direct visible snow albedo Yang97 eqn. 15 for BATS snow albedo + BATS_NIR_DIR = 0.4 ! cosz factor for direct NIR snow albedo Yang97 eqn. 16 for BATS snow albedo + C2_SNOWCOMPACT = 21.0e-3 ! overburden snow compaction parameter (m3/kg) + C3_SNOWCOMPACT = 2.5e-6 ! snow desctructive metamorphism compaction parameter1 [1/s] + C4_SNOWCOMPACT = 0.04 ! snow desctructive metamorphism compaction parameter2 [1/k] + C5_SNOWCOMPACT = 2.0 ! snow desctructive metamorphism compaction parameter3 + DM_SNOWCOMPACT = 100.0 ! upper Limit on destructive metamorphism compaction [kg/m3] + ETA0_SNOWCOMPACT = 1.33e+6 ! snow viscosity coefficient [kg-s/m2], Anderson1979: 0.52e6~1.38e6; 1.33e+6 optimized based on SNOTEL obs (He et al. 2021 JGR) + SNLIQMAXFRAC = 0.4 ! maximum liquid water fraction in snow + SWEMAXGLA = 5000.0 ! Maximum SWE allowed at glaciers (mm) + SNOWDEN_MAX = 120.0 ! maximum fresh snowfall density (kg/m3) + CLASS_ALB_REF = 0.55 ! reference snow albedo in CLASS scheme + CLASS_SNO_AGE = 3600.0 ! snow aging e-folding time (s) in CLASS albedo scheme + CLASS_ALB_NEW = 0.84 ! fresh snow albedo in CLASS scheme + RSURF_SNOW = 50.0 ! surface resistence for snow [s/m] + Z0SNO = 0.002 ! snow surface roughness length (m) + ! other soil and hydrological parameters + RSURF_EXP = 5.0 ! exponent in the shape parameter for soil resistance option 1 + WSLMAX = 5000.0 ! maximum lake water storage (mm) + PSIWLT = -150.0 ! metric potential for wilting point (m) + Z0SOIL = 0.002 ! Bare-soil roughness length (m) (i.e., under the canopy) + Z0LAKE = 0.01 ! Lake surface roughness length (m) +/ + +&noahmp_irrigation_parameters + IRR_FRAC = 0.10 ! irrigation Fraction + IRR_HAR = 20 ! number of days before harvest date to stop irrigation + IRR_LAI = 0.10 ! Minimum lai to trigger irrigation + IRR_MAD = 0.60 ! management allowable deficit (0.0-1.0) + FILOSS = 0.50 ! flood irrigation loss fraction (0.0-0.99) + SPRIR_RATE = 6.40 ! mm/h, sprinkler irrigation rate + MICIR_RATE = 1.38 ! mm/h, micro irrigation rate + FIRTFAC = 1.20 ! flood application rate factor + IR_RAIN = 1.00 ! maximum precipitation [mm/hr] to stop irrigation trigger +/ + +&noahmp_crop_parameters + ! NCROP = 5 + ! 1: Corn + ! 2: Soybean + ! 3: Sorghum + ! 4: Rice + ! 5: Winter wheat + + DEFAULT_CROP = 0 ! default crop type (1-5); if =0, use generic dynamic vegetation + +!------------------------------------------------------- +! CropType: 1 2 3 4 5 +!------------------------------------------------------- + PLTDAY = 111, 131, 111, 111, 111, ! Planting date + HSDAY = 300, 280, 300, 300, 300, ! Harvest date + PLANTPOP = 78.0, 78.0, 78.0, 78.0, 78.0, ! Plant density [per ha] + GDDTBASE = 10.0, 10.0, 10.0, 10.0, 10.0, ! Base temperature for Grow Degree Day (GDD) accumulation [C] + GDDTCUT = 30.0, 30.0, 30.0, 30.0, 30.0, ! Upper temperature for Grow Degree Day (GDD) accumulation [C] + GDDS1 = 50.0, 60.0, 50.0, 50.0, 50.0, ! Grow Degree Day (GDD) from seeding to emergence + GDDS2 = 625.0, 675.0, 718.0, 718.0, 718.0, ! Grow Degree Day (GDD) from seeding to initial vegetative + GDDS3 = 933.0, 1183.0, 933.0, 933.0, 933.0, ! Grow Degree Day (GDD) from seeding to post vegetative + GDDS4 = 1103.0, 1253.0, 1103.0, 1103.0, 1103.0, ! Grow Degree Day (GDD) from seeding to intial reproductive + GDDS5 = 1555.0, 1605.0, 1555.0, 1555.0, 1555.0, ! Grow Degree Day (GDD) from seeding to pysical maturity + C3PSNI = 0.0, 1.0, 1.0, 1.0, 1.0, ! photosynthetic pathway: 0.0 = c4, 1.0 = c3; the following 11 *I parameters added by Z. Zhang, 2020/02 + KC25I = 30.0, 30.0, 30.0, 30.0, 30.0, ! CO2 michaelis-menten constant at 25 degC (pa) + AKCI = 2.1, 2.1, 2.1, 2.1, 2.1, ! q10 for KC25; change in CO2 Michaelis-Menten constant for every 10-degC temperature change + KO25I = 3.E4, 3.E4, 3.E4, 3.E4, 3.E4, ! O2 michaelis-menten constant at 25 degC (pa) + AKOI = 1.2, 1.2, 1.2, 1.2, 1.2, ! q10 for KO25; change in O2 Michaelis-Menten constant for every 10-degC temperature change + AVCMXI = 2.4, 2.4, 2.4, 2.4, 2.4, ! q10 for VCMZ25; change in maximum rate of carboxylation for every 10-degC temperature change + VCMX25I = 60.0, 80.0, 60.0, 60.0, 55.0, ! maximum rate of carboxylation at 25c (umol CO2/m2/s) + BPI = 4.E4, 1.E4, 2.E3, 2.E3, 2.E3, ! minimum leaf conductance (umol/m2/s) + MPI = 4., 9., 6., 9., 9., ! slope of conductance-to-photosynthesis relationship + FOLNMXI = 1.5, 1.5, 1.5, 1.5, 1.5, ! foliage nitrogen concentration when f(n)=1 (%) + QE25I = 0.05, 0.06, 0.06, 0.06, 0.06, ! quantum efficiency at 25 degC (umol CO2/umol photon) + Aref = 7.0, 7.0, 7.0, 7.0, 7.0, ! reference maximum CO2 assimilation rate + PSNRF = 0.85, 0.85, 0.85, 0.85, 0.85, ! CO2 assimilation reduction factor(0-1) (caused by non-modeling part,e.g.pest,weeds) + I2PAR = 0.5, 0.5, 0.5, 0.5, 0.5, ! Fraction of incoming solar radiation to photosynthetically active radiation + TASSIM0 = 8.0, 8.0, 8.0, 8.0, 8.0, ! Minimum temperature for CO2 assimilation [C] + TASSIM1 = 18.0, 18.0, 18.0, 18.0, 18.0, ! CO2 assimilation linearly increasing until temperature reaches T1 [C] + TASSIM2 = 30.0, 30.0, 30.0, 30.0, 30.0, ! CO2 assmilation rate remain at Aref until temperature reaches T2 [C] + K = 0.55, 0.55, 0.55, 0.55, 0.55, ! light extinction coefficient + EPSI = 12.5, 12.5, 12.5, 12.5, 12.5, ! initial light use efficiency + Q10MR = 2.0, 2.0, 2.0, 2.0, 2.0, ! q10 for maintainance respiration; change in maintainance respiration for every 10-degC temperature change + LEFREEZ = 268, 268, 268, 268, 268, ! characteristic T for leaf freezing [K] + DILE_FC_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! coeficient for temperature leaf stress death [1/s] at growth stage 1 + DILE_FC_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, ! coeficient for temperature leaf stress death [1/s] at growth stage 2 + DILE_FC_S3 = 0.0, 0.0, 0.0, 0.0, 0.0, ! coeficient for temperature leaf stress death [1/s] at growth stage 3 + DILE_FC_S4 = 0.0, 0.0, 0.0, 0.0, 0.0, ! coeficient for temperature leaf stress death [1/s] at growth stage 4 + DILE_FC_S5 = 0.5, 0.5, 0.5, 0.5, 0.5, ! coeficient for temperature leaf stress death [1/s] at growth stage 5 + DILE_FC_S6 = 0.5, 0.5, 0.5, 0.5, 0.5, ! coeficient for temperature leaf stress death [1/s] at growth stage 6 + DILE_FC_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, ! coeficient for temperature leaf stress death [1/s] at growth stage 7 + DILE_FC_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, ! coeficient for temperature leaf stress death [1/s] at growth stage 8 + DILE_FW_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! coeficient for water leaf stress death [1/s] at growth stage 1 + DILE_FW_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, ! coeficient for water leaf stress death [1/s] at growth stage 2 + DILE_FW_S3 = 0.0, 0.0, 0.0, 0.0, 0.0, ! coeficient for water leaf stress death [1/s] at growth stage 3 + DILE_FW_S4 = 0.0, 0.0, 0.0, 0.0, 0.0, ! coeficient for water leaf stress death [1/s] at growth stage 4 + DILE_FW_S5 = 0.2, 0.2, 0.2, 0.2, 0.2, ! coeficient for water leaf stress death [1/s] at growth stage 5 + DILE_FW_S6 = 0.2, 0.2, 0.2, 0.2, 0.2, ! coeficient for water leaf stress death [1/s] at growth stage 6 + DILE_FW_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, ! coeficient for water leaf stress death [1/s] at growth stage 7 + DILE_FW_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, ! coeficient for water leaf stress death [1/s] at growth stage 8 + FRA_GR = 0.2, 0.2, 0.2, 0.2, 0.2, ! fraction of growth respiration + LF_OVRC_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of leaf turnover [1/s] at growth stage 1 + LF_OVRC_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of leaf turnover [1/s] at growth stage 2 + LF_OVRC_S3 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of leaf turnover [1/s] at growth stage 3 + LF_OVRC_S4 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of leaf turnover [1/s] at growth stage 4 + LF_OVRC_S5 = 0.2, 0.2, 0.48, 0.48, 0.48, ! fraction of leaf turnover [1/s] at growth stage 5 + LF_OVRC_S6 = 0.3, 0.3, 0.48, 0.48, 0.48, ! fraction of leaf turnover [1/s] at growth stage 6 + LF_OVRC_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of leaf turnover [1/s] at growth stage 7 + LF_OVRC_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of leaf turnover [1/s] at growth stage 8 + ST_OVRC_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of stem turnover [1/s] at growth stage 1 + ST_OVRC_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of stem turnover [1/s] at growth stage 2 + ST_OVRC_S3 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of stem turnover [1/s] at growth stage 3 + ST_OVRC_S4 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of stem turnover [1/s] at growth stage 4 + ST_OVRC_S5 = 0.2, 0.12, 0.12, 0.12, 0.12, ! fraction of stem turnover [1/s] at growth stage 5 + ST_OVRC_S6 = 0.3, 0.06, 0.06, 0.06, 0.06, ! fraction of stem turnover [1/s] at growth stage 6 + ST_OVRC_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of stem turnover [1/s] at growth stage 7 + ST_OVRC_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of stem turnover [1/s] at growth stage 8 + RT_OVRC_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of root tunrover [1/s] at growth stage 1 + RT_OVRC_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of root tunrover [1/s] at growth stage 2 + RT_OVRC_S3 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of root tunrover [1/s] at growth stage 3 + RT_OVRC_S4 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of root tunrover [1/s] at growth stage 4 + RT_OVRC_S5 = 0.12, 0.12, 0.12, 0.12, 0.12, ! fraction of root tunrover [1/s] at growth stage 5 + RT_OVRC_S6 = 0.06, 0.06, 0.06, 0.06, 0.06, ! fraction of root tunrover [1/s] at growth stage 6 + RT_OVRC_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of root tunrover [1/s] at growth stage 7 + RT_OVRC_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of root tunrover [1/s] at growth stage 8 + LFMR25 = 0.8, 1.0, 1.0, 1.0, 1.0, ! leaf maintenance respiration at 25C [umol CO2/m2/s] + STMR25 = 0.05, 0.05, 0.1, 0.1, 0.1, ! stem maintenance respiration at 25C [umol CO2/kg bio/s] + RTMR25 = 0.05, 0.05, 0.0, 0.0, 0.0, ! root maintenance respiration at 25C [umol CO2/kg bio/s] + GRAINMR25 = 0.0, 0.0, 0.1, 0.1, 0.1, ! grain maintenance respiration at 25C [umol CO2/kg bio/s] + LFPT_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to leaf at growth stage 1 + LFPT_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to leaf at growth stage 2 + LFPT_S3 = 0.36, 0.4, 0.4, 0.4, 0.4, ! fraction of carbohydrate flux to leaf at growth stage 3 + LFPT_S4 = 0.1, 0.2, 0.2, 0.2, 0.2, ! fraction of carbohydrate flux to leaf at growth stage 4 + LFPT_S5 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to leaf at growth stage 5 + LFPT_S6 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to leaf at growth stage 6 + LFPT_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to leaf at growth stage 7 + LFPT_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to leaf at growth stage 8 + STPT_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to stem at growth stage 1 + STPT_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to stem at growth stage 2 + STPT_S3 = 0.24, 0.2, 0.2, 0.2, 0.2, ! fraction of carbohydrate flux to stem at growth stage 3 + STPT_S4 = 0.6, 0.5, 0.5, 0.5, 0.5, ! fraction of carbohydrate flux to stem at growth stage 4 + STPT_S5 = 0.0, 0.0, 0.15, 0.15, 0.15, ! fraction of carbohydrate flux to stem at growth stage 5 + STPT_S6 = 0.0, 0.0, 0.05, 0.05, 0.05, ! fraction of carbohydrate flux to stem at growth stage 6 + STPT_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to stem at growth stage 7 + STPT_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to stem at growth stage 8 + RTPT_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to root at growth stage 1 + RTPT_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to root at growth stage 2 + RTPT_S3 = 0.4, 0.4, 0.4, 0.4, 0.4, ! fraction of carbohydrate flux to root at growth stage 3 + RTPT_S4 = 0.3, 0.3, 0.3, 0.3, 0.3, ! fraction of carbohydrate flux to root at growth stage 4 + RTPT_S5 = 0.05, 0.05, 0.05, 0.05, 0.05, ! fraction of carbohydrate flux to root at growth stage 5 + RTPT_S6 = 0.0, 0.0, 0.05, 0.05, 0.05, ! fraction of carbohydrate flux to root at growth stage 6 + RTPT_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to root at growth stage 7 + RTPT_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to root at growth stage 8 + GRAINPT_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to grain at growth stage 1 + GRAINPT_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to grain at growth stage 2 + GRAINPT_S3 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to grain at growth stage 3 + GRAINPT_S4 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to grain at growth stage 4 + GRAINPT_S5 = 0.95, 0.95, 0.8, 0.8, 0.8, ! fraction of carbohydrate flux to grain at growth stage 5 + GRAINPT_S6 = 1.0, 1.0, 0.9, 0.9, 0.9, ! fraction of carbohydrate flux to grain at growth stage 6 + GRAINPT_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to grain at growth stage 7 + GRAINPT_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate flux to grain at growth stage 8 + LFCT_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate translocation from leaf to grain at growth stage 1 + LFCT_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate translocation from leaf to grain at growth stage 2 + LFCT_S3 = 0.0, 0.0, 0.4, 0.4, 0.4, ! fraction of carbohydrate translocation from leaf to grain at growth stage 3 + LFCT_S4 = 0.0, 0.0, 0.3, 0.3, 0.3, ! fraction of carbohydrate translocation from leaf to grain at growth stage 4 + LFCT_S5 = 0.0, 0.0, 0.05, 0.05, 0.05, ! fraction of carbohydrate translocation from leaf to grain at growth stage 5 + LFCT_S6 = 0.0, 0.0, 0.05, 0.05, 0.05, ! fraction of carbohydrate translocation from leaf to grain at growth stage 6 + LFCT_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate translocation from leaf to grain at growth stage 7 + LFCT_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate translocation from leaf to grain at growth stage 8 + STCT_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate translocation from stem to grain at growth stage 1 + STCT_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate translocation from stem to grain at growth stage 2 + STCT_S3 = 0.0, 0.0, 0.4, 0.4, 0.4, ! fraction of carbohydrate translocation from stem to grain at growth stage 3 + STCT_S4 = 0.0, 0.0, 0.3, 0.3, 0.3, ! fraction of carbohydrate translocation from stem to grain at growth stage 4 + STCT_S5 = 0.0, 0.0, 0.05, 0.05, 0.05, ! fraction of carbohydrate translocation from stem to grain at growth stage 5 + STCT_S6 = 0.0, 0.0, 0.05, 0.05, 0.05, ! fraction of carbohydrate translocation from stem to grain at growth stage 6 + STCT_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate translocation from stem to grain at growth stage 7 + STCT_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate translocation from stem to grain at growth stage 8 + RTCT_S1 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate translocation from root to grain at growth stage 1 + RTCT_S2 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate translocation from root to grain at growth stage 2 + RTCT_S3 = 0.0, 0.0, 0.4, 0.4, 0.4, ! fraction of carbohydrate translocation from root to grain at growth stage 3 + RTCT_S4 = 0.0, 0.0, 0.3, 0.3, 0.3, ! fraction of carbohydrate translocation from root to grain at growth stage 4 + RTCT_S5 = 0.0, 0.0, 0.05, 0.05, 0.05, ! fraction of carbohydrate translocation from root to grain at growth stage 5 + RTCT_S6 = 0.0, 0.0, 0.05, 0.05, 0.05, ! fraction of carbohydrate translocation from root to grain at growth stage 6 + RTCT_S7 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate translocation from root to grain at growth stage 7 + RTCT_S8 = 0.0, 0.0, 0.0, 0.0, 0.0, ! fraction of carbohydrate translocation from root to grain at growth stage 8 + BIO2LAI = 0.015, 0.030, 0.015, 0.015, 0.015, ! leaf area per living leaf biomass [m2/kg] +/ + +&noahmp_tiledrain_parameters + NSOILTYPE = 19 ! num_soil_types + + !-----------------------------------! + ! For simple drainage model ! + !-----------------------------------! + DRAIN_LAYER_OPT = 4 ! soil layer which is applied by drainage + ! 0 - from one specified layer by TD_DEPTH, + ! 1 - from layers 1 & 2, + ! 2 - from layer layers 1, 2, and 3 + ! 3 - from layer 2 and 3 + ! 4 - from layer layers 3, 4 + ! 5 - from all the four layers + !-------------------------------------------------------------------------------------------------------------------------------------------------------------------- ! + ! SoilType: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 ! + !-------------------------------------------------------------------------------------------------------------------------------------------------------------------- ! + ! TDSMC_FAC: tile drainage soil moisture factor + TDSMC_FAC = 0.90, 0.90, 0.90, 0.90, 0.90, 1.25, 0.90, 1.0, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, 0.90, + ! TD_DEPTH: depth of drain tube from the soil surface + TD_DEPTH = 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + ! TD_DC: drainage coefficient (mm/d) + TD_DC = 20.0, 20.0, 20.0, 20.0, 20.0, 20.0, 20.0, 20.0, 20.0, 20.0, 20.0, 20.0, 20.0, 20.0, 20.0, 20.0, 20.0, 20.0, 20.0, + + !-------------------------------------! + ! For Hooghoudt tile drain model ! + !-------------------------------------! + !-------------------------------------------------------------------------------------------------------------------------------------------------------------------- ! + ! SoilType: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 ! + !-------------------------------------------------------------------------------------------------------------------------------------------------------------------- ! + ! TD_DCOEF: tile drainage coefficient (mm/d) + TD_DCOEF = 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, + ! TD_D: depth to impervious layer from drain water level [m] + TD_D = 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, 1.00, + ! TD_ADEPTH: actual depth of impervious layer from land surface [m] + TD_ADEPTH = 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, 2.00, + ! TD_RADI: effective radius of drain tubes [m] + TD_RADI = 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, 0.07, + ! TD_SPAC: distance between two drain tubes or tiles [m] + TD_SPAC = 60.0, 55.0, 45.0, 20.0, 25.0, 30.0, 40.0, 16.0, 18.0, 50.0, 15.0, 10.0, 35.0, 10.0, 60.0, 60.0, 10.0, 60.0, 60.0, + ! TD_DDRAIN: Depth of drain [m] + TD_DDRAIN = 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, 1.20, + ! KLAT_FAC: multiplication factor to lateral hydrological conductivity + KLAT_FAC = 1.30, 1.80, 2.10, 2.60, 2.90, 2.50, 2.30, 3.00, 2.70, 2.00, 3.10, 3.30, 2.50, 1.00, 1.00, 1.80, 4.00, 1.00, 1.30, +/ + +&noahmp_optional_parameters + !------------------------------------------------------------------------------ + ! Saxton and Rawls 2006 Pedo-transfer function coefficients + !------------------------------------------------------------------------------ + sr2006_theta_1500t_a = -0.024 ! sand coefficient + sr2006_theta_1500t_b = 0.487 ! clay coefficient + sr2006_theta_1500t_c = 0.006 ! orgm coefficient + sr2006_theta_1500t_d = 0.005 ! sand*orgm coefficient + sr2006_theta_1500t_e = -0.013 ! clay*orgm coefficient + sr2006_theta_1500t_f = 0.068 ! sand*clay coefficient + sr2006_theta_1500t_g = 0.031 ! constant adjustment + sr2006_theta_1500_a = 0.14 ! theta_1500t coefficient + sr2006_theta_1500_b = -0.02 ! constant adjustment + sr2006_theta_33t_a = -0.251 ! sand coefficient + sr2006_theta_33t_b = 0.195 ! clay coefficient + sr2006_theta_33t_c = 0.011 ! orgm coefficient + sr2006_theta_33t_d = 0.006 ! sand*orgm coefficient + sr2006_theta_33t_e = -0.027 ! clay*orgm coefficient + sr2006_theta_33t_f = 0.452 ! sand*clay coefficient + sr2006_theta_33t_g = 0.299 ! constant adjustment + sr2006_theta_33_a = 1.283 ! theta_33t*theta_33t coefficient + sr2006_theta_33_b = -0.374 ! theta_33t coefficient + sr2006_theta_33_c = -0.015 ! constant adjustment + sr2006_theta_s33t_a = 0.278 ! sand coefficient + sr2006_theta_s33t_b = 0.034 ! clay coefficient + sr2006_theta_s33t_c = 0.022 ! orgm coefficient + sr2006_theta_s33t_d = -0.018 ! sand*orgm coefficient + sr2006_theta_s33t_e = -0.027 ! clay*orgm coefficient + sr2006_theta_s33t_f = -0.584 ! sand*clay coefficient + sr2006_theta_s33t_g = 0.078 ! constant adjustment + sr2006_theta_s33_a = 0.636 ! theta_s33t coefficient + sr2006_theta_s33_b = -0.107 ! constant adjustment + sr2006_psi_et_a = -21.67 ! sand coefficient + sr2006_psi_et_b = -27.93 ! clay coefficient + sr2006_psi_et_c = -81.97 ! theta_s33 coefficient + sr2006_psi_et_d = 71.12 ! sand*theta_s33 coefficient + sr2006_psi_et_e = 8.29 ! clay*theta_s33 coefficient + sr2006_psi_et_f = 14.05 ! sand*clay coefficient + sr2006_psi_et_g = 27.16 ! constant adjustment + sr2006_psi_e_a = 0.02 ! psi_et*psi_et coefficient + sr2006_psi_e_b = -0.113 ! psi_et coefficient + sr2006_psi_e_c = -0.7 ! constant adjustment + sr2006_smcmax_a = -0.097 ! sand adjustment + sr2006_smcmax_b = 0.043 ! constant adjustment +/ + +&noahmp_general_parameters + !------------------------------------------------- + ! this part is originally from GENPARM.TBL + !------------------------------------------------- + SLOPE_DATA = 0.1, 0.6, 1.0, 0.35, 0.55, 0.8, 0.63, 0.0, 0.0 ! slope factor for soil drainage (9 different slope types) + CSOIL_DATA = 2.00E+6 ! Soil heat capacity [J m-3 K-1] + REFDK_DATA = 2.0E-6 ! Parameter in the surface runoff parameterization + REFKDT_DATA = 3.0 ! Parameter in the surface runoff parameterization + FRZK_DATA = 0.15 ! Frozen ground parameter + ZBOT_DATA = -8.0 ! Depth [m] of lower boundary soil temperature + CZIL_DATA = 0.1 ! Parameter used in the calculation of the roughness length for heat +/ + +&noahmp_stas_soil_categories + SLTYPE = "STAS" ! soil dataset: "STAS" or "STAS_RUC" + SLCATS = 19 ! num_soil_types +/ + +&noahmp_soil_stas_parameters + ! 19 total soil types considered by NoahMP + ! 1: SAND + ! 2: LOAMY SAND + ! 3: SANDY LOAM + ! 4: SILT LOAM + ! 5: SILT + ! 6: LOAM + ! 7: SANDY CLAY LOAM + ! 8: SILTY CLAY LOAM + ! 9: CLAY LOAM + ! 10: SANDY CLAY + ! 11: SILTY CLAY + ! 12: CLAY + ! 13: ORGANIC MATERIAL + ! 14: WATER + ! 15: BEDROCK + ! 16: OTHER(land-ice) + ! 17: PLAYA + ! 18: LAVA + ! 19: WHITE SAND + !----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- ! + ! SOIL TYPE: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 ! + !----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- ! + ! BB: soil B parameter + BB = 2.790, 4.260, 4.740, 5.330, 3.860, 5.250, 6.770, 8.720, 8.170, 10.730, 10.390, 11.550, 5.250, 0.000, 2.790, 4.260, 11.550, 2.790, 2.790 + ! DRYSMC: dry soil moisture threshold + DRYSMC = 0.010, 0.028, 0.047, 0.084, 0.061, 0.066, 0.069, 0.120, 0.103, 0.100, 0.126, 0.138, 0.066, 0.000, 0.006, 0.028, 0.030, 0.006, 0.010 + ! MAXSMC: saturated value of soil moisture (volumetric) + MAXSMC = 0.339, 0.421, 0.434, 0.476, 0.484, 0.439, 0.404, 0.464, 0.465, 0.406, 0.468, 0.468, 0.439, 1.000, 0.200, 0.421, 0.468, 0.200, 0.339 + ! REFSMC: reference soil moisture (field capacity) (volumetric) + REFSMC = 0.192, 0.283, 0.312, 0.360, 0.347, 0.329, 0.315, 0.387, 0.382, 0.338, 0.404, 0.412, 0.329, 0.000, 0.170, 0.283, 0.454, 0.170, 0.192 + ! SATPSI: saturated soil matric potential + SATPSI = 0.069, 0.036, 0.141, 0.759, 0.955, 0.355, 0.135, 0.617, 0.263, 0.098, 0.324, 0.468, 0.355, 0.000, 0.069, 0.036, 0.468, 0.069, 0.069 + ! SATDK: saturated soil hydraulic conductivity + SATDK = 4.66E-05, 1.41E-05, 5.23E-06, 2.81E-06, 2.18E-06, 3.38E-06, 4.45E-06, 2.03E-06, 2.45E-06, 7.22E-06, 1.34E-06, 9.74E-07, 3.38E-06, 0.00E+00, 1.41E-04, 1.41E-05, 9.74E-07, 1.41E-04, 4.66E-05 + ! SATDW: saturated soil hydraulic diffusivity + SATDW = 2.65E-05, 5.14E-06, 8.05E-06, 2.39E-05, 1.66E-05, 1.43E-05, 1.01E-05, 2.35E-05, 1.13E-05, 1.87E-05, 9.64E-06, 1.12E-05, 1.43E-05, 0.00E+00, 1.36E-04, 5.14E-06, 1.12E-05, 1.36E-04, 2.65E-05 + ! WLTSMC: wilting point soil moisture (volumetric) + WLTSMC = 0.010, 0.028, 0.047, 0.084, 0.061, 0.066, 0.069, 0.120, 0.103, 0.100, 0.126, 0.138, 0.066, 0.000, 0.006, 0.028, 0.030, 0.006, 0.010 + ! QTZ: soil quartz content + QTZ = 0.920, 0.820, 0.600, 0.250, 0.100, 0.400, 0.600, 0.100, 0.350, 0.520, 0.100, 0.250, 0.050, 0.600, 0.070, 0.250, 0.600, 0.520, 0.920 + ! BVIC: VIC model infiltration parameter for VIC runoff + BVIC = 0.050, 0.080, 0.090, 0.250, 0.150, 0.180, 0.200, 0.220, 0.230, 0.250, 0.280, 0.300, 0.260, 0.000, 1.000, 1.000, 1.000, 0.350, 0.150 + ! AXAJ: Tension water distribution inflection parameter for Xinanjiang runoff + AXAJ = 0.009, 0.010, 0.009, 0.010, 0.012, 0.013, 0.014, 0.015, 0.016, 0.015, 0.016, 0.017, 0.012, 0.001, 0.017, 0.017, 0.017, 0.015, 0.009 + ! BXAJ: Tension water distribution shape parameter for Xinanjiang runoff + BXAJ = 0.050, 0.080, 0.090, 0.250, 0.150, 0.180, 0.200, 0.220, 0.230, 0.250, 0.280, 0.300, 0.260, 0.000, 1.000, 1.000, 1.000, 0.350, 0.150 + ! XXAJ: Free water distribution shape parameter for Xinanjiang runoff + XXAJ = 0.050, 0.080, 0.090, 0.250, 0.150, 0.180, 0.200, 0.220, 0.230, 0.250, 0.280, 0.300, 0.260, 0.000, 1.000, 1.000, 1.000, 0.350, 0.150 + ! BDVIC: VIC model infiltration parameter for dynamic VIC runoff + BDVIC = 0.050, 0.080, 0.090, 0.250, 0.150, 0.180, 0.200, 0.220, 0.230, 0.250, 0.280, 0.300, 0.260, 0.000, 1.000, 1.000, 1.000, 0.350, 0.150 + ! BBVIC: heterogeniety parameter for infiltration for dynamic VIC runoff + BBVIC = 1.000, 1.010, 1.020, 1.025, 1.000, 1.000, 1.032, 1.035, 1.040, 1.042, 1.045, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000 + ! GDVIC: mean capilary drive (m) for dynamic VIC runoff + GDVIC = 0.050, 0.070, 0.130, 0.200, 0.170, 0.110, 0.260, 0.350, 0.260, 0.300, 0.380, 0.410, 0.500, 0.001, 0.010, 0.001, 0.001, 0.050, 0.020 +/ + +&noahmp_soil_stas_ruc_parameters + ! 19 total soil types considered by NoahMP + ! 1: SAND + ! 2: LOAMY SAND + ! 3: SANDY LOAM + ! 4: SILT LOAM + ! 5: SILT + ! 6: LOAM + ! 7: SANDY CLAY LOAM + ! 8: SILTY CLAY LOAM + ! 9: CLAY LOAM + ! 10: SANDY CLAY + ! 11: SILTY CLAY + ! 12: CLAY + ! 13: ORGANIC MATERIAL + ! 14: WATER + ! 15: BEDROCK + ! 16: OTHER(land-ice) + ! 17: PLAYA + ! 18: LAVA + ! 19: WHITE SAND + !----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- ! + ! SOIL TYPE: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 ! + !----------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- ! + ! BB: soil B parameter + BB = 4.050, 4.380, 4.900, 5.300, 5.300, 5.390, 7.120, 7.750, 5.390, 10.400, 10.400, 11.400, 5.390, 0.000, 4.050, 4.900, 11.400, 4.050, 4.050 + ! DRYSMC: dry soil moisture threshold + DRYSMC = 0.002, 0.035, 0.041, 0.034, 0.034, 0.050, 0.068, 0.060, 0.050, 0.070, 0.070, 0.068, 0.027, 0.000, 0.004, 0.065, 0.030, 0.006, 0.010 + ! HC: not used in current Noah-MP + HC = 1.470, 1.410, 1.340, 1.270, 1.270, 1.210, 1.180, 1.320, 1.210, 1.180, 1.150, 1.090, 1.210, 4.180, 2.030, 2.100, 1.410, 1.410, 1.470 + ! MAXSMC: saturated value of soil moisture (volumetric) + MAXSMC = 0.395, 0.410, 0.435, 0.485, 0.485, 0.451, 0.420, 0.477, 0.451, 0.426, 0.492, 0.482, 0.451, 1.000, 0.200, 0.435, 0.468, 0.200, 0.339 + ! REFSMC: reference soil moisture (field capacity) (volumetric) + REFSMC = 0.174, 0.179, 0.249, 0.369, 0.369, 0.314, 0.299, 0.357, 0.314, 0.316, 0.409, 0.400, 0.314, 1.000, 0.100, 0.249, 0.454, 0.170, 0.236 + ! SATPSI: saturated soil matric potential + SATPSI = 0.121, 0.090, 0.218, 0.786, 0.786, 0.478, 0.299, 0.356, 0.478, 0.153, 0.490, 0.405, 0.478, 0.000, 0.121, 0.218, 0.468, 0.069, 0.069 + ! SATDK: saturated soil hydraulic conductivity + SATDK = 1.76E-04, 1.56E-04, 3.47E-05, 7.20E-06, 7.20E-06, 6.95E-06, 6.30E-06, 1.70E-06, 6.95E-06, 2.17E-06, 1.03E-06, 1.28E-06, 6.95E-06, 0.00E+00, 1.41E-04, 3.47E-05, 9.74E-07, 1.41E-04, 1.76E-04 + ! SATDW: saturated soil hydraulic diffusivity + SATDW = 6.08E-07, 5.14E-06, 8.05E-06, 2.39E-05, 2.39E-05, 1.43E-05, 9.90E-06, 2.37E-05, 1.43E-05, 1.87E-05, 9.64E-06, 1.12E-05, 1.43E-05, 0.00E+00, 1.36E-04, 5.14E-06, 1.12E-05, 1.36E-04, 6.08E-07 + ! WLTSMC: wilting point soil moisture (volumetric) + WLTSMC = 0.033, 0.055, 0.095, 0.143, 0.143, 0.137, 0.148, 0.170, 0.137, 0.158, 0.190, 0.198, 0.117, 0.000, 0.006, 0.114, 0.030, 0.006, 0.060 + ! QTZ: soil quartz content + QTZ = 0.920, 0.820, 0.600, 0.250, 0.100, 0.400, 0.600, 0.100, 0.400, 0.520, 0.100, 0.250, 0.050, 0.000, 0.600, 0.050, 0.600, 0.520, 0.920 + ! BVIC: VIC model infiltration parameter for VIC runoff + BVIC = 0.050, 0.080, 0.090, 0.100, 0.150, 0.180, 0.200, 0.220, 0.230, 0.250, 0.280, 0.300, 0.260, 0.000, 1.000, 1.000, 1.000, 0.350, 0.150 + ! AXAJ: Tension water distribution inflection parameter for Xinanjiang runoff + AXAJ = 0.009, 0.010, 0.009, 0.010, 0.012, 0.013, 0.014, 0.015, 0.016, 0.015, 0.016, 0.017, 0.012, 0.001, 0.017, 0.017, 0.017, 0.015, 0.009 + ! BXAJ: Tension water distribution shape parameter for Xinanjiang runoff + BXAJ = 0.050, 0.080, 0.090, 0.250, 0.150, 0.180, 0.200, 0.220, 0.230, 0.250, 0.280, 0.300, 0.260, 0.000, 1.000, 1.000, 1.000, 0.350, 0.150 + ! XXAJ: Free water distribution shape parameter for Xinanjiang runoff + XXAJ = 0.050, 0.080, 0.090, 0.250, 0.150, 0.180, 0.200, 0.220, 0.230, 0.250, 0.280, 0.300, 0.260, 0.000, 1.000, 1.000, 1.000, 0.350, 0.150 + ! BDVIC: VIC model infiltration parameter for dynamic VIC runoff + BDVIC = 0.050, 0.080, 0.090, 0.100, 0.150, 0.180, 0.200, 0.220, 0.230, 0.250, 0.280, 0.300, 0.260, 0.000, 1.000, 1.000, 1.000, 0.350, 0.150 + ! BBVIC: heterogeniety parameter for infiltration for dynamic VIC runoff + BBVIC = 1.000, 1.010, 1.020, 1.025, 1.000, 1.000, 1.032, 1.035, 1.040, 1.042, 1.045, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000 + ! GDVIC: mean capilary drive (m) for dynamic VIC runoff + GDVIC = 0.050, 0.070, 0.130, 0.200, 0.170, 0.110, 0.260, 0.350, 0.260, 0.300, 0.380, 0.410, 0.500, 0.001, 0.010, 0.001, 0.001, 0.050, 0.020 +/ diff --git a/src/core_atmosphere/physics/physics_noahmp/src/AtmosForcingMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/AtmosForcingMod.F90 new file mode 100644 index 000000000..96a7105b1 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/AtmosForcingMod.F90 @@ -0,0 +1,182 @@ +module AtmosForcingMod + +!!! Process input atmospheric forcing variables + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine ProcessAtmosForcing(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: ATM +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local varibles + integer :: LoopInd ! loop index + integer, parameter :: LoopNum = 10 ! iterations for Twet calculation + real(kind=kind_noahmp) :: PrecipFrozenTot ! total frozen precipitation [mm/s] ! MB/AN : v3.7 + real(kind=kind_noahmp) :: RadDirFrac ! direct solar radiation fraction + real(kind=kind_noahmp) :: RadVisFrac ! visible band solar radiation fraction + real(kind=kind_noahmp) :: VapPresSat ! saturated vapor pressure of air + real(kind=kind_noahmp) :: LatHeatVap ! latent heat of vapor/sublimation + real(kind=kind_noahmp) :: PsychConst ! (cp*p)/(eps*L), psychrometric coefficient + real(kind=kind_noahmp) :: TemperatureDegC ! air temperature [C] + real(kind=kind_noahmp) :: TemperatureWetBulb ! wetbulb temperature + +! ------------------------------------------------------------------------ + associate( & + CosSolarZenithAngle => noahmp%config%domain%CosSolarZenithAngle ,& ! in, cosine solar zenith angle [0-1] + OptRainSnowPartition => noahmp%config%nmlist%OptRainSnowPartition ,& ! in, rain-snow partition physics option + PressureAirRefHeight => noahmp%forcing%PressureAirRefHeight ,& ! in, air pressure [Pa] at reference height + TemperatureAirRefHeight => noahmp%forcing%TemperatureAirRefHeight ,& ! in, air temperature [K] at reference height + SpecHumidityRefHeight => noahmp%forcing%SpecHumidityRefHeight ,& ! in, specific humidity [kg/kg] forcing at reference height + PrecipConvRefHeight => noahmp%forcing%PrecipConvRefHeight ,& ! in, convective precipitation rate [mm/s] at reference height + PrecipNonConvRefHeight => noahmp%forcing%PrecipNonConvRefHeight ,& ! in, non-convective precipitation rate [mm/s] at reference height + PrecipShConvRefHeight => noahmp%forcing%PrecipShConvRefHeight ,& ! in, shallow convective precipitation rate [mm/s] at reference height + PrecipSnowRefHeight => noahmp%forcing%PrecipSnowRefHeight ,& ! in, snowfall rate [mm/s] at reference height + PrecipGraupelRefHeight => noahmp%forcing%PrecipGraupelRefHeight ,& ! in, graupel rate [mm/s] at reference height + PrecipHailRefHeight => noahmp%forcing%PrecipHailRefHeight ,& ! in, hail rate [mm/s] at reference height + RadSwDownRefHeight => noahmp%forcing%RadSwDownRefHeight ,& ! in, downward shortwave radiation [W/m2] at reference height + WindEastwardRefHeight => noahmp%forcing%WindEastwardRefHeight ,& ! in, wind speed [m/s] in eastward direction at reference height + WindNorthwardRefHeight => noahmp%forcing%WindNorthwardRefHeight ,& ! in, wind speed [m/s] in northward direction at reference height + SnowfallDensityMax => noahmp%water%param%SnowfallDensityMax ,& ! in, maximum fresh snowfall density [kg/m3] + TemperaturePotRefHeight => noahmp%energy%state%TemperaturePotRefHeight ,& ! out, surface potential temperature [K] + PressureVaporRefHeight => noahmp%energy%state%PressureVaporRefHeight ,& ! out, vapor pressure air [Pa] at reference height + DensityAirRefHeight => noahmp%energy%state%DensityAirRefHeight ,& ! out, density air [kg/m3] + WindSpdRefHeight => noahmp%energy%state%WindSpdRefHeight ,& ! out, wind speed [m/s] at reference height + RadSwDownDir => noahmp%energy%flux%RadSwDownDir ,& ! out, incoming direct solar radiation [W/m2] + RadSwDownDif => noahmp%energy%flux%RadSwDownDif ,& ! out, incoming diffuse solar radiation [W/m2] + RainfallRefHeight => noahmp%water%flux%RainfallRefHeight ,& ! out, rainfall [mm/s] at reference height + SnowfallRefHeight => noahmp%water%flux%SnowfallRefHeight ,& ! out, liquid equivalent snowfall [mm/s] at reference height + PrecipTotRefHeight => noahmp%water%flux%PrecipTotRefHeight ,& ! out, total precipitation [mm/s] at reference height + PrecipConvTotRefHeight => noahmp%water%flux%PrecipConvTotRefHeight ,& ! out, total convective precipitation [mm/s] at reference height + PrecipLargeSclRefHeight => noahmp%water%flux%PrecipLargeSclRefHeight ,& ! out, large-scale precipitation [mm/s] at reference height + PrecipAreaFrac => noahmp%water%state%PrecipAreaFrac ,& ! out, fraction of area receiving precipitation + FrozenPrecipFrac => noahmp%water%state%FrozenPrecipFrac ,& ! out, frozen precipitation fraction + SnowfallDensity => noahmp%water%state%SnowfallDensity & ! out, bulk density of snowfall [kg/m3] + ) +! ------------------------------------------------------------------------ + + ! surface air variables + TemperaturePotRefHeight = TemperatureAirRefHeight * & + (PressureAirRefHeight / PressureAirRefHeight) ** (ConstGasDryAir / ConstHeatCapacAir) + PressureVaporRefHeight = SpecHumidityRefHeight * PressureAirRefHeight / (0.622 + 0.378*SpecHumidityRefHeight) + DensityAirRefHeight = (PressureAirRefHeight - 0.378*PressureVaporRefHeight) / & + (ConstGasDryAir * TemperatureAirRefHeight) + + ! downward solar radiation + RadDirFrac = 0.7 + RadVisFrac = 0.5 + if ( CosSolarZenithAngle <= 0.0 ) RadSwDownRefHeight = 0.0 ! filter by solar zenith angle + RadSwDownDir(1) = RadSwDownRefHeight * RadDirFrac * RadVisFrac ! direct vis + RadSwDownDir(2) = RadSwDownRefHeight * RadDirFrac * (1.0-RadVisFrac) ! direct nir + RadSwDownDif(1) = RadSwDownRefHeight * (1.0-RadDirFrac) * RadVisFrac ! diffuse vis + RadSwDownDif(2) = RadSwDownRefHeight * (1.0-RadDirFrac) * (1.0-RadVisFrac) ! diffuse nir + + ! precipitation + PrecipTotRefHeight = PrecipConvRefHeight + PrecipNonConvRefHeight + PrecipShConvRefHeight + if ( OptRainSnowPartition == 4 ) then + PrecipConvTotRefHeight = PrecipConvRefHeight + PrecipShConvRefHeight + PrecipLargeSclRefHeight = PrecipNonConvRefHeight + else + PrecipConvTotRefHeight = 0.10 * PrecipTotRefHeight + PrecipLargeSclRefHeight = 0.90 * PrecipTotRefHeight + endif + + ! fractional area that receives precipitation (see, Niu et al. 2005) + PrecipAreaFrac = 0.0 + if ( (PrecipConvTotRefHeight+PrecipLargeSclRefHeight) > 0.0 ) then + PrecipAreaFrac = (PrecipConvTotRefHeight + PrecipLargeSclRefHeight) / & + (10.0*PrecipConvTotRefHeight + PrecipLargeSclRefHeight) + endif + + ! partition precipitation into rain and snow. Moved from CANWAT MB/AN: v3.7 + ! Jordan (1991) + if ( OptRainSnowPartition == 1 ) then + if ( TemperatureAirRefHeight > (ConstFreezePoint+2.5) ) then + FrozenPrecipFrac = 0.0 + else + if ( TemperatureAirRefHeight <= (ConstFreezePoint+0.5) ) then + FrozenPrecipFrac = 1.0 + elseif ( TemperatureAirRefHeight <= (ConstFreezePoint+2.0) ) then + FrozenPrecipFrac = 1.0 - (-54.632 + 0.2*TemperatureAirRefHeight) + else + FrozenPrecipFrac = 0.6 + endif + endif + endif + + ! BATS scheme + if ( OptRainSnowPartition == 2 ) then + if ( TemperatureAirRefHeight >= (ConstFreezePoint+2.2) ) then + FrozenPrecipFrac = 0.0 + else + FrozenPrecipFrac = 1.0 + endif + endif + + ! Simple temperature scheme + if ( OptRainSnowPartition == 3 ) then + if ( TemperatureAirRefHeight >= ConstFreezePoint ) then + FrozenPrecipFrac = 0.0 + else + FrozenPrecipFrac = 1.0 + endif + endif + + ! Use WRF microphysics output + ! Hedstrom NR and JW Pomeroy (1998), Hydrol. Processes, 12, 1611-1625 + SnowfallDensity = min( SnowfallDensityMax, 67.92+51.25*exp((TemperatureAirRefHeight-ConstFreezePoint)/2.59) ) ! fresh snow density !MB/AN: change to MIN + if ( OptRainSnowPartition == 4 ) then + PrecipFrozenTot = PrecipSnowRefHeight + PrecipGraupelRefHeight + PrecipHailRefHeight + if ( (PrecipNonConvRefHeight > 0.0) .and. (PrecipFrozenTot > 0.0) ) then + FrozenPrecipFrac = min( 1.0, PrecipFrozenTot/PrecipNonConvRefHeight ) + FrozenPrecipFrac = max( 0.0, FrozenPrecipFrac ) + SnowfallDensity = SnowfallDensity * (PrecipSnowRefHeight/PrecipFrozenTot) + & + ConstDensityGraupel * (PrecipGraupelRefHeight/PrecipFrozenTot) + & + ConstDensityHail * (PrecipHailRefHeight/PrecipFrozenTot) + else + FrozenPrecipFrac = 0.0 + endif + endif + + ! wet-bulb scheme (Wang et al., 2019 GRL), C.He, 12/18/2020 + if ( OptRainSnowPartition == 5 ) then + TemperatureDegC = min( 50.0, max(-50.0,(TemperatureAirRefHeight-ConstFreezePoint)) ) ! Kelvin to degree Celsius with limit -50 to +50 + if ( TemperatureAirRefHeight > ConstFreezePoint ) then + LatHeatVap = ConstLatHeatEvap + else + LatHeatVap = ConstLatHeatSublim + endif + PsychConst = ConstHeatCapacAir * PressureAirRefHeight / (0.622 * LatHeatVap) + TemperatureWetBulb = TemperatureDegC - 5.0 ! first guess wetbulb temperature + do LoopInd = 1, LoopNum + VapPresSat = 610.8 * exp( (17.27*TemperatureWetBulb) / (237.3+TemperatureWetBulb) ) + TemperatureWetBulb = TemperatureWetBulb - (VapPresSat - PressureVaporRefHeight) / PsychConst ! Wang et al., 2019 GRL Eq.2 + enddo + FrozenPrecipFrac = 1.0 / (1.0 + 6.99e-5 * exp(2.0*(TemperatureWetBulb+3.97))) ! Wang et al., 2019 GRL Eq. 1 + endif + + ! rain-snow partitioning + RainfallRefHeight = PrecipTotRefHeight * (1.0 - FrozenPrecipFrac) + SnowfallRefHeight = PrecipTotRefHeight * FrozenPrecipFrac + + ! wind speed at reference height for turbulence calculation + WindSpdRefHeight = max(sqrt(WindEastwardRefHeight**2.0 + WindNorthwardRefHeight**2.0), 1.0) + + end associate + + end subroutine ProcessAtmosForcing + +end module AtmosForcingMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/BalanceErrorCheckGlacierMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/BalanceErrorCheckGlacierMod.F90 new file mode 100644 index 000000000..7b5e83913 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/BalanceErrorCheckGlacierMod.F90 @@ -0,0 +1,163 @@ +module BalanceErrorCheckGlacierMod + +!!! Check glacier water and energy balance and report error + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + +!!!! Water balance check initialization + subroutine BalanceWaterInitGlacier(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: None (embedded in NOAHMP_GLACIER) +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! -------------------------------------------------------------------- + associate( & + SnowWaterEquiv => noahmp%water%state%SnowWaterEquiv ,& ! in, snow water equivalent [mm] + WaterStorageTotBeg => noahmp%water%state%WaterStorageTotBeg & ! out, total water storage [mm] at the beginning + ) +! ---------------------------------------------------------------------- + + ! compute total glacier water storage before NoahMP processes + ! need more work on including glacier ice mass underneath snow + WaterStorageTotBeg = SnowWaterEquiv + + end associate + + end subroutine BalanceWaterInitGlacier + + +!!!! Water balance check and report error + subroutine BalanceWaterCheckGlacier(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: ERROR_GLACIER +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! -------------------------------------------------------------------- + associate( & + GridIndexI => noahmp%config%domain%GridIndexI ,& ! in, grid index in x-direction + GridIndexJ => noahmp%config%domain%GridIndexJ ,& ! in, grid index in y-direction + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, main noahmp timestep [s] + SnowWaterEquiv => noahmp%water%state%SnowWaterEquiv ,& ! in, snow water equivalent [mm] + WaterStorageTotBeg => noahmp%water%state%WaterStorageTotBeg ,& ! in, total water storage [mm] at the beginning + PrecipTotRefHeight => noahmp%water%flux%PrecipTotRefHeight ,& ! in, total precipitation [mm/s] at reference height + EvapGroundNet => noahmp%water%flux%EvapGroundNet ,& ! in, net ground evaporation [mm/s] + RunoffSurface => noahmp%water%flux%RunoffSurface ,& ! in, surface runoff [mm/s] + RunoffSubsurface => noahmp%water%flux%RunoffSubsurface ,& ! in, subsurface runoff [mm/s] + WaterStorageTotEnd => noahmp%water%state%WaterStorageTotEnd ,& ! out, total water storage [mm] at the end + WaterBalanceError => noahmp%water%state%WaterBalanceError & ! out, water balance error [mm] per time step + ) +! ---------------------------------------------------------------------- + + ! Error in water balance should be < 0.1 mm + ! compute total glacier water storage before NoahMP processes + ! need more work on including glacier ice mass underneath snow + WaterStorageTotEnd = SnowWaterEquiv + WaterBalanceError = WaterStorageTotEnd - WaterStorageTotBeg - & + (PrecipTotRefHeight - EvapGroundNet - RunoffSurface - RunoffSubsurface) * MainTimeStep + +#ifndef WRF_HYDRO + if ( abs(WaterBalanceError) > 0.1 ) then + if ( WaterBalanceError > 0) then + write(*,*) "The model is gaining water (WaterBalanceError is positive)" + else + write(*,*) "The model is losing water (WaterBalanceError is negative)" + endif + write(*,*) "WaterBalanceError = ",WaterBalanceError, "kg m{-2} timestep{-1}" + write(*, & + '(" GridIndexI GridIndexJ WaterStorageTotEnd WaterStorageTotBeg PrecipTotRefHeight & + EvapGroundNet RunoffSurface RunoffSubsurface")') + write(*,'(i6,1x,i6,1x,2f15.3,9f11.5)') GridIndexI, GridIndexJ, WaterStorageTotEnd, WaterStorageTotBeg, & + PrecipTotRefHeight*MainTimeStep, EvapGroundNet*MainTimeStep, & + RunoffSurface*MainTimeStep, RunoffSubsurface*MainTimeStep + stop "Error: Water budget problem in NoahMP LSM" + endif +#endif + + end associate + + end subroutine BalanceWaterCheckGlacier + + +!!!! Energy balance check and error report + subroutine BalanceEnergyCheckGlacier(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: ERROR_GLACIER +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! -------------------------------------------------------------------- + associate( & + GridIndexI => noahmp%config%domain%GridIndexI ,& ! in, grid index in x-direction + GridIndexJ => noahmp%config%domain%GridIndexJ ,& ! in, grid index in y-direction + RadSwDownRefHeight => noahmp%forcing%RadSwDownRefHeight ,& ! in, downward shortwave radiation [W/m2] at reference height + RadSwAbsSfc => noahmp%energy%flux%RadSwAbsSfc ,& ! in, total absorbed solar radiation [W/m2] + RadSwReflSfc => noahmp%energy%flux%RadSwReflSfc ,& ! in, total reflected solar radiation [W/m2] + RadLwNetSfc => noahmp%energy%flux%RadLwNetSfc ,& ! in, total net longwave rad [W/m2] (+ to atm) + HeatSensibleSfc => noahmp%energy%flux%HeatSensibleSfc ,& ! in, total sensible heat [W/m2] (+ to atm) + HeatLatentGrd => noahmp%energy%flux%HeatLatentGrd ,& ! in, total ground latent heat [W/m2] (+ to atm) + HeatGroundTot => noahmp%energy%flux%HeatGroundTot ,& ! in, total ground heat flux [W/m2] (+ to soil/snow) + RadSwAbsGrd => noahmp%energy%flux%RadSwAbsGrd ,& ! in, solar radiation absorbed by ground [W/m2] + HeatPrecipAdvSfc => noahmp%energy%flux%HeatPrecipAdvSfc ,& ! in, precipitation advected heat - total [W/m2] + EnergyBalanceError => noahmp%energy%state%EnergyBalanceError ,& ! out, error in surface energy balance [W/m2] + RadSwBalanceError => noahmp%energy%state%RadSwBalanceError & ! out, error in shortwave radiation balance [W/m2] + ) +! ---------------------------------------------------------------------- + + ! error in shortwave radiation balance should be <0.01 W/m2 + RadSwBalanceError = RadSwDownRefHeight - (RadSwAbsSfc + RadSwReflSfc) + ! print out diagnostics when error is large + if ( abs(RadSwBalanceError) > 0.01 ) then + write(*,*) "GridIndexI, GridIndexJ = ", GridIndexI, GridIndexJ + write(*,*) "RadSwBalanceError = ", RadSwBalanceError + write(*,*) "RadSwDownRefHeight = ", RadSwDownRefHeight + write(*,*) "RadSwReflSfc = ", RadSwReflSfc + write(*,*) "RadSwAbsGrd = ", RadSwAbsGrd + write(*,*) "RadSwAbsSfc = ", RadSwAbsSfc + stop "Error: Solar radiation budget problem in NoahMP LSM" + endif + + ! error in surface energy balance should be <0.01 W/m2 + EnergyBalanceError = RadSwAbsGrd + HeatPrecipAdvSfc - (RadLwNetSfc + HeatSensibleSfc + HeatLatentGrd + HeatGroundTot) + ! print out diagnostics when error is large + if ( abs(EnergyBalanceError) > 0.01 ) then + write(*,*) 'EnergyBalanceError = ', EnergyBalanceError, ' at GridIndexI,GridIndexJ: ', GridIndexI, GridIndexJ + write(*,'(a17,F10.4)' ) "Net longwave: ", RadLwNetSfc + write(*,'(a17,F10.4)' ) "Total sensible: ", HeatSensibleSfc + write(*,'(a17,F10.4)' ) "Ground evap: ", HeatLatentGrd + write(*,'(a17,F10.4)' ) "Total ground: ", HeatGroundTot + write(*,'(a17,4F10.4)') "Precip advected: ", HeatPrecipAdvSfc + write(*,'(a17,F10.4)' ) "absorbed shortwave: ", RadSwAbsGrd + stop "Error: Surface energy budget problem in NoahMP LSM" + endif + + end associate + + end subroutine BalanceEnergyCheckGlacier + +end module BalanceErrorCheckGlacierMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/BalanceErrorCheckMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/BalanceErrorCheckMod.F90 new file mode 100644 index 000000000..f076e2a5e --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/BalanceErrorCheckMod.F90 @@ -0,0 +1,255 @@ +module BalanceErrorCheckMod + +!!! Check water and energy balance and report error + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + +!!!! Water balance check initialization + subroutine BalanceWaterInit(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: None (embedded in NOAHMP_SFLX) +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: LoopInd ! loop index + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + SurfaceType => noahmp%config%domain%SurfaceType ,& ! in, surface type 1-soil; 2-lake + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! in, thickness of snow/soil layers [m] + CanopyLiqWater => noahmp%water%state%CanopyLiqWater ,& ! in, canopy intercepted liquid water [mm] + CanopyIce => noahmp%water%state%CanopyIce ,& ! in, canopy intercepted ice [mm] + SnowWaterEquiv => noahmp%water%state%SnowWaterEquiv ,& ! in, snow water equivalent [mm] + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! in, total soil moisture [m3/m3] + WaterStorageAquifer => noahmp%water%state%WaterStorageAquifer ,& ! in, water storage in aquifer [mm] + WaterStorageTotBeg => noahmp%water%state%WaterStorageTotBeg & ! out, total water storage [mm] at the beginning + ) +! ---------------------------------------------------------------------- + + ! compute total water storage before NoahMP processes + if ( SurfaceType == 1 ) then ! soil + WaterStorageTotBeg = CanopyLiqWater + CanopyIce + SnowWaterEquiv + WaterStorageAquifer + do LoopInd = 1, NumSoilLayer + WaterStorageTotBeg = WaterStorageTotBeg + SoilMoisture(LoopInd) * ThicknessSnowSoilLayer(LoopInd) * 1000.0 + enddo + endif + + end associate + + end subroutine BalanceWaterInit + + +!!!! Water balance check and report error + subroutine BalanceWaterCheck(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: ERROR +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: LoopInd ! loop index + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + SurfaceType => noahmp%config%domain%SurfaceType ,& ! in, surface type 1-soil; 2-lake + GridIndexI => noahmp%config%domain%GridIndexI ,& ! in, grid index in x-direction + GridIndexJ => noahmp%config%domain%GridIndexJ ,& ! in, grid index in y-direction + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! in, thickness of snow/soil layers [m] + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, main noahmp timestep [s] + FlagCropland => noahmp%config%domain%FlagCropland ,& ! in, flag to identify croplands + FlagSoilProcess => noahmp%config%domain%FlagSoilProcess ,& ! in, flag to calculate soil process + IrriFracThreshold => noahmp%water%param%IrriFracThreshold ,& ! in, irrigation fraction parameter + IrrigationFracGrid => noahmp%water%state%IrrigationFracGrid ,& ! in, total input irrigation fraction + WaterTableDepth => noahmp%water%state%WaterTableDepth ,& ! in, water table depth [m] + CanopyLiqWater => noahmp%water%state%CanopyLiqWater ,& ! in, canopy intercepted liquid water [mm] + CanopyIce => noahmp%water%state%CanopyIce ,& ! in, canopy intercepted ice [mm] + SnowWaterEquiv => noahmp%water%state%SnowWaterEquiv ,& ! in, snow water equivalent [mm] + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! in, total soil moisture [m3/m3] + WaterStorageAquifer => noahmp%water%state%WaterStorageAquifer ,& ! in, water storage in aquifer [mm] + WaterStorageTotBeg => noahmp%water%state%WaterStorageTotBeg ,& ! in, total water storage [mm] at the beginning + PrecipTotRefHeight => noahmp%water%flux%PrecipTotRefHeight ,& ! in, total precipitation [mm/s] at reference height + EvapCanopyNet => noahmp%water%flux%EvapCanopyNet ,& ! in, evaporation of intercepted water [mm/s] + Transpiration => noahmp%water%flux%Transpiration ,& ! in, transpiration rate [mm/s] + EvapGroundNet => noahmp%water%flux%EvapGroundNet ,& ! in, net ground (soil/snow) evaporation [mm/s] + RunoffSurface => noahmp%water%flux%RunoffSurface ,& ! in, surface runoff [mm/dt_soil] per soil timestep + RunoffSubsurface => noahmp%water%flux%RunoffSubsurface ,& ! in, subsurface runoff [mm/dt_soil] per soil timestep + TileDrain => noahmp%water%flux%TileDrain ,& ! in, tile drainage [mm/dt_soil] per soil timestep + IrrigationRateSprinkler => noahmp%water%flux%IrrigationRateSprinkler ,& ! in, rate of irrigation by sprinkler [m/timestep] + IrrigationRateMicro => noahmp%water%flux%IrrigationRateMicro ,& ! in, micro irrigation water rate [m/timestep] + IrrigationRateFlood => noahmp%water%flux%IrrigationRateFlood ,& ! in, flood irrigation water rate [m/timestep] + SfcWaterTotChgAcc => noahmp%water%flux%SfcWaterTotChgAcc ,& ! inout, accumulated snow,soil,canopy water change per soil timestep [mm] + PrecipTotAcc => noahmp%water%flux%PrecipTotAcc ,& ! inout, accumulated precipitation per soil timestep [mm] + EvapCanopyNetAcc => noahmp%water%flux%EvapCanopyNetAcc ,& ! inout, accumulated net canopy evaporation per soil timestep [mm] + TranspirationAcc => noahmp%water%flux%TranspirationAcc ,& ! inout, accumulated transpiration per soil timestep [mm] + EvapGroundNetAcc => noahmp%water%flux%EvapGroundNetAcc ,& ! inout, accumulated net ground evaporation per soil timestep [mm] + WaterStorageTotEnd => noahmp%water%state%WaterStorageTotEnd ,& ! out, total water storage [mm] at the end + WaterBalanceError => noahmp%water%state%WaterBalanceError & ! out, water balance error [mm] per time step + ) +! ---------------------------------------------------------------------- + + ! before water balance check, add irrigation water to precipitation + if ( (FlagCropland .eqv. .true.) .and. (IrrigationFracGrid >= IrriFracThreshold) ) then + PrecipTotRefHeight = PrecipTotRefHeight + IrrigationRateSprinkler * 1000.0 / MainTimeStep ! irrigation + endif + + ! only water balance check for every soil timestep + ! Error in water balance should be < 0.1 mm + if ( SurfaceType == 1 ) then ! soil + WaterStorageTotEnd = CanopyLiqWater + CanopyIce + SnowWaterEquiv + WaterStorageAquifer + do LoopInd = 1, NumSoilLayer + WaterStorageTotEnd = WaterStorageTotEnd + SoilMoisture(LoopInd) * ThicknessSnowSoilLayer(LoopInd) * 1000.0 + enddo + ! accumualted water change (only for canopy and snow during non-soil timestep) + SfcWaterTotChgAcc = SfcWaterTotChgAcc + (WaterStorageTotEnd - WaterStorageTotBeg) ! snow, canopy, and soil water change + PrecipTotAcc = PrecipTotAcc + PrecipTotRefHeight * MainTimeStep ! accumulated precip + EvapCanopyNetAcc = EvapCanopyNetAcc + EvapCanopyNet * MainTimeStep ! accumulated canopy evapo + TranspirationAcc = TranspirationAcc + Transpiration * MainTimeStep ! accumulated transpiration + EvapGroundNetAcc = EvapGroundNetAcc + EvapGroundNet * MainTimeStep ! accumulated soil evapo + + ! check water balance at soil timestep + if ( FlagSoilProcess .eqv. .true. ) then + WaterBalanceError = SfcWaterTotChgAcc - (PrecipTotAcc + IrrigationRateMicro*1000.0 + IrrigationRateFlood*1000.0 - & + EvapCanopyNetAcc - TranspirationAcc - EvapGroundNetAcc - RunoffSurface - RunoffSubsurface - & + TileDrain) +#ifndef WRF_HYDRO + if ( abs(WaterBalanceError) > 0.1 ) then + if ( WaterBalanceError > 0 ) then + write(*,*) "The model is gaining water (WaterBalanceError is positive)" + else + write(*,*) "The model is losing water (WaterBalanceError is negative)" + endif + write(*,*) 'WaterBalanceError = ',WaterBalanceError, "kg m{-2} timestep{-1}" + write(*, & + '(" GridIndexI GridIndexJ SfcWaterTotChgAcc PrecipTotRefHeightAcc IrrigationRateMicro & + IrrigationRateFlood EvapCanopyNetAcc EvapGroundNetAcc TranspirationAcc RunoffSurface & + RunoffSubsurface WaterTableDepth TileDrain")') + write(*,'(i6,i6,f10.3,10f10.5)') GridIndexI, GridIndexJ, SfcWaterTotChgAcc, PrecipTotAcc, & + IrrigationRateMicro*1000.0, IrrigationRateFlood*1000.0, & + EvapCanopyNetAcc, EvapGroundNetAcc, TranspirationAcc, RunoffSurface, & + RunoffSubsurface, WaterTableDepth, TileDrain + stop "Error: Water budget problem in NoahMP LSM" + endif +#endif + endif ! FlagSoilProcess + + else ! water point + WaterBalanceError = 0.0 + endif + + end associate + + end subroutine BalanceWaterCheck + + +!!!! Energy balance check and error report + subroutine BalanceEnergyCheck(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: ERROR +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! -------------------------------------------------------------------- + associate( & + GridIndexI => noahmp%config%domain%GridIndexI ,& ! in, grid index in x-direction + GridIndexJ => noahmp%config%domain%GridIndexJ ,& ! in, grid index in y-direction + RadSwDownRefHeight => noahmp%forcing%RadSwDownRefHeight ,& ! in, downward shortwave radiation [W/m2] at reference height + VegFrac => noahmp%energy%state%VegFrac ,& ! in, greeness vegetation fraction + RadSwAbsSfc => noahmp%energy%flux%RadSwAbsSfc ,& ! in, total absorbed solar radiation [W/m2] + RadSwReflSfc => noahmp%energy%flux%RadSwReflSfc ,& ! in, total reflected solar radiation [W/m2] + RadSwReflVeg => noahmp%energy%flux%RadSwReflVeg ,& ! in, reflected solar radiation by vegetation [W/m2] + RadSwReflGrd => noahmp%energy%flux%RadSwReflGrd ,& ! in, reflected solar radiation by ground [W/m2] + RadLwNetSfc => noahmp%energy%flux%RadLwNetSfc ,& ! in, total net longwave rad [W/m2] (+ to atm) + HeatSensibleSfc => noahmp%energy%flux%HeatSensibleSfc ,& ! in, total sensible heat [W/m2] (+ to atm) + HeatLatentCanopy => noahmp%energy%flux%HeatLatentCanopy ,& ! in, canopy latent heat flux [W/m2] (+ to atm) + HeatLatentGrd => noahmp%energy%flux%HeatLatentGrd ,& ! in, total ground latent heat [W/m2] (+ to atm) + HeatLatentTransp => noahmp%energy%flux%HeatLatentTransp ,& ! in, latent heat flux from transpiration [W/m2] (+ to atm) + HeatGroundTot => noahmp%energy%flux%HeatGroundTot ,& ! in, total ground heat flux [W/m2] (+ to soil/snow) + RadSwAbsVeg => noahmp%energy%flux%RadSwAbsVeg ,& ! in, solar radiation absorbed by vegetation [W/m2] + RadSwAbsGrd => noahmp%energy%flux%RadSwAbsGrd ,& ! in, solar radiation absorbed by ground [W/m2] + HeatPrecipAdvSfc => noahmp%energy%flux%HeatPrecipAdvSfc ,& ! in, precipitation advected heat - total [W/m2] + HeatPrecipAdvBareGrd => noahmp%energy%flux%HeatPrecipAdvBareGrd ,& ! in, precipitation advected heat - bare ground net [W/m2] + HeatPrecipAdvVegGrd => noahmp%energy%flux%HeatPrecipAdvVegGrd ,& ! in, precipitation advected heat - under canopy net [W/m2] + HeatPrecipAdvCanopy => noahmp%energy%flux%HeatPrecipAdvCanopy ,& ! in, precipitation advected heat - vegetation net [W/m2] + HeatLatentIrriEvap => noahmp%energy%flux%HeatLatentIrriEvap ,& ! in, latent heating due to sprinkler evaporation [W/m2] + HeatCanStorageChg => noahmp%energy%flux%HeatCanStorageChg ,& ! in, canopy heat storage change [W/m2] + EnergyBalanceError => noahmp%energy%state%EnergyBalanceError ,& ! out, error in surface energy balance [W/m2] + RadSwBalanceError => noahmp%energy%state%RadSwBalanceError & ! out, error in shortwave radiation balance [W/m2] + ) +! ---------------------------------------------------------------------- + + ! error in shortwave radiation balance should be <0.01 W/m2 + RadSwBalanceError = RadSwDownRefHeight - (RadSwAbsSfc + RadSwReflSfc) + ! print out diagnostics when error is large + if ( abs(RadSwBalanceError) > 0.01 ) then + write(*,*) "GridIndexI, GridIndexJ = ", GridIndexI, GridIndexJ + write(*,*) "RadSwBalanceError = ", RadSwBalanceError + write(*,*) "VEGETATION ---------" + write(*,*) "RadSwDownRefHeight * VegFrac = ", RadSwDownRefHeight*VegFrac + write(*,*) "VegFrac*RadSwAbsVeg + RadSwAbsGrd = ", VegFrac*RadSwAbsVeg+RadSwAbsGrd + write(*,*) "VegFrac*RadSwReflVeg + RadSwReflGrd = ", VegFrac*RadSwReflVeg+RadSwReflGrd + write(*,*) "GROUND -------" + write(*,*) "(1 - VegFrac) * RadSwDownRefHeight = ", (1.0-VegFrac)*RadSwDownRefHeight + write(*,*) "(1 - VegFrac) * RadSwAbsGrd = ", (1.0-VegFrac)*RadSwAbsGrd + write(*,*) "(1 - VegFrac) * RadSwReflGrd = ", (1.0-VegFrac)*RadSwReflGrd + write(*,*) "RadSwReflVeg = ", RadSwReflVeg + write(*,*) "RadSwReflGrd = ", RadSwReflGrd + write(*,*) "RadSwReflSfc = ", RadSwReflSfc + write(*,*) "RadSwAbsVeg = ", RadSwAbsVeg + write(*,*) "RadSwAbsGrd = ", RadSwAbsGrd + write(*,*) "RadSwAbsSfc = ", RadSwAbsSfc + stop "Error: Solar radiation budget problem in NoahMP LSM" + endif + + ! error in surface energy balance should be <0.01 W/m2 + EnergyBalanceError = RadSwAbsVeg + RadSwAbsGrd + HeatPrecipAdvSfc - & + (RadLwNetSfc + HeatSensibleSfc + HeatLatentCanopy + HeatLatentGrd + & + HeatLatentTransp + HeatGroundTot + HeatLatentIrriEvap + HeatCanStorageChg) + ! print out diagnostics when error is large + if ( abs(EnergyBalanceError) > 0.01 ) then + write(*,*) 'EnergyBalanceError = ', EnergyBalanceError, ' at GridIndexI,GridIndexJ: ', GridIndexI, GridIndexJ + write(*,'(a17,F10.4)' ) "Net solar: ", RadSwAbsSfc + write(*,'(a17,F10.4)' ) "Net longwave: ", RadLwNetSfc + write(*,'(a17,F10.4)' ) "Total sensible: ", HeatSensibleSfc + write(*,'(a17,F10.4)' ) "Canopy evap: ", HeatLatentCanopy + write(*,'(a17,F10.4)' ) "Ground evap: ", HeatLatentGrd + write(*,'(a17,F10.4)' ) "Transpiration: ", HeatLatentTransp + write(*,'(a17,F10.4)' ) "Total ground: ", HeatGroundTot + write(*,'(a17,F10.4)' ) "Sprinkler: ", HeatLatentIrriEvap + write(*,'(a17,F10.4)' ) "Canopy heat storage change: ", HeatCanStorageChg + write(*,'(a17,4F10.4)') "Precip advected: ", HeatPrecipAdvSfc,HeatPrecipAdvCanopy,HeatPrecipAdvVegGrd,HeatPrecipAdvBareGrd + write(*,'(a17,F10.4)' ) "Veg fraction: ", VegFrac + stop "Error: Energy budget problem in NoahMP LSM" + endif + + end associate + + end subroutine BalanceEnergyCheck + +end module BalanceErrorCheckMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/BiochemCropMainMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/BiochemCropMainMod.F90 new file mode 100644 index 000000000..c0afe27ea --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/BiochemCropMainMod.F90 @@ -0,0 +1,115 @@ +module BiochemCropMainMod + +!!! Main Biogeochemistry module for dynamic crop (as opposed to natural vegetation) +!!! currently only include carbon processes (RE Dickinson et al.(1998) and Liu et al., 2014)) + + use Machine + use NoahmpVarType + use ConstantDefineMod + use CarbonFluxCropMod, only : CarbonFluxCrop + use CropGrowDegreeDayMod, only : CropGrowDegreeDay + use CropPhotosynthesisMod, only : CropPhotosynthesis + + implicit none + +contains + + subroutine BiochemCropMain(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: CARBON_CROP +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Modified by Xing Liu, 2014 +! Refactered code: C. He, P. Valayamkunnath & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variables + integer :: LoopInd ! loop index + +!------------------------------------------------------------------------- + associate( & + VegType => noahmp%config%domain%VegType ,& ! in, vegetation type + DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth [m] of layer-bottom from soil surface + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! in, snow/soil layer thickness [m] + IndexWaterPoint => noahmp%config%domain%IndexWaterPoint ,& ! in, water point flag + IndexIcePoint => noahmp%config%domain%IndexIcePoint ,& ! in, land ice flag + IndexBarrenPoint => noahmp%config%domain%IndexBarrenPoint ,& ! in, bare soil flag + FlagUrban => noahmp%config%domain%FlagUrban ,& ! in, urban point flag + NumSoilLayerRoot => noahmp%water%param%NumSoilLayerRoot ,& ! in, number of soil layers with root present + SoilMoistureSat => noahmp%water%param%SoilMoistureSat ,& ! in, saturated value of soil moisture [m3/m3] + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! in, soil moisture (ice + liq.) [m3/m3] + SoilTranspFacAcc => noahmp%water%state%SoilTranspFacAcc ,& ! in, accumulated soil water transpiration factor (0 to 1) + LeafMass => noahmp%biochem%state%LeafMass ,& ! inout, leaf mass [g/m2] + RootMass => noahmp%biochem%state%RootMass ,& ! inout, mass of fine roots [g/m2] + StemMass => noahmp%biochem%state%StemMass ,& ! inout, stem mass [g/m2] + WoodMass => noahmp%biochem%state%WoodMass ,& ! inout, mass of wood (incl. woody roots) [g/m2] + CarbonMassDeepSoil => noahmp%biochem%state%CarbonMassDeepSoil ,& ! inout, stable carbon in deep soil [g/m2] + CarbonMassShallowSoil => noahmp%biochem%state%CarbonMassShallowSoil ,& ! inout, short-lived carbon in shallow soil [g/m2] + LeafAreaIndex => noahmp%energy%state%LeafAreaIndex ,& ! inout, leaf area index + StemAreaIndex => noahmp%energy%state%StemAreaIndex ,& ! inout, stem area index + GrossPriProduction => noahmp%biochem%flux%GrossPriProduction ,& ! out, net instantaneous assimilation [g/m2/s C] + NetPriProductionTot => noahmp%biochem%flux%NetPriProductionTot ,& ! out, net primary productivity [g/m2/s C] + NetEcoExchange => noahmp%biochem%flux%NetEcoExchange ,& ! out, net ecosystem exchange [g/m2/s CO2] + RespirationPlantTot => noahmp%biochem%flux%RespirationPlantTot ,& ! out, total plant respiration [g/m2/s C] + RespirationSoilOrg => noahmp%biochem%flux%RespirationSoilOrg ,& ! out, soil organic respiration [g/m2/s C] + CarbonMassSoilTot => noahmp%biochem%state%CarbonMassSoilTot ,& ! out, total soil carbon [g/m2 C] + CarbonMassLiveTot => noahmp%biochem%state%CarbonMassLiveTot ,& ! out, total living carbon ([g/m2 C] + GrainMass => noahmp%biochem%state%GrainMass ,& ! out, mass of grain [g/m2] + SoilWaterRootZone => noahmp%water%state%SoilWaterRootZone ,& ! out, root zone soil water + SoilWaterStress => noahmp%water%state%SoilWaterStress & ! out, water stress coeficient (1.0 for wilting) + ) +!------------------------------------------------------------------------ + + ! initialize + NetEcoExchange = 0.0 + NetPriProductionTot = 0.0 + GrossPriProduction = 0.0 + + ! no biogeochemistry in non-vegetated points + if ( (VegType == IndexWaterPoint) .or. (VegType == IndexBarrenPoint) .or. & + (VegType == IndexIcePoint ) .or. (FlagUrban .eqv. .true.) ) then + LeafAreaIndex = 0.0 + StemAreaIndex = 0.0 + GrossPriProduction = 0.0 + NetPriProductionTot = 0.0 + NetEcoExchange = 0.0 + RespirationPlantTot = 0.0 + RespirationSoilOrg = 0.0 + CarbonMassSoilTot = 0.0 + CarbonMassLiveTot = 0.0 + LeafMass = 0.0 + RootMass = 0.0 + StemMass = 0.0 + WoodMass = 0.0 + CarbonMassDeepSoil = 0.0 + CarbonMassShallowSoil = 0.0 + GrainMass = 0.0 + return + endif + + ! start biogeochemistry process + ! water stress + SoilWaterStress = 1.0 - SoilTranspFacAcc + SoilWaterRootZone = 0.0 + do LoopInd = 1, NumSoilLayerRoot + SoilWaterRootZone = SoilWaterRootZone + SoilMoisture(LoopInd) / SoilMoistureSat(LoopInd) * & + ThicknessSnowSoilLayer(LoopInd) / (-DepthSoilLayer(NumSoilLayerRoot)) + enddo + + ! start crop carbon process + ! Note: The following CropPhotosynthesis is not used currently. + ! Photosynthesis rate is directly from calculations in the energy part (similar to the treatment in CARBON subroutine) + + !call CropPhotosynthesis(noahmp) + call CropGrowDegreeDay(noahmp) + call CarbonFluxCrop(noahmp) + + end associate + + end subroutine BiochemCropMain + +end module BiochemCropMainMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/BiochemNatureVegMainMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/BiochemNatureVegMainMod.F90 new file mode 100644 index 000000000..93a0a9769 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/BiochemNatureVegMainMod.F90 @@ -0,0 +1,109 @@ +module BiochemNatureVegMainMod + +!!! Main Biogeochemistry module for dynamic generic vegetation (as opposed to explicit crop scheme) +!!! currently only include carbon processes (RE Dickinson et al.(1998) and Guo-Yue Niu(2004)) + + use Machine + use NoahmpVarType + use ConstantDefineMod + use CarbonFluxNatureVegMod, only : CarbonFluxNatureVeg + + implicit none + +contains + + subroutine BiochemNatureVegMain(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: CARBON +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variables + integer :: LoopInd ! loop index + +!------------------------------------------------------------------------ + associate( & + VegType => noahmp%config%domain%VegType ,& ! in, vegetation type + DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth [m] of layer-bottom from soil surface + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! in, snow/soil layer thickness [m] + IndexWaterPoint => noahmp%config%domain%IndexWaterPoint ,& ! in, water point flag + IndexIcePoint => noahmp%config%domain%IndexIcePoint ,& ! in, land ice flag + IndexBarrenPoint => noahmp%config%domain%IndexBarrenPoint ,& ! in, bare soil flag + FlagUrban => noahmp%config%domain%FlagUrban ,& ! in, urban point flag + NumSoilLayerRoot => noahmp%water%param%NumSoilLayerRoot ,& ! in, number of soil layers with root present + SoilMoistureSat => noahmp%water%param%SoilMoistureSat ,& ! in, saturated value of soil moisture [m3/m3] + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! in, soil moisture (ice + liq.) [m3/m3] + SoilTranspFacAcc => noahmp%water%state%SoilTranspFacAcc ,& ! in, accumulated soil water transpiration factor (0 to 1) + LeafAreaPerMass1side => noahmp%biochem%param%LeafAreaPerMass1side ,& ! in, single-side leaf area per Kg [m2/kg] + LeafMass => noahmp%biochem%state%LeafMass ,& ! inout, leaf mass [g/m2] + RootMass => noahmp%biochem%state%RootMass ,& ! inout, mass of fine roots [g/m2] + StemMass => noahmp%biochem%state%StemMass ,& ! inout, stem mass [g/m2] + WoodMass => noahmp%biochem%state%WoodMass ,& ! inout, mass of wood (incl. woody roots) [g/m2] + CarbonMassDeepSoil => noahmp%biochem%state%CarbonMassDeepSoil ,& ! inout, stable carbon in deep soil [g/m2] + CarbonMassShallowSoil => noahmp%biochem%state%CarbonMassShallowSoil ,& ! inout, short-lived carbon in shallow soil [g/m2] + LeafAreaIndex => noahmp%energy%state%LeafAreaIndex ,& ! inout, leaf area index + StemAreaIndex => noahmp%energy%state%StemAreaIndex ,& ! inout, stem area index + GrossPriProduction => noahmp%biochem%flux%GrossPriProduction ,& ! out, net instantaneous assimilation [g/m2/s C] + NetPriProductionTot => noahmp%biochem%flux%NetPriProductionTot ,& ! out, net primary productivity [g/m2/s C] + NetEcoExchange => noahmp%biochem%flux%NetEcoExchange ,& ! out, net ecosystem exchange [g/m2/s CO2] + RespirationPlantTot => noahmp%biochem%flux%RespirationPlantTot ,& ! out, total plant respiration [g/m2/s C] + RespirationSoilOrg => noahmp%biochem%flux%RespirationSoilOrg ,& ! out, soil organic respiration [g/m2/s C] + CarbonMassSoilTot => noahmp%biochem%state%CarbonMassSoilTot ,& ! out, total soil carbon [g/m2 C] + CarbonMassLiveTot => noahmp%biochem%state%CarbonMassLiveTot ,& ! out, total living carbon ([g/m2 C] + SoilWaterRootZone => noahmp%water%state%SoilWaterRootZone ,& ! out, root zone soil water + SoilWaterStress => noahmp%water%state%SoilWaterStress ,& ! out, water stress coeficient (1. for wilting) + LeafAreaPerMass => noahmp%biochem%state%LeafAreaPerMass & ! out, leaf area per unit mass [m2/g] + ) +!----------------------------------------------------------------------- + + ! initialize + NetEcoExchange = 0.0 + NetPriProductionTot = 0.0 + GrossPriProduction = 0.0 + + ! no biogeochemistry in non-vegetated points + if ( (VegType == IndexWaterPoint) .or. (VegType == IndexBarrenPoint) .or. & + (VegType == IndexIcePoint ) .or. (FlagUrban .eqv. .true.) ) then + LeafAreaIndex = 0.0 + StemAreaIndex = 0.0 + GrossPriProduction = 0.0 + NetPriProductionTot = 0.0 + NetEcoExchange = 0.0 + RespirationPlantTot = 0.0 + RespirationSoilOrg = 0.0 + CarbonMassSoilTot = 0.0 + CarbonMassLiveTot = 0.0 + LeafMass = 0.0 + RootMass = 0.0 + StemMass = 0.0 + WoodMass = 0.0 + CarbonMassDeepSoil = 0.0 + CarbonMassShallowSoil = 0.0 + return + endif + + ! start biogeochemistry process + LeafAreaPerMass = LeafAreaPerMass1side / 1000.0 ! m2/kg -> m2/g + + ! water stress + SoilWaterStress = 1.0 - SoilTranspFacAcc + SoilWaterRootZone = 0.0 + do LoopInd = 1, NumSoilLayerRoot + SoilWaterRootZone = SoilWaterRootZone + SoilMoisture(LoopInd) / SoilMoistureSat(LoopInd) * & + ThicknessSnowSoilLayer(LoopInd) / (-DepthSoilLayer(NumSoilLayerRoot)) + enddo + + ! start carbon process + call CarbonFluxNatureVeg(noahmp) + + end associate + + end subroutine BiochemNatureVegMain + +end module BiochemNatureVegMainMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/BiochemVarInitMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/BiochemVarInitMod.F90 new file mode 100644 index 000000000..e53aa108c --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/BiochemVarInitMod.F90 @@ -0,0 +1,193 @@ +module BiochemVarInitMod + +!!! Initialize column (1-D) Noah-MP biochemistry (carbon,nitrogen,etc) variables +!!! Biochemistry variables should be first defined in BiochemVarType.F90 + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use Machine + use NoahmpVarType + + implicit none + +contains + +!=== initialize with default values + + subroutine BiochemVarInitDefault(noahmp) + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + + associate( NumCropGrowStage => noahmp%config%domain%NumCropGrowStage ) + + ! biochem state variables + noahmp%biochem%state%PlantGrowStage = undefined_int + noahmp%biochem%state%IndexPlanting = undefined_int + noahmp%biochem%state%IndexHarvest = undefined_int + noahmp%biochem%state%IndexGrowSeason = undefined_real + noahmp%biochem%state%NitrogenConcFoliage = undefined_real + noahmp%biochem%state%LeafMass = undefined_real + noahmp%biochem%state%RootMass = undefined_real + noahmp%biochem%state%StemMass = undefined_real + noahmp%biochem%state%WoodMass = undefined_real + noahmp%biochem%state%CarbonMassDeepSoil = undefined_real + noahmp%biochem%state%CarbonMassShallowSoil = undefined_real + noahmp%biochem%state%CarbonMassSoilTot = undefined_real + noahmp%biochem%state%CarbonMassLiveTot = undefined_real + noahmp%biochem%state%LeafAreaPerMass = undefined_real + noahmp%biochem%state%StemAreaPerMass = undefined_real + noahmp%biochem%state%LeafMassMin = undefined_real + noahmp%biochem%state%StemMassMin = undefined_real + noahmp%biochem%state%CarbonFracToLeaf = undefined_real + noahmp%biochem%state%CarbonFracToRoot = undefined_real + noahmp%biochem%state%CarbonFracToWood = undefined_real + noahmp%biochem%state%CarbonFracToStem = undefined_real + noahmp%biochem%state%WoodCarbonFrac = undefined_real + noahmp%biochem%state%CarbonFracToWoodRoot = undefined_real + noahmp%biochem%state%MicroRespFactorSoilWater = undefined_real + noahmp%biochem%state%MicroRespFactorSoilTemp = undefined_real + noahmp%biochem%state%RespFacNitrogenFoliage = undefined_real + noahmp%biochem%state%RespFacTemperature = undefined_real + noahmp%biochem%state%RespReductionFac = undefined_real + noahmp%biochem%state%GrainMass = undefined_real + noahmp%biochem%state%GrowDegreeDay = undefined_real + + ! biochem flux variables + noahmp%biochem%flux%PhotosynLeafSunlit = undefined_real + noahmp%biochem%flux%PhotosynLeafShade = undefined_real + noahmp%biochem%flux%PhotosynCrop = undefined_real + noahmp%biochem%flux%PhotosynTotal = undefined_real + noahmp%biochem%flux%GrossPriProduction = undefined_real + noahmp%biochem%flux%NetPriProductionTot = undefined_real + noahmp%biochem%flux%NetEcoExchange = undefined_real + noahmp%biochem%flux%RespirationPlantTot = undefined_real + noahmp%biochem%flux%RespirationSoilOrg = undefined_real + noahmp%biochem%flux%CarbonToAtmos = undefined_real + noahmp%biochem%flux%NetPriProductionLeaf = undefined_real + noahmp%biochem%flux%NetPriProductionRoot = undefined_real + noahmp%biochem%flux%NetPriProductionWood = undefined_real + noahmp%biochem%flux%NetPriProductionStem = undefined_real + noahmp%biochem%flux%GrowthRespLeaf = undefined_real + noahmp%biochem%flux%GrowthRespRoot = undefined_real + noahmp%biochem%flux%GrowthRespWood = undefined_real + noahmp%biochem%flux%GrowthRespStem = undefined_real + noahmp%biochem%flux%LeafMassMaxChg = undefined_real + noahmp%biochem%flux%StemMassMaxChg = undefined_real + noahmp%biochem%flux%CarbonDecayToStable = undefined_real + noahmp%biochem%flux%RespirationLeaf = undefined_real + noahmp%biochem%flux%RespirationStem = undefined_real + noahmp%biochem%flux%GrowthRespGrain = undefined_real + noahmp%biochem%flux%NetPriProductionGrain = undefined_real + noahmp%biochem%flux%ConvRootToGrain = undefined_real + noahmp%biochem%flux%ConvStemToGrain = undefined_real + noahmp%biochem%flux%RespirationWood = undefined_real + noahmp%biochem%flux%RespirationLeafMaint = undefined_real + noahmp%biochem%flux%RespirationRoot = undefined_real + noahmp%biochem%flux%DeathLeaf = undefined_real + noahmp%biochem%flux%DeathStem = undefined_real + noahmp%biochem%flux%CarbonAssim = undefined_real + noahmp%biochem%flux%TurnoverLeaf = undefined_real + noahmp%biochem%flux%TurnoverStem = undefined_real + noahmp%biochem%flux%TurnoverWood = undefined_real + noahmp%biochem%flux%RespirationSoil = undefined_real + noahmp%biochem%flux%TurnoverRoot = undefined_real + noahmp%biochem%flux%CarbohydrAssim = undefined_real + noahmp%biochem%flux%TurnoverGrain = undefined_real + noahmp%biochem%flux%ConvLeafToGrain = undefined_real + noahmp%biochem%flux%RespirationGrain = undefined_real + + ! biochem parameter variables + noahmp%biochem%param%DatePlanting = undefined_int + noahmp%biochem%param%DateHarvest = undefined_int + noahmp%biochem%param%QuantumEfficiency25C = undefined_real + noahmp%biochem%param%CarboxylRateMax25C = undefined_real + noahmp%biochem%param%CarboxylRateMaxQ10 = undefined_real + noahmp%biochem%param%PhotosynPathC3 = undefined_real + noahmp%biochem%param%SlopeConductToPhotosyn = undefined_real + noahmp%biochem%param%TemperatureMinPhotosyn = undefined_real + noahmp%biochem%param%LeafAreaPerMass1side = undefined_real + noahmp%biochem%param%NitrogenConcFoliageMax = undefined_real + noahmp%biochem%param%WoodToRootRatio = undefined_real + noahmp%biochem%param%WoodPoolIndex = undefined_real + noahmp%biochem%param%TurnoverCoeffLeafVeg = undefined_real + noahmp%biochem%param%LeafDeathWaterCoeffVeg = undefined_real + noahmp%biochem%param%LeafDeathTempCoeffVeg = undefined_real + noahmp%biochem%param%MicroRespCoeff = undefined_real + noahmp%biochem%param%RespMaintQ10 = undefined_real + noahmp%biochem%param%RespMaintLeaf25C = undefined_real + noahmp%biochem%param%RespMaintStem25C = undefined_real + noahmp%biochem%param%RespMaintRoot25C = undefined_real + noahmp%biochem%param%RespMaintGrain25C = undefined_real + noahmp%biochem%param%GrowthRespFrac = undefined_real + noahmp%biochem%param%TemperaureLeafFreeze = undefined_real + noahmp%biochem%param%LeafAreaPerBiomass = undefined_real + noahmp%biochem%param%TempBaseGrowDegDay = undefined_real + noahmp%biochem%param%TempMaxGrowDegDay = undefined_real + noahmp%biochem%param%GrowDegDayEmerg = undefined_real + noahmp%biochem%param%GrowDegDayInitVeg = undefined_real + noahmp%biochem%param%GrowDegDayPostVeg = undefined_real + noahmp%biochem%param%GrowDegDayInitReprod = undefined_real + noahmp%biochem%param%GrowDegDayMature = undefined_real + noahmp%biochem%param%PhotosynRadFrac = undefined_real + noahmp%biochem%param%TempMinCarbonAssim = undefined_real + noahmp%biochem%param%TempMaxCarbonAssim = undefined_real + noahmp%biochem%param%TempMaxCarbonAssimMax = undefined_real + noahmp%biochem%param%CarbonAssimRefMax = undefined_real + noahmp%biochem%param%LightExtCoeff = undefined_real + noahmp%biochem%param%LightUseEfficiency = undefined_real + noahmp%biochem%param%CarbonAssimReducFac = undefined_real + noahmp%biochem%param%StemAreaIndexMin = undefined_real + noahmp%biochem%param%WoodAllocFac = undefined_real + noahmp%biochem%param%WaterStressCoeff = undefined_real + noahmp%biochem%param%LeafAreaIndexMin = undefined_real + noahmp%biochem%param%TurnoverCoeffRootVeg = undefined_real + noahmp%biochem%param%WoodRespCoeff = undefined_real + + if ( .not. allocated(noahmp%biochem%param%LeafDeathTempCoeffCrop) ) & + allocate( noahmp%biochem%param%LeafDeathTempCoeffCrop(1:NumCropGrowStage) ) + if ( .not. allocated(noahmp%biochem%param%LeafDeathWaterCoeffCrop) ) & + allocate( noahmp%biochem%param%LeafDeathWaterCoeffCrop(1:NumCropGrowStage) ) + if ( .not. allocated(noahmp%biochem%param%CarbohydrLeafToGrain) ) & + allocate( noahmp%biochem%param%CarbohydrLeafToGrain(1:NumCropGrowStage) ) + if ( .not. allocated(noahmp%biochem%param%CarbohydrStemToGrain) ) & + allocate( noahmp%biochem%param%CarbohydrStemToGrain(1:NumCropGrowStage) ) + if ( .not. allocated(noahmp%biochem%param%CarbohydrRootToGrain) ) & + allocate( noahmp%biochem%param%CarbohydrRootToGrain(1:NumCropGrowStage) ) + if ( .not. allocated(noahmp%biochem%param%CarbohydrFracToLeaf) ) & + allocate( noahmp%biochem%param%CarbohydrFracToLeaf(1:NumCropGrowStage) ) + if ( .not. allocated(noahmp%biochem%param%CarbohydrFracToStem) ) & + allocate( noahmp%biochem%param%CarbohydrFracToStem(1:NumCropGrowStage) ) + if ( .not. allocated(noahmp%biochem%param%CarbohydrFracToRoot) ) & + allocate( noahmp%biochem%param%CarbohydrFracToRoot(1:NumCropGrowStage) ) + if ( .not. allocated(noahmp%biochem%param%CarbohydrFracToGrain) ) & + allocate( noahmp%biochem%param%CarbohydrFracToGrain(1:NumCropGrowStage) ) + if ( .not. allocated(noahmp%biochem%param%TurnoverCoeffLeafCrop) ) & + allocate( noahmp%biochem%param%TurnoverCoeffLeafCrop(1:NumCropGrowStage) ) + if ( .not. allocated(noahmp%biochem%param%TurnoverCoeffStemCrop) ) & + allocate( noahmp%biochem%param%TurnoverCoeffStemCrop(1:NumCropGrowStage) ) + if ( .not. allocated(noahmp%biochem%param%TurnoverCoeffRootCrop) ) & + allocate( noahmp%biochem%param%TurnoverCoeffRootCrop(1:NumCropGrowStage) ) + + noahmp%biochem%param%LeafDeathTempCoeffCrop (:) = undefined_real + noahmp%biochem%param%LeafDeathWaterCoeffCrop(:) = undefined_real + noahmp%biochem%param%CarbohydrLeafToGrain (:) = undefined_real + noahmp%biochem%param%CarbohydrStemToGrain (:) = undefined_real + noahmp%biochem%param%CarbohydrRootToGrain (:) = undefined_real + noahmp%biochem%param%CarbohydrFracToLeaf (:) = undefined_real + noahmp%biochem%param%CarbohydrFracToStem (:) = undefined_real + noahmp%biochem%param%CarbohydrFracToRoot (:) = undefined_real + noahmp%biochem%param%CarbohydrFracToGrain (:) = undefined_real + noahmp%biochem%param%TurnoverCoeffLeafCrop (:) = undefined_real + noahmp%biochem%param%TurnoverCoeffStemCrop (:) = undefined_real + noahmp%biochem%param%TurnoverCoeffRootCrop (:) = undefined_real + + end associate + + end subroutine BiochemVarInitDefault + +end module BiochemVarInitMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/BiochemVarType.F90 b/src/core_atmosphere/physics/physics_noahmp/src/BiochemVarType.F90 new file mode 100644 index 000000000..9e9cd3e44 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/BiochemVarType.F90 @@ -0,0 +1,177 @@ +module BiochemVarType + +!!! Define column (1-D) Noah-MP Biochemistry (carbon,nitrogen,etc) variables +!!! Biochemistry variable initialization is done in BiochemVarInitMod.F90 + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use Machine + + implicit none + save + private + +!=== define "flux" sub-type of biochem (biochem%flux%variable) + type :: flux_type + + real(kind=kind_noahmp) :: PhotosynTotal ! total leaf photosynthesis [umol co2/m2/s] + real(kind=kind_noahmp) :: PhotosynLeafSunlit ! sunlit leaf photosynthesis [umol co2/m2/s] + real(kind=kind_noahmp) :: PhotosynLeafShade ! shaded leaf photosynthesis [umol co2/m2/s] + real(kind=kind_noahmp) :: PhotosynCrop ! crop photosynthesis rate [umol co2/m2/s] + real(kind=kind_noahmp) :: GrossPriProduction ! gross primary production [g/m2/s C] + real(kind=kind_noahmp) :: NetEcoExchange ! net ecosystem exchange [g/m2/s CO2] + real(kind=kind_noahmp) :: NetPriProductionTot ! total net primary production [g/m2/s C] + real(kind=kind_noahmp) :: NetPriProductionLeaf ! leaf net primary production [g/m2/s] + real(kind=kind_noahmp) :: NetPriProductionRoot ! root net primary production [g/m2/s] + real(kind=kind_noahmp) :: NetPriProductionWood ! wood net primary production [g/m2/s] + real(kind=kind_noahmp) :: NetPriProductionStem ! stem net primary production [g/m2/s] + real(kind=kind_noahmp) :: NetPriProductionGrain ! grain net primary production [g/m2/s] + real(kind=kind_noahmp) :: RespirationPlantTot ! total plant respiration (leaf,stem,root,wood,grain) [g/m2/s C] + real(kind=kind_noahmp) :: RespirationSoilOrg ! soil heterotrophic (organic) respiration [g/m2/s C] + real(kind=kind_noahmp) :: CarbonToAtmos ! carbon flux to atmosphere [g/m2/s] + real(kind=kind_noahmp) :: GrowthRespLeaf ! growth respiration rate for leaf [g/m2/s] + real(kind=kind_noahmp) :: GrowthRespRoot ! growth respiration rate for root [g/m2/s] + real(kind=kind_noahmp) :: GrowthRespWood ! growth respiration rate for wood [g/m2/s] + real(kind=kind_noahmp) :: GrowthRespStem ! growth respiration rate for stem [g/m2/s] + real(kind=kind_noahmp) :: GrowthRespGrain ! growth respiration rate for grain [g/m2/s] + real(kind=kind_noahmp) :: LeafMassMaxChg ! maximum leaf mass available to change [g/m2/s] + real(kind=kind_noahmp) :: StemMassMaxChg ! maximum stem mass available to change [g/m2/s] + real(kind=kind_noahmp) :: CarbonDecayToStable ! decay rate of fast carbon to slow carbon [g/m2/s] + real(kind=kind_noahmp) :: RespirationLeaf ! leaf respiration [umol CO2/m2/s] + real(kind=kind_noahmp) :: RespirationStem ! stem respiration [g/m2/s] + real(kind=kind_noahmp) :: RespirationWood ! wood respiration rate [g/m2/s] + real(kind=kind_noahmp) :: RespirationLeafMaint ! leaf maintenance respiration rate [g/m2/s] + real(kind=kind_noahmp) :: RespirationRoot ! fine root respiration rate [g/m2/s] + real(kind=kind_noahmp) :: RespirationSoil ! soil respiration rate [g/m2/s] + real(kind=kind_noahmp) :: RespirationGrain ! grain respiration rate [g/m2/s] + real(kind=kind_noahmp) :: ConvRootToGrain ! root to grain conversion [g/m2/s] + real(kind=kind_noahmp) :: ConvStemToGrain ! stem to grain conversion [g/m2/s] + real(kind=kind_noahmp) :: ConvLeafToGrain ! leaf to grain conversion [g/m2/s] + real(kind=kind_noahmp) :: TurnoverLeaf ! leaf turnover rate [g/m2/s] + real(kind=kind_noahmp) :: TurnoverStem ! stem turnover rate [g/m2/s] + real(kind=kind_noahmp) :: TurnoverWood ! wood turnover rate [g/m2/s] + real(kind=kind_noahmp) :: TurnoverRoot ! root turnover rate [g/m2/s] + real(kind=kind_noahmp) :: TurnoverGrain ! grain turnover rate [g/m2/s] + real(kind=kind_noahmp) :: DeathLeaf ! death rate of leaf mass [g/m2/s] + real(kind=kind_noahmp) :: DeathStem ! death rate of stem mass [g/m2/s] + real(kind=kind_noahmp) :: CarbonAssim ! carbon assimilated rate [g/m2/s] + real(kind=kind_noahmp) :: CarbohydrAssim ! carbohydrate assimilated rate [g/m2/s] + + end type flux_type + + +!=== define "state" sub-type of biochem (biochem%state%variable) + type :: state_type + + integer :: PlantGrowStage ! plant growing stage + integer :: IndexPlanting ! Planting index (0=off, 1=on) + integer :: IndexHarvest ! Harvest index (0=on,1=off) + real(kind=kind_noahmp) :: IndexGrowSeason ! growing season index (0=off, 1=on) + real(kind=kind_noahmp) :: NitrogenConcFoliage ! foliage nitrogen concentration [%] + real(kind=kind_noahmp) :: LeafMass ! leaf mass [g/m2] + real(kind=kind_noahmp) :: RootMass ! mass of fine roots [g/m2] + real(kind=kind_noahmp) :: StemMass ! stem mass [g/m2] + real(kind=kind_noahmp) :: WoodMass ! mass of wood (include woody roots) [g/m2] + real(kind=kind_noahmp) :: GrainMass ! mass of grain [g/m2] + real(kind=kind_noahmp) :: CarbonMassDeepSoil ! stable carbon in deep soil [g/m2] + real(kind=kind_noahmp) :: CarbonMassShallowSoil ! short-lived carbon in shallow soil [g/m2] + real(kind=kind_noahmp) :: CarbonMassSoilTot ! total soil carbon mass [g/m2 C] + real(kind=kind_noahmp) :: CarbonMassLiveTot ! total living carbon mass ([g/m2 C] + real(kind=kind_noahmp) :: LeafAreaPerMass ! leaf area per unit mass [m2/g] + real(kind=kind_noahmp) :: StemAreaPerMass ! stem area per unit mass (m2/g) + real(kind=kind_noahmp) :: LeafMassMin ! minimum leaf mass [g/m2] + real(kind=kind_noahmp) :: StemMassMin ! minimum stem mass [g/m2] + real(kind=kind_noahmp) :: CarbonFracToLeaf ! fraction of carbon flux allocated to leaves + real(kind=kind_noahmp) :: CarbonFracToRoot ! fraction of carbon flux allocated to roots + real(kind=kind_noahmp) :: CarbonFracToWood ! fraction of carbon flux allocated to wood + real(kind=kind_noahmp) :: CarbonFracToStem ! fraction of carbon flux allocated to stem + real(kind=kind_noahmp) :: WoodCarbonFrac ! wood carbon fraction in (root + wood) carbon + real(kind=kind_noahmp) :: CarbonFracToWoodRoot ! fraction of carbon to root and wood + real(kind=kind_noahmp) :: MicroRespFactorSoilWater ! soil water factor for microbial respiration + real(kind=kind_noahmp) :: MicroRespFactorSoilTemp ! soil temperature factor for microbial respiration + real(kind=kind_noahmp) :: RespFacNitrogenFoliage ! foliage nitrogen adjustemt factor to respiration (<= 1) + real(kind=kind_noahmp) :: RespFacTemperature ! temperature factor for respiration + real(kind=kind_noahmp) :: RespReductionFac ! respiration reduction factor (<= 1) + real(kind=kind_noahmp) :: GrowDegreeDay ! growing degree days + + end type state_type + + +!=== define "parameter" sub-type of biochem (biochem%param%variable) + type :: parameter_type + + integer :: DatePlanting ! planting date + integer :: DateHarvest ! harvest date + real(kind=kind_noahmp) :: QuantumEfficiency25C ! quantum efficiency at 25c [umol CO2/umol photon] + real(kind=kind_noahmp) :: CarboxylRateMax25C ! maximum rate of carboxylation at 25c [umol CO2/m2/s] + real(kind=kind_noahmp) :: CarboxylRateMaxQ10 ! change in maximum rate of carboxylation for every 10-deg C temperature change + real(kind=kind_noahmp) :: PhotosynPathC3 ! C3 photosynthetic pathway indicator: 0.0 = c4, 1.0 = c3 + real(kind=kind_noahmp) :: SlopeConductToPhotosyn ! slope of conductance-to-photosynthesis relationship + real(kind=kind_noahmp) :: TemperatureMinPhotosyn ! minimum temperature for photosynthesis [K] + real(kind=kind_noahmp) :: LeafAreaPerMass1side ! single-side leaf area per mass [m2/kg] + real(kind=kind_noahmp) :: NitrogenConcFoliageMax ! foliage nitrogen concentration when f(n)=1 (%) + real(kind=kind_noahmp) :: WoodToRootRatio ! wood to root ratio + real(kind=kind_noahmp) :: WoodPoolIndex ! wood pool index (0~1) depending on woody or not + real(kind=kind_noahmp) :: TurnoverCoeffLeafVeg ! leaf turnover coefficient [1/s] for generic vegetation + real(kind=kind_noahmp) :: LeafDeathWaterCoeffVeg ! coeficient for leaf water stress death [1/s] for generic vegetation + real(kind=kind_noahmp) :: LeafDeathTempCoeffVeg ! coeficient for leaf temperature stress death [1/s] for generic vegetation + real(kind=kind_noahmp) :: MicroRespCoeff ! microbial respiration coefficient [umol co2 /kg c/ s] + real(kind=kind_noahmp) :: RespMaintQ10 ! change in maintenance respiration for every 10-deg C temperature change + real(kind=kind_noahmp) :: RespMaintLeaf25C ! leaf maintenance respiration at 25C [umol CO2/m2 /s] + real(kind=kind_noahmp) :: RespMaintStem25C ! stem maintenance respiration at 25C [umol CO2/kg bio/s], bio: C or CH2O + real(kind=kind_noahmp) :: RespMaintRoot25C ! root maintenance respiration at 25C [umol CO2/kg bio/s], bio: C or CH2O + real(kind=kind_noahmp) :: RespMaintGrain25C ! grain maintenance respiration at 25C [umol CO2/kg bio/s], bio: C or CH2O + real(kind=kind_noahmp) :: GrowthRespFrac ! fraction of growth respiration + real(kind=kind_noahmp) :: TemperaureLeafFreeze ! characteristic temperature for leaf freezing [K] + real(kind=kind_noahmp) :: LeafAreaPerBiomass ! leaf area per living leaf biomass [m2/g] + real(kind=kind_noahmp) :: TempBaseGrowDegDay ! Base temperature for growing degree day (GDD) accumulation [C] + real(kind=kind_noahmp) :: TempMaxGrowDegDay ! Maximum temperature for growing degree day (GDD) accumulation [C] + real(kind=kind_noahmp) :: GrowDegDayEmerg ! growing degree day (GDD) from seeding to emergence + real(kind=kind_noahmp) :: GrowDegDayInitVeg ! growing degree day (GDD) from seeding to initial vegetative + real(kind=kind_noahmp) :: GrowDegDayPostVeg ! growing degree day (GDD) from seeding to post vegetative + real(kind=kind_noahmp) :: GrowDegDayInitReprod ! growing degree day (GDD) from seeding to intial reproductive + real(kind=kind_noahmp) :: GrowDegDayMature ! growing degree day (GDD) from seeding to pysical maturity + real(kind=kind_noahmp) :: PhotosynRadFrac ! Fraction of incoming solar radiation to photosynthetically active radiation + real(kind=kind_noahmp) :: TempMinCarbonAssim ! Minimum temperature for CO2 assimulation [C] + real(kind=kind_noahmp) :: TempMaxCarbonAssim ! CO2 assimulation linearly increasing until reaching this temperature [C] + real(kind=kind_noahmp) :: TempMaxCarbonAssimMax ! CO2 assmilation rate remain at CarbonAssimRefMax until reaching this temperature [C] + real(kind=kind_noahmp) :: CarbonAssimRefMax ! reference maximum CO2 assimilation rate [g co2/m2/s] + real(kind=kind_noahmp) :: LightExtCoeff ! light extinction coefficient + real(kind=kind_noahmp) :: LightUseEfficiency ! initial light use efficiency + real(kind=kind_noahmp) :: CarbonAssimReducFac ! CO2 assimilation reduction factor(0-1) (caused by non-modeling part,e.g.pest,weeds) + real(kind=kind_noahmp) :: StemAreaIndexMin ! minimum stem area index [m2/m2] + real(kind=kind_noahmp) :: WoodAllocFac ! present wood allocation factor + real(kind=kind_noahmp) :: WaterStressCoeff ! water stress coeficient + real(kind=kind_noahmp) :: LeafAreaIndexMin ! minimum leaf area index [m2/m2] + real(kind=kind_noahmp) :: TurnoverCoeffRootVeg ! root turnover coefficient [1/s] for generic vegetation + real(kind=kind_noahmp) :: WoodRespCoeff ! wood respiration coeficient [1/s] + + real(kind=kind_noahmp), allocatable, dimension(:) :: LeafDeathTempCoeffCrop ! coeficient for leaf temperature stress death [1/s] for crop + real(kind=kind_noahmp), allocatable, dimension(:) :: LeafDeathWaterCoeffCrop ! coeficient for leaf water stress death [1/s] for crop + real(kind=kind_noahmp), allocatable, dimension(:) :: CarbohydrLeafToGrain ! fraction of carbohydrate flux transallocate from leaf to grain + real(kind=kind_noahmp), allocatable, dimension(:) :: CarbohydrStemToGrain ! fraction of carbohydrate flux transallocate from stem to grain + real(kind=kind_noahmp), allocatable, dimension(:) :: CarbohydrRootToGrain ! fraction of carbohydrate flux transallocate from root to grain + real(kind=kind_noahmp), allocatable, dimension(:) :: CarbohydrFracToLeaf ! fraction of carbohydrate flux to leaf for crop + real(kind=kind_noahmp), allocatable, dimension(:) :: CarbohydrFracToStem ! fraction of carbohydrate flux to stem for crop + real(kind=kind_noahmp), allocatable, dimension(:) :: CarbohydrFracToRoot ! fraction of carbohydrate flux to root for crop + real(kind=kind_noahmp), allocatable, dimension(:) :: CarbohydrFracToGrain ! fraction of carbohydrate flux to grain for crop + real(kind=kind_noahmp), allocatable, dimension(:) :: TurnoverCoeffLeafCrop ! leaf turnover coefficient [1/s] for crop + real(kind=kind_noahmp), allocatable, dimension(:) :: TurnoverCoeffStemCrop ! stem turnover coefficient [1/s] for crop + real(kind=kind_noahmp), allocatable, dimension(:) :: TurnoverCoeffRootCrop ! root tunrover coefficient [1/s] for crop + + end type parameter_type + + +!=== define biochem type that includes 3 subtypes (flux,state,parameter) + type, public :: biochem_type + + type(flux_type) :: flux + type(state_type) :: state + type(parameter_type) :: param + + end type biochem_type + +end module BiochemVarType diff --git a/src/core_atmosphere/physics/physics_noahmp/src/CanopyHydrologyMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/CanopyHydrologyMod.F90 new file mode 100644 index 000000000..24fab3b4b --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/CanopyHydrologyMod.F90 @@ -0,0 +1,141 @@ +module CanopyHydrologyMod + +!!! Canopy Hydrology processes for intercepted rain and snow water +!!! Canopy liquid water evaporation and dew; canopy ice water sublimation and frost + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine CanopyHydrology(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: CANWATER +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! -------------------------------------------------------------------- + associate( & + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, noahmp main time step [s] + HeatLatentCanopy => noahmp%energy%flux%HeatLatentCanopy ,& ! in, canopy latent heat flux [W/m2] (+ to atm) + HeatLatentTransp => noahmp%energy%flux%HeatLatentTransp ,& ! in, latent heat flux from transpiration [W/m2] (+ to atm) + LeafAreaIndEff => noahmp%energy%state%LeafAreaIndEff ,& ! in, leaf area index, after burying by snow + StemAreaIndEff => noahmp%energy%state%StemAreaIndEff ,& ! in, stem area index, after burying by snow + FlagFrozenCanopy => noahmp%energy%state%FlagFrozenCanopy ,& ! in, used to define latent heat pathway + VegFrac => noahmp%energy%state%VegFrac ,& ! in, greeness vegetation fraction + SnowfallDensity => noahmp%water%state%SnowfallDensity ,& ! in, bulk density of snowfall [kg/m3] + CanopyLiqHoldCap => noahmp%water%param%CanopyLiqHoldCap ,& ! in, maximum intercepted liquid water per unit veg area index [mm] + CanopyLiqWater => noahmp%water%state%CanopyLiqWater ,& ! inout, intercepted canopy liquid water [mm] + CanopyIce => noahmp%water%state%CanopyIce ,& ! inout, intercepted canopy ice [mm] + TemperatureCanopy => noahmp%energy%state%TemperatureCanopy ,& ! inout, vegetation temperature [K] + CanopyTotalWater => noahmp%water%state%CanopyTotalWater ,& ! out, total canopy intercepted water [mm] + CanopyWetFrac => noahmp%water%state%CanopyWetFrac ,& ! out, wetted or snowed fraction of the canopy + CanopyIceMax => noahmp%water%state%CanopyIceMax ,& ! out, canopy capacity for snow interception [mm] + CanopyLiqWaterMax => noahmp%water%state%CanopyLiqWaterMax ,& ! out, canopy capacity for rain interception [mm] + EvapCanopyNet => noahmp%water%flux%EvapCanopyNet ,& ! out, evaporation of intercepted total water [mm/s] + Transpiration => noahmp%water%flux%Transpiration ,& ! out, transpiration rate [mm/s] + EvapCanopyLiq => noahmp%water%flux%EvapCanopyLiq ,& ! out, canopy liquid water evaporation rate [mm/s] + DewCanopyLiq => noahmp%water%flux%DewCanopyLiq ,& ! out, canopy liquid water dew rate [mm/s] + FrostCanopyIce => noahmp%water%flux%FrostCanopyIce ,& ! out, canopy ice frost rate [mm/s] + SublimCanopyIce => noahmp%water%flux%SublimCanopyIce ,& ! out, canopy ice sublimation rate [mm/s] + MeltCanopyIce => noahmp%water%flux%MeltCanopyIce ,& ! out, canopy ice melting rate [mm/s] + FreezeCanopyLiq => noahmp%water%flux%FreezeCanopyLiq & ! out, canopy water freezing rate [mm/s] + ) +! -------------------------------------------------------------------- + + ! initialization for out-only variables + EvapCanopyNet = 0.0 + Transpiration = 0.0 + EvapCanopyLiq = 0.0 + DewCanopyLiq = 0.0 + FrostCanopyIce = 0.0 + SublimCanopyIce = 0.0 + MeltCanopyIce = 0.0 + FreezeCanopyLiq = 0.0 + CanopyLiqWaterMax = 0.0 + CanopyIceMax = 0.0 + CanopyWetFrac = 0.0 + CanopyTotalWater = 0.0 + + ! canopy liquid water + ! maximum canopy intercepted water + CanopyLiqWaterMax = VegFrac * CanopyLiqHoldCap * (LeafAreaIndEff + StemAreaIndEff) + + ! canopy evaporation, transpiration, and dew + if ( FlagFrozenCanopy .eqv. .false. ) then ! Barlage: change to FlagFrozenCanopy + Transpiration = max( HeatLatentTransp/ConstLatHeatEvap, 0.0 ) + EvapCanopyLiq = max( HeatLatentCanopy/ConstLatHeatEvap, 0.0 ) + DewCanopyLiq = abs( min( HeatLatentCanopy/ConstLatHeatEvap, 0.0 ) ) + SublimCanopyIce = 0.0 + FrostCanopyIce = 0.0 + else + Transpiration = max( HeatLatentTransp/ConstLatHeatSublim, 0.0 ) + EvapCanopyLiq = 0.0 + DewCanopyLiq = 0.0 + SublimCanopyIce = max( HeatLatentCanopy/ConstLatHeatSublim, 0.0 ) + FrostCanopyIce = abs( min( HeatLatentCanopy/ConstLatHeatSublim, 0.0 ) ) + endif + + ! canopy water balance. for convenience allow dew to bring CanopyLiqWater above + ! maxh2o or else would have to re-adjust drip + EvapCanopyLiq = min( CanopyLiqWater/MainTimeStep, EvapCanopyLiq ) + CanopyLiqWater = max( 0.0, CanopyLiqWater+(DewCanopyLiq-EvapCanopyLiq)*MainTimeStep ) + if ( CanopyLiqWater <= 1.0e-06 ) CanopyLiqWater = 0.0 + + ! canopy ice + ! maximum canopy intercepted ice + CanopyIceMax = VegFrac * 6.6 * (0.27 + 46.0/SnowfallDensity) * (LeafAreaIndEff + StemAreaIndEff) + + ! canopy sublimation and frost + SublimCanopyIce = min( CanopyIce/MainTimeStep, SublimCanopyIce ) + CanopyIce = max( 0.0, CanopyIce+(FrostCanopyIce-SublimCanopyIce)*MainTimeStep ) + if ( CanopyIce <= 1.0e-6 ) CanopyIce = 0.0 + + ! wetted fraction of canopy + if ( (CanopyIce > 0.0) .and. (CanopyIce >= CanopyLiqWater) ) then + CanopyWetFrac = max(0.0,CanopyIce) / max(CanopyIceMax,1.0e-06) + else + CanopyWetFrac = max(0.0,CanopyLiqWater) / max(CanopyLiqWaterMax,1.0e-06) + endif + CanopyWetFrac = min(CanopyWetFrac, 1.0) ** 0.667 + CanopyTotalWater = CanopyLiqWater + CanopyIce + + ! phase change + ! canopy ice melting + if ( (CanopyIce > 1.0e-6) .and. (TemperatureCanopy > ConstFreezePoint) ) then + MeltCanopyIce = min( CanopyIce/MainTimeStep, (TemperatureCanopy-ConstFreezePoint) * ConstHeatCapacIce * & + CanopyIce / ConstDensityIce / (MainTimeStep*ConstLatHeatFusion) ) + CanopyIce = max( 0.0, CanopyIce - MeltCanopyIce*MainTimeStep ) + CanopyLiqWater = max( 0.0, CanopyTotalWater - CanopyIce ) + TemperatureCanopy = CanopyWetFrac*ConstFreezePoint + (1.0 - CanopyWetFrac)*TemperatureCanopy + endif + + ! canopy water refreeezing + if ( (CanopyLiqWater > 1.0e-6) .and. (TemperatureCanopy < ConstFreezePoint) ) then + FreezeCanopyLiq = min( CanopyLiqWater/MainTimeStep, (ConstFreezePoint-TemperatureCanopy) * ConstHeatCapacWater * & + CanopyLiqWater / ConstDensityWater / (MainTimeStep*ConstLatHeatFusion) ) + CanopyLiqWater = max( 0.0, CanopyLiqWater - FreezeCanopyLiq*MainTimeStep ) + CanopyIce = max( 0.0, CanopyTotalWater - CanopyLiqWater ) + TemperatureCanopy = CanopyWetFrac*ConstFreezePoint + (1.0 - CanopyWetFrac)*TemperatureCanopy + endif + + ! update total canopy water + CanopyTotalWater = CanopyLiqWater + CanopyIce + + ! total canopy net evaporation + EvapCanopyNet = EvapCanopyLiq + SublimCanopyIce - DewCanopyLiq - FrostCanopyIce + + end associate + + end subroutine CanopyHydrology + +end module CanopyHydrologyMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/CanopyRadiationTwoStreamMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/CanopyRadiationTwoStreamMod.F90 new file mode 100644 index 000000000..cbafc5c11 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/CanopyRadiationTwoStreamMod.F90 @@ -0,0 +1,263 @@ +module CanopyRadiationTwoStreamMod + +!!! Compute canopy radiative transfer using two-stream approximation of Dickinson (1983) Adv Geophysics +!!! Calculate fluxes absorbed by vegetation, reflected by vegetation, and transmitted through vegetation +!!! for unit incoming direct or diffuse flux given an underlying ground with known albedo. +!!! Reference for the modified two-stream scheme Niu and Yang (2004), JGR + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine CanopyRadiationTwoStream(noahmp, IndSwBnd, IndSwDif) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: TWOSTREAM +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + integer , intent(in ) :: IndSwBnd ! solar radiation band index + integer , intent(in ) :: IndSwDif ! 0=unit incoming direct; 1=unit incoming diffuse + +! local variables + real(kind=kind_noahmp) :: ScatCoeffCan ! total scattering coefficient for canopy + real(kind=kind_noahmp) :: ScatCoeffLeaf ! scattering coefficient for leaves not covered by snow + real(kind=kind_noahmp) :: UpscatCoeffCanDif ! upscatter parameter for diffuse radiation + real(kind=kind_noahmp) :: UpscatCoeffLeafDif ! upscatter parameter for diffuse radiation for leaves + real(kind=kind_noahmp) :: UpscatCoeffCanDir ! upscatter parameter for direct radiation + real(kind=kind_noahmp) :: UpscatCoeffLeafDir ! upscatter parameter for direct radiation for leaves + real(kind=kind_noahmp) :: OpticDepthDir ! optical depth of direct beam per unit leaf area + real(kind=kind_noahmp) :: OpticDepthDif ! average diffuse optical depth per unit leaf area + real(kind=kind_noahmp) :: CosSolarZenithAngleTmp ! cosine of solar zenith angle (0.001~1.0) + real(kind=kind_noahmp) :: SingleScatAlb ! single scattering albedo + real(kind=kind_noahmp) :: LeafOrientIndex ! leaf orientation index (-0.4~0.6) + real(kind=kind_noahmp) :: RadSwTransDir ! transmitted direct solar radiation below canopy + real(kind=kind_noahmp) :: RadSwTransDif ! transmitted diffuse solar radiation below canopy + real(kind=kind_noahmp) :: RadSwReflTot ! total reflected flux by canopy and ground + real(kind=kind_noahmp) :: VegDensity ! vegetation density + real(kind=kind_noahmp) :: RadSwReflCan ! reflected flux by canopy + real(kind=kind_noahmp) :: RadSwReflGrd ! reflected flux by ground + real(kind=kind_noahmp) :: CrownDepth ! crown depth [m] + real(kind=kind_noahmp) :: CrownRadiusVert ! vertical crown radius [m] + real(kind=kind_noahmp) :: SolarAngleTmp ! solar angle conversion from SZA + real(kind=kind_noahmp) :: FoliageDensity ! foliage volume density (m-1) + real(kind=kind_noahmp) :: VegAreaIndTmp ! temporary effective VAI + real(kind=kind_noahmp) :: Tmp0,Tmp1,Tmp2,Tmp3,Tmp4 ! temporary vars + real(kind=kind_noahmp) :: Tmp5,Tmp6,Tmp7,Tmp8,Tmp9 ! temporary vars + real(kind=kind_noahmp) :: P1,P2,P3,P4,S1,S2,U1,U2,U3 ! temporary vars + real(kind=kind_noahmp) :: B,C,D,D1,D2,F,H,H1,H2,H3 ! temporary vars + real(kind=kind_noahmp) :: H4,H5,H6,H7,H8,H9,H10 ! temporary vars + real(kind=kind_noahmp) :: Phi1,Phi2,Sigma ! temporary vars + +! -------------------------------------------------------------------- + associate( & + OptCanopyRadiationTransfer => noahmp%config%nmlist%OptCanopyRadiationTransfer ,& ! in, options for canopy radiation transfer + CosSolarZenithAngle => noahmp%config%domain%CosSolarZenithAngle ,& ! in, cosine solar zenith angle + CanopyWetFrac => noahmp%water%state%CanopyWetFrac ,& ! in, wetted or snowed fraction of the canopy + TreeCrownRadius => noahmp%energy%param%TreeCrownRadius ,& ! in, tree crown radius [m] + HeightCanopyTop => noahmp%energy%param%HeightCanopyTop ,& ! in, top of canopy [m] + HeightCanopyBot => noahmp%energy%param%HeightCanopyBot ,& ! in, bottom of canopy [m] + TreeDensity => noahmp%energy%param%TreeDensity ,& ! in, tree density [no. of trunks per m2] + CanopyOrientIndex => noahmp%energy%param%CanopyOrientIndex ,& ! in, leaf/stem orientation index + ScatterCoeffSnow => noahmp%energy%param%ScatterCoeffSnow ,& ! in, Scattering coefficient for snow + UpscatterCoeffSnowDir => noahmp%energy%param%UpscatterCoeffSnowDir ,& ! in, Upscattering parameters for snow for direct radiation + UpscatterCoeffSnowDif => noahmp%energy%param%UpscatterCoeffSnowDif ,& ! in, Upscattering parameters for snow for diffuse radiation + VegAreaIndEff => noahmp%energy%state%VegAreaIndEff ,& ! in, one-sided leaf+stem area index [m2/m2] + TemperatureCanopy => noahmp%energy%state%TemperatureCanopy ,& ! in, vegetation temperature [K] + AlbedoGrdDir => noahmp%energy%state%AlbedoGrdDir ,& ! in, ground albedo (direct beam: vis, nir) + AlbedoGrdDif => noahmp%energy%state%AlbedoGrdDif ,& ! in, ground albedo (diffuse: vis, nir) + ReflectanceVeg => noahmp%energy%state%ReflectanceVeg ,& ! in, leaf/stem reflectance weighted by LAI and SAI fraction + TransmittanceVeg => noahmp%energy%state%TransmittanceVeg ,& ! in, leaf/stem transmittance weighted by LAI and SAI fraction + VegFrac => noahmp%energy%state%VegFrac ,& ! in, greeness vegetation fraction + AlbedoSfcDir => noahmp%energy%state%AlbedoSfcDir ,& ! out, surface albedo (direct) + AlbedoSfcDif => noahmp%energy%state%AlbedoSfcDif ,& ! out, surface albedo (diffuse) + VegAreaProjDir => noahmp%energy%state%VegAreaProjDir ,& ! out, projected leaf+stem area in solar direction + GapBtwCanopy => noahmp%energy%state%GapBtwCanopy ,& ! out, between canopy gap fraction for beam + GapInCanopy => noahmp%energy%state%GapInCanopy ,& ! out, within canopy gap fraction for beam + GapCanopyDif => noahmp%energy%state%GapCanopyDif ,& ! out, gap fraction for diffue light + GapCanopyDir => noahmp%energy%state%GapCanopyDir ,& ! out, total gap fraction for beam (<=1-VegFrac) + RadSwAbsVegDir => noahmp%energy%flux%RadSwAbsVegDir ,& ! out, flux abs by veg (per unit direct flux) + RadSwAbsVegDif => noahmp%energy%flux%RadSwAbsVegDif ,& ! out, flux abs by veg (per unit diffuse flux) + RadSwDirTranGrdDir => noahmp%energy%flux%RadSwDirTranGrdDir ,& ! out, downward direct flux below veg (per unit dir flux) + RadSwDirTranGrdDif => noahmp%energy%flux%RadSwDirTranGrdDif ,& ! out, downward direct flux below veg per unit dif flux (=0) + RadSwDifTranGrdDir => noahmp%energy%flux%RadSwDifTranGrdDir ,& ! out, downward diffuse flux below veg (per unit dir flux) + RadSwDifTranGrdDif => noahmp%energy%flux%RadSwDifTranGrdDif ,& ! out, downward diffuse flux below veg (per unit dif flux) + RadSwReflVegDir => noahmp%energy%flux%RadSwReflVegDir ,& ! out, flux reflected by veg layer (per unit direct flux) + RadSwReflVegDif => noahmp%energy%flux%RadSwReflVegDif ,& ! out, flux reflected by veg layer (per unit diffuse flux) + RadSwReflGrdDir => noahmp%energy%flux%RadSwReflGrdDir ,& ! out, flux reflected by ground (per unit direct flux) + RadSwReflGrdDif => noahmp%energy%flux%RadSwReflGrdDif & ! out, flux reflected by ground (per unit diffuse flux) + ) +! ---------------------------------------------------------------------- + + ! compute within and between gaps + if ( VegAreaIndEff == 0.0 ) then + GapCanopyDir = 1.0 + GapCanopyDif = 1.0 + else + if ( OptCanopyRadiationTransfer == 1 ) then + VegDensity = -log(max(1.0-VegFrac, 0.01)) / (ConstPI*TreeCrownRadius**2) + CrownDepth = HeightCanopyTop - HeightCanopyBot + CrownRadiusVert = 0.5 * CrownDepth + SolarAngleTmp = atan(CrownRadiusVert / TreeCrownRadius * tan(acos(max(0.01, CosSolarZenithAngle)))) + !GapBtwCanopy = exp(TreeDensity * ConstPI * TreeCrownRadius**2 / cos(SolarAngleTmp)) + GapBtwCanopy = exp(-VegDensity * ConstPI * TreeCrownRadius**2 / cos(SolarAngleTmp)) + FoliageDensity = VegAreaIndEff / (1.33*ConstPI*TreeCrownRadius**3.0 * (CrownRadiusVert/TreeCrownRadius)*VegDensity) + VegAreaIndTmp = CrownDepth * FoliageDensity + GapInCanopy = (1.0 - GapBtwCanopy) * exp(-0.5*VegAreaIndTmp/CosSolarZenithAngle) + GapCanopyDir = min( 1.0-VegFrac, GapBtwCanopy+GapInCanopy ) + GapCanopyDif = 0.05 + endif + if ( OptCanopyRadiationTransfer == 2 ) then + GapCanopyDir = 0.0 + GapCanopyDif = 0.0 + endif + if ( OptCanopyRadiationTransfer == 3 ) then + GapCanopyDir = 1.0 - VegFrac + GapCanopyDif = 1.0 - VegFrac + endif + endif + + ! calculate two-stream parameters ScatCoeffCan, UpscatCoeffCanDir, UpscatCoeffCanDif, OpticDepthDif, VegAreaProjDir, OpticDepthDir. + ! ScatCoeffCan, UpscatCoeffCanDir, UpscatCoeffCanDif are adjusted for snow. values for ScatCoeffCan*UpscatCoeffCanDir + ! and ScatCoeffCan*UpscatCoeffCanDif are calculated and then divided by the new ScatCoeffCan + ! because the product ScatCoeffCan*UpscatCoeffCanDif, ScatCoeffCan*UpscatCoeffCanDir is used in solution. + ! also, the transmittances and reflectances are linear + ! weights of leaf and stem values. + + CosSolarZenithAngleTmp = max( 0.001, CosSolarZenithAngle ) + LeafOrientIndex = min( max(CanopyOrientIndex, -0.4), 0.6 ) + if ( abs(LeafOrientIndex) <= 0.01 ) LeafOrientIndex = 0.01 + Phi1 = 0.5 - 0.633 * LeafOrientIndex - 0.330 * LeafOrientIndex * LeafOrientIndex + Phi2 = 0.877 * (1.0 - 2.0 * Phi1) + VegAreaProjDir = Phi1 + Phi2 * CosSolarZenithAngleTmp + OpticDepthDir = VegAreaProjDir / CosSolarZenithAngleTmp + OpticDepthDif = (1.0 - Phi1/Phi2 * log( (Phi1+Phi2) / Phi1 )) / Phi2 + ScatCoeffLeaf = ReflectanceVeg(IndSwBnd) + TransmittanceVeg(IndSwBnd) + Tmp0 = VegAreaProjDir + Phi2 * CosSolarZenithAngleTmp + Tmp1 = Phi1 * CosSolarZenithAngleTmp + SingleScatAlb = 0.5 * ScatCoeffLeaf * VegAreaProjDir / Tmp0 * (1.0 - Tmp1/Tmp0 * log((Tmp1+Tmp0)/Tmp1) ) + UpscatCoeffLeafDir = (1.0 + OpticDepthDif * OpticDepthDir) / & + (ScatCoeffLeaf * OpticDepthDif * OpticDepthDir) * SingleScatAlb + UpscatCoeffLeafDif = 0.5 * (ReflectanceVeg(IndSwBnd) + TransmittanceVeg(IndSwBnd) + & + (ReflectanceVeg(IndSwBnd)-TransmittanceVeg(IndSwBnd))*((1.0+LeafOrientIndex)/2.0)**2)/ScatCoeffLeaf + + ! adjust omega, betad, and betai for intercepted snow + if ( TemperatureCanopy > ConstFreezePoint ) then ! no snow on leaf + Tmp0 = ScatCoeffLeaf + Tmp1 = UpscatCoeffLeafDir + Tmp2 = UpscatCoeffLeafDif + else + Tmp0 = (1.0 - CanopyWetFrac) * ScatCoeffLeaf + CanopyWetFrac * ScatterCoeffSnow(IndSwBnd) + Tmp1 = ((1.0 - CanopyWetFrac) * ScatCoeffLeaf * UpscatCoeffLeafDir + & + CanopyWetFrac * ScatterCoeffSnow(IndSwBnd) * UpscatterCoeffSnowDir ) / Tmp0 ! direct + Tmp2 = ((1.0 - CanopyWetFrac) * ScatCoeffLeaf * UpscatCoeffLeafDif + & + CanopyWetFrac * ScatterCoeffSnow(IndSwBnd) * UpscatterCoeffSnowDif ) / Tmp0 ! diffuse + endif + ScatCoeffCan = Tmp0 + UpscatCoeffCanDir = Tmp1 + UpscatCoeffCanDif = Tmp2 + + ! absorbed, reflected, transmitted fluxes per unit incoming radiation + B = 1.0 - ScatCoeffCan + ScatCoeffCan * UpscatCoeffCanDif + C = ScatCoeffCan * UpscatCoeffCanDif + Tmp0 = OpticDepthDif * OpticDepthDir + D = Tmp0 * ScatCoeffCan * UpscatCoeffCanDir + F = Tmp0 * ScatCoeffCan * (1.0 - UpscatCoeffCanDir) + Tmp1 = B * B - C * C + H = sqrt(Tmp1) / OpticDepthDif + Sigma = Tmp0 * Tmp0 - Tmp1 + if ( abs(Sigma) < 1.0e-6 ) Sigma = sign(1.0e-6, Sigma) + P1 = B + OpticDepthDif * H + P2 = B - OpticDepthDif * H + P3 = B + Tmp0 + P4 = B - Tmp0 + S1 = exp( -H * VegAreaIndEff ) + S2 = exp( -OpticDepthDir * VegAreaIndEff ) + if ( IndSwDif == 0 ) then ! direct + U1 = B - C / AlbedoGrdDir(IndSwBnd) + U2 = B - C * AlbedoGrdDir(IndSwBnd) + U3 = F + C * AlbedoGrdDir(IndSwBnd) + else ! diffuse + U1 = B - C / AlbedoGrdDif(IndSwBnd) + U2 = B - C * AlbedoGrdDif(IndSwBnd) + U3 = F + C * AlbedoGrdDif(IndSwBnd) + endif + Tmp2 = U1 - OpticDepthDif * H + Tmp3 = U1 + OpticDepthDif * H + D1 = P1 * Tmp2 / S1 - P2 * Tmp3 * S1 + Tmp4 = U2 + OpticDepthDif * H + Tmp5 = U2 - OpticDepthDif * H + D2 = Tmp4 / S1 - Tmp5 * S1 + H1 = -D * P4 - C * F + Tmp6 = D - H1 * P3 / Sigma + Tmp7 = ( D - C - H1 / Sigma * (U1+Tmp0) ) * S2 + H2 = ( Tmp6 * Tmp2 / S1 - P2 * Tmp7 ) / D1 + H3 = - ( Tmp6 * Tmp3 * S1 - P1 * Tmp7 ) / D1 + H4 = -F * P3 - C * D + Tmp8 = H4 / Sigma + Tmp9 = ( U3 - Tmp8 * (U2-Tmp0) ) * S2 + H5 = - ( Tmp8 * Tmp4 / S1 + Tmp9 ) / D2 + H6 = ( Tmp8 * Tmp5 * S1 + Tmp9 ) / D2 + H7 = (C * Tmp2) / (D1 * S1) + H8 = (-C * Tmp3 * S1) / D1 + H9 = Tmp4 / (D2 * S1) + H10 = (-Tmp5 * S1) / D2 + + ! downward direct and diffuse fluxes below vegetation Niu and Yang (2004), JGR. + if ( IndSwDif == 0 ) then ! direct + RadSwTransDir = S2 * (1.0 - GapCanopyDir) + GapCanopyDir + RadSwTransDif = (H4 * S2 / Sigma + H5 * S1 + H6 / S1) * (1.0 - GapCanopyDir) + else ! diffuse + RadSwTransDir = 0.0 + RadSwTransDif = (H9 * S1 + H10 / S1) * (1.0 - GapCanopyDif) + GapCanopyDif + endif + if ( IndSwDif == 0 ) then ! direct + RadSwDirTranGrdDir(IndSwBnd) = RadSwTransDir + RadSwDifTranGrdDir(IndSwBnd) = RadSwTransDif + else ! diffuse + RadSwDirTranGrdDif(IndSwBnd) = RadSwTransDir + RadSwDifTranGrdDif(IndSwBnd) = RadSwTransDif + endif + + ! flux reflected by the surface (veg. and ground) + if ( IndSwDif == 0 ) then ! direct + RadSwReflTot = (H1 / Sigma + H2 + H3) * (1.0 - GapCanopyDir) + AlbedoGrdDir(IndSwBnd) * GapCanopyDir + RadSwReflCan = (H1 / Sigma + H2 + H3) * (1.0 - GapCanopyDir) + RadSwReflGrd = AlbedoGrdDir(IndSwBnd) * GapCanopyDir + else ! diffuse + RadSwReflTot = (H7 + H8) * (1.0 - GapCanopyDif) + AlbedoGrdDif(IndSwBnd) * GapCanopyDif + RadSwReflCan = (H7 + H8) * (1.0 - GapCanopyDif) + AlbedoGrdDif(IndSwBnd) * GapCanopyDif + RadSwReflGrd = 0 + endif + if ( IndSwDif == 0 ) then ! direct + AlbedoSfcDir(IndSwBnd) = RadSwReflTot + RadSwReflVegDir(IndSwBnd) = RadSwReflCan + RadSwReflGrdDir(IndSwBnd) = RadSwReflGrd + else ! diffuse + AlbedoSfcDif(IndSwBnd) = RadSwReflTot + RadSwReflVegDif(IndSwBnd) = RadSwReflCan + RadSwReflGrdDif(IndSwBnd) = RadSwReflGrd + endif + + ! flux absorbed by vegetation + if ( IndSwDif == 0 ) then ! direct + RadSwAbsVegDir(IndSwBnd) = 1.0 - AlbedoSfcDir(IndSwBnd) - (1.0 - AlbedoGrdDir(IndSwBnd))*RadSwDirTranGrdDir(IndSwBnd) - & + (1.0 - AlbedoGrdDif(IndSwBnd))*RadSwDifTranGrdDir(IndSwBnd) + else ! diffuse + RadSwAbsVegDif(IndSwBnd) = 1.0 - AlbedoSfcDif(IndSwBnd) - (1.0 - AlbedoGrdDir(IndSwBnd))*RadSwDirTranGrdDif(IndSwBnd) - & + (1.0 - AlbedoGrdDif(IndSwBnd))*RadSwDifTranGrdDif(IndSwBnd) + endif + + end associate + + end subroutine CanopyRadiationTwoStream + +end module CanopyRadiationTwoStreamMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/CanopyWaterInterceptMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/CanopyWaterInterceptMod.F90 new file mode 100644 index 000000000..274d0c260 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/CanopyWaterInterceptMod.F90 @@ -0,0 +1,155 @@ +module CanopyWaterInterceptMod + +!!! Canopy water processes for snow and rain interception +!!! Subsequent hydrological process for intercepted water is done in CanopyHydrologyMod.F90 + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine CanopyWaterIntercept(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: PRECIP_HEAT +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! The water and heat portions of PRECIP_HEAT are separated in refactored code +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + real(kind=kind_noahmp) :: IceDripFacTemp ! temperature factor for unloading rate + real(kind=kind_noahmp) :: IceDripFacWind ! wind factor for unloading rate + real(kind=kind_noahmp) :: CanopySnowDrip ! canopy snow/ice unloading + +! -------------------------------------------------------------------- + associate( & + SurfaceType => noahmp%config%domain%SurfaceType ,& ! in, surface type 1-soil; 2-lake + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, noahmp main time step [s] + WindEastwardRefHeight => noahmp%forcing%WindEastwardRefHeight ,& ! in, wind speed [m/s] in eastward direction at reference height + WindNorthwardRefHeight => noahmp%forcing%WindNorthwardRefHeight ,& ! in, wind speed [m/s] in northward direction at reference height + LeafAreaIndEff => noahmp%energy%state%LeafAreaIndEff ,& ! in, leaf area index, after burying by snow + StemAreaIndEff => noahmp%energy%state%StemAreaIndEff ,& ! in, stem area index, after burying by snow + VegFrac => noahmp%energy%state%VegFrac ,& ! in, greeness vegetation fraction + TemperatureCanopy => noahmp%energy%state%TemperatureCanopy ,& ! in, vegetation temperature [K] + TemperatureGrd => noahmp%energy%state%TemperatureGrd ,& ! in, ground temperature [K] + CanopyLiqHoldCap => noahmp%water%param%CanopyLiqHoldCap ,& ! in, maximum intercepted liquid water per unit veg area index [mm] + RainfallRefHeight => noahmp%water%flux%RainfallRefHeight ,& ! in, total liquid rainfall [mm/s] before interception + SnowfallRefHeight => noahmp%water%flux%SnowfallRefHeight ,& ! in, total snowfall [mm/s] before interception + SnowfallDensity => noahmp%water%state%SnowfallDensity ,& ! in, bulk density of snowfall [kg/m3] + PrecipAreaFrac => noahmp%water%state%PrecipAreaFrac ,& ! in, fraction of the gridcell that receives precipitation + CanopyLiqWater => noahmp%water%state%CanopyLiqWater ,& ! inout, intercepted canopy liquid water [mm] + CanopyIce => noahmp%water%state%CanopyIce ,& ! inout, intercepted canopy ice [mm] + CanopyWetFrac => noahmp%water%state%CanopyWetFrac ,& ! out, wetted or snowed fraction of the canopy + CanopyTotalWater => noahmp%water%state%CanopyTotalWater ,& ! out, total canopy intercepted water [mm] + CanopyIceMax => noahmp%water%state%CanopyIceMax ,& ! out, canopy capacity for snow interception [mm] + CanopyLiqWaterMax => noahmp%water%state%CanopyLiqWaterMax ,& ! out, canopy capacity for rain interception [mm] + InterceptCanopyRain => noahmp%water%flux%InterceptCanopyRain ,& ! out, interception rate for rain [mm/s] + DripCanopyRain => noahmp%water%flux%DripCanopyRain ,& ! out, drip rate for intercepted rain [mm/s] + ThroughfallRain => noahmp%water%flux%ThroughfallRain ,& ! out, throughfall for rain [mm/s] + InterceptCanopySnow => noahmp%water%flux%InterceptCanopySnow ,& ! out, interception (loading) rate for snowfall [mm/s] + DripCanopySnow => noahmp%water%flux%DripCanopySnow ,& ! out, drip (unloading) rate for intercepted snow [mm/s] + ThroughfallSnow => noahmp%water%flux%ThroughfallSnow ,& ! out, throughfall of snowfall [mm/s] + RainfallGround => noahmp%water%flux%RainfallGround ,& ! out, rainfall at ground surface [mm/s] + SnowfallGround => noahmp%water%flux%SnowfallGround ,& ! out, snowfall at ground surface [mm/s] + SnowDepthIncr => noahmp%water%flux%SnowDepthIncr & ! out, snow depth increasing rate [m/s] due to snowfall + ) +! ---------------------------------------------------------------------- + + ! initialization + InterceptCanopyRain = 0.0 + DripCanopyRain = 0.0 + ThroughfallRain = 0.0 + InterceptCanopySnow = 0.0 + DripCanopySnow = 0.0 + ThroughfallSnow = 0.0 + RainfallGround = 0.0 + SnowfallGround = 0.0 + SnowDepthIncr = 0.0 + CanopySnowDrip = 0.0 + IceDripFacTemp = 0.0 + IceDripFacWind = 0.0 + + ! ----------------------- canopy liquid water ------------------------------ + ! maximum canopy water + CanopyLiqWaterMax = VegFrac * CanopyLiqHoldCap * (LeafAreaIndEff + StemAreaIndEff) + + ! average rain interception and throughfall + if ( (LeafAreaIndEff+StemAreaIndEff) > 0.0 ) then + InterceptCanopyRain = VegFrac * RainfallRefHeight * PrecipAreaFrac ! max interception capability + InterceptCanopyRain = min( InterceptCanopyRain, (CanopyLiqWaterMax-CanopyLiqWater)/MainTimeStep * & + (1.0-exp(-RainfallRefHeight*MainTimeStep/CanopyLiqWaterMax)) ) + InterceptCanopyRain = max( InterceptCanopyRain, 0.0 ) + DripCanopyRain = VegFrac * RainfallRefHeight - InterceptCanopyRain + ThroughfallRain = (1.0 - VegFrac) * RainfallRefHeight + CanopyLiqWater = max( 0.0, CanopyLiqWater + InterceptCanopyRain*MainTimeStep ) + else + InterceptCanopyRain = 0.0 + DripCanopyRain = 0.0 + ThroughfallRain = RainfallRefHeight + if ( CanopyLiqWater > 0.0 ) then ! canopy gets buried by rain + DripCanopyRain = DripCanopyRain + CanopyLiqWater / MainTimeStep + CanopyLiqWater = 0.0 + endif + endif + + ! ----------------------- canopy ice ------------------------------ + ! maximum canopy ice + CanopyIceMax = VegFrac * 6.6 * (0.27 + 46.0/SnowfallDensity) * (LeafAreaIndEff + StemAreaIndEff) + + ! average snow interception and throughfall + if ( (LeafAreaIndEff+StemAreaIndEff) > 0.0 ) then + InterceptCanopySnow = VegFrac * SnowfallRefHeight * PrecipAreaFrac + InterceptCanopySnow = min( InterceptCanopySnow, (CanopyIceMax-CanopyIce)/MainTimeStep * & + (1.0-exp(-SnowfallRefHeight*MainTimeStep/CanopyIceMax)) ) + InterceptCanopySnow = max( InterceptCanopySnow, 0.0 ) + IceDripFacTemp = max( 0.0, (TemperatureCanopy - 270.15) / 1.87e5 ) + IceDripFacWind = sqrt(WindEastwardRefHeight**2.0 + WindNorthwardRefHeight**2.0) / 1.56e5 + ! MB: changed below to reflect the rain assumption that all precip gets intercepted + CanopySnowDrip = max( 0.0, CanopyIce ) * (IceDripFacWind + IceDripFacTemp) + CanopySnowDrip = min( CanopyIce/MainTimeStep + InterceptCanopySnow, CanopySnowDrip) ! add constraint to keep water balance + DripCanopySnow = (VegFrac * SnowfallRefHeight - InterceptCanopySnow) + CanopySnowDrip + ThroughfallSnow = (1.0 - VegFrac) * SnowfallRefHeight + CanopyIce = max( 0.0, CanopyIce + (InterceptCanopySnow-CanopySnowDrip)*MainTimeStep ) + else + InterceptCanopySnow = 0.0 + DripCanopySnow = 0.0 + ThroughfallSnow = SnowfallRefHeight + if ( CanopyIce > 0.0 ) then ! canopy gets buried by snow + DripCanopySnow = DripCanopySnow + CanopyIce / MainTimeStep + CanopyIce = 0.0 + endif + endif + + ! wetted fraction of canopy + if ( CanopyIce > 0.0 ) then + CanopyWetFrac = max( 0.0, CanopyIce ) / max( CanopyIceMax, 1.0e-06 ) + else + CanopyWetFrac = max( 0.0, CanopyLiqWater ) / max( CanopyLiqWaterMax, 1.0e-06 ) + endif + CanopyWetFrac = min( CanopyWetFrac, 1.0 ) ** 0.667 + + ! total canopy water + CanopyTotalWater = CanopyLiqWater + CanopyIce + + ! rain or snow on the ground + RainfallGround = DripCanopyRain + ThroughfallRain + SnowfallGround = DripCanopySnow + ThroughfallSnow + SnowDepthIncr = SnowfallGround / SnowfallDensity + if ( (SurfaceType == 2) .and. (TemperatureGrd > ConstFreezePoint) ) then + SnowfallGround = 0.0 + SnowDepthIncr = 0.0 + endif + + end associate + + end subroutine CanopyWaterIntercept + +end module CanopyWaterInterceptMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/CarbonFluxCropMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/CarbonFluxCropMod.F90 new file mode 100644 index 000000000..59f6ff10a --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/CarbonFluxCropMod.F90 @@ -0,0 +1,268 @@ +module CarbonFluxCropMod + +!!! Main Carbon assimilation for crops +!!! based on RE Dickinson et al.(1998), modifed by Guo-Yue Niu, 2004 +!!! Modified by Xing Liu, 2014 + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine CarbonFluxCrop(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: CO2FLUX_CROP +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + real(kind=kind_noahmp) :: DeathCoeffTemp ! temperature stress death coefficient + real(kind=kind_noahmp) :: DeathCoeffWater ! water stress death coefficient + real(kind=kind_noahmp) :: NetPriProdLeafAdd ! leaf assimil after resp. losses removed [gCH2O/m2/s] + real(kind=kind_noahmp) :: NetPriProdStemAdd ! stem assimil after resp. losses removed [gCH2O/m2/s] + !real(kind=kind_noahmp) :: RespTmp, Temp0 ! temperary vars for function below + !RespTmp(Temp0) = exp(0.08 * (Temp0 - 298.16)) ! Respiration as a function of temperature + +!------------------------------------------------------------------------ + associate( & + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, main noahmp timestep [s] + WaterStressCoeff => noahmp%biochem%param%WaterStressCoeff ,& ! in, water stress coeficient + LeafAreaIndexMin => noahmp%biochem%param%LeafAreaIndexMin ,& ! in, minimum leaf area index [m2/m2] + StemAreaIndexMin => noahmp%biochem%param%StemAreaIndexMin ,& ! in, minimum stem area index [m2/m2] + NitrogenConcFoliageMax => noahmp%biochem%param%NitrogenConcFoliageMax ,& ! in, foliage nitrogen concentration when f(n)=1 [%] + RespMaintQ10 => noahmp%biochem%param%RespMaintQ10 ,& ! in, change in maintenance respiration for each 10C temp. change + RespMaintLeaf25C => noahmp%biochem%param%RespMaintLeaf25C ,& ! in, leaf maintenance respiration at 25C [umol CO2/m2/s] + RespMaintRoot25C => noahmp%biochem%param%RespMaintRoot25C ,& ! in, root maintenance respiration at 25C [umol CO2/kgCH2O/s] + RespMaintStem25C => noahmp%biochem%param%RespMaintStem25C ,& ! in, stem maintenance respiration at 25C [umol CO2/kgCH2O/s] + RespMaintGrain25C => noahmp%biochem%param%RespMaintGrain25C ,& ! in, grain maintenance respiration at 25C [umol CO2/kgCH2O/s] + GrowthRespFrac => noahmp%biochem%param%GrowthRespFrac ,& ! in, fraction of growth respiration + CarbohydrFracToLeaf => noahmp%biochem%param%CarbohydrFracToLeaf ,& ! in, fraction of carbohydrate flux to leaf + CarbohydrFracToStem => noahmp%biochem%param%CarbohydrFracToStem ,& ! in, fraction of carbohydrate flux to stem + CarbohydrFracToRoot => noahmp%biochem%param%CarbohydrFracToRoot ,& ! in, fraction of carbohydrate flux to root + CarbohydrFracToGrain => noahmp%biochem%param%CarbohydrFracToGrain ,& ! in, fraction of carbohydrate flux to grain + TurnoverCoeffLeafCrop => noahmp%biochem%param%TurnoverCoeffLeafCrop ,& ! in, leaf turnover coefficient [1/s] for crop + TurnoverCoeffRootCrop => noahmp%biochem%param%TurnoverCoeffRootCrop ,& ! in, root tunrover coefficient [1/s] for crop + TurnoverCoeffStemCrop => noahmp%biochem%param%TurnoverCoeffStemCrop ,& ! in, stem turnover coefficient [1/s] for crop + TemperaureLeafFreeze => noahmp%biochem%param%TemperaureLeafFreeze ,& ! in, characteristic temperature for leaf freezing [K] + LeafDeathWaterCoeffCrop => noahmp%biochem%param%LeafDeathWaterCoeffCrop ,& ! in, coeficient for water leaf stress death [1/s] for crop + LeafDeathTempCoeffCrop => noahmp%biochem%param%LeafDeathTempCoeffCrop ,& ! in, coeficient for temperature leaf stress death [1/s] for crop + CarbohydrLeafToGrain => noahmp%biochem%param%CarbohydrLeafToGrain ,& ! in, fraction of carbohydrate translocation from leaf to grain + CarbohydrStemToGrain => noahmp%biochem%param%CarbohydrStemToGrain ,& ! in, fraction of carbohydrate translocation from stem to grain + CarbohydrRootToGrain => noahmp%biochem%param%CarbohydrRootToGrain ,& ! in, fraction of carbohydrate translocation from root to grain + MicroRespCoeff => noahmp%biochem%param%MicroRespCoeff ,& ! in, microbial respiration parameter [umol CO2/kgC/s] + LeafAreaPerBiomass => noahmp%biochem%param%LeafAreaPerBiomass ,& ! in, leaf area per living leaf biomass [m2/g] + SoilWaterRootZone => noahmp%water%state%SoilWaterRootZone ,& ! in, root zone soil water + SoilWaterStress => noahmp%water%state%SoilWaterStress ,& ! in, water stress coeficient (1.0 for wilting) + PhotosynTotal => noahmp%biochem%flux%PhotosynTotal ,& ! in, total leaf photosynthesis [umol CO2/m2/s] + NitrogenConcFoliage => noahmp%biochem%state%NitrogenConcFoliage ,& ! in, foliage nitrogen concentration [%] + IndexPlanting => noahmp%biochem%state%IndexPlanting ,& ! in, Planting index + PlantGrowStage => noahmp%biochem%state%PlantGrowStage ,& ! in, plant growing stage + TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow ,& ! in, snow and soil layer temperature [K] + TemperatureCanopy => noahmp%energy%state%TemperatureCanopy ,& ! in, vegetation temperature [K] + LeafAreaIndex => noahmp%energy%state%LeafAreaIndex ,& ! inout, leaf area index + StemAreaIndex => noahmp%energy%state%StemAreaIndex ,& ! inout, stem area index + LeafMass => noahmp%biochem%state%LeafMass ,& ! inout, leaf mass [gCH2O/m2] + RootMass => noahmp%biochem%state%RootMass ,& ! inout, mass of fine roots [gCH2O/m2] + StemMass => noahmp%biochem%state%StemMass ,& ! inout, stem mass [gCH2O/m2] + CarbonMassDeepSoil => noahmp%biochem%state%CarbonMassDeepSoil ,& ! inout, stable carbon in deep soil [gC/m2] + CarbonMassShallowSoil => noahmp%biochem%state%CarbonMassShallowSoil ,& ! inout, short-lived carbon in shallow soil [gC/m2] + GrainMass => noahmp%biochem%state%GrainMass ,& ! inout, mass of grain [gCH2O/m2] + RespFacNitrogenFoliage => noahmp%biochem%state%RespFacNitrogenFoliage ,& ! out, foliage nitrogen adjustemt to respiration (<= 1) + MicroRespFactorSoilWater => noahmp%biochem%state%MicroRespFactorSoilWater ,& ! out, soil water factor for microbial respiration + MicroRespFactorSoilTemp => noahmp%biochem%state%MicroRespFactorSoilTemp ,& ! out, soil temperature factor for microbial respiration + LeafMassMin => noahmp%biochem%state%LeafMassMin ,& ! out, minimum leaf mass [gCH2O/m2] + StemMassMin => noahmp%biochem%state%StemMassMin ,& ! out, minimum stem mass [gCH2O/m2] + StemAreaPerMass => noahmp%biochem%state%StemAreaPerMass ,& ! out, stem area per unit mass [m2/g] + RespFacTemperature => noahmp%biochem%state%RespFacTemperature ,& ! out, temperature factor + CarbonMassSoilTot => noahmp%biochem%state%CarbonMassSoilTot ,& ! out, total soil carbon [gC/m2] + CarbonMassLiveTot => noahmp%biochem%state%CarbonMassLiveTot ,& ! out, total living carbon [gC/m2] + CarbonAssim => noahmp%biochem%flux%CarbonAssim ,& ! out, carbon assimilated rate [gC/m2/s] + CarbohydrAssim => noahmp%biochem%flux%CarbohydrAssim ,& ! out, carbohydrate assimilated rate [gCH2O/m2/s] + TurnoverLeaf => noahmp%biochem%flux%TurnoverLeaf ,& ! out, leaf turnover rate [gCH2O/m2/s] + TurnoverStem => noahmp%biochem%flux%TurnoverStem ,& ! out, stem turnover rate [gCH2O/m2/s] + TurnoverRoot => noahmp%biochem%flux%TurnoverRoot ,& ! out, root carbon loss rate by turnover [gCH2O/m2/s] + ConvLeafToGrain => noahmp%biochem%flux%ConvLeafToGrain ,& ! out, leaf to grain conversion [gCH2O/m2] + ConvRootToGrain => noahmp%biochem%flux%ConvRootToGrain ,& ! out, root to grain conversion [gCH2O/m2] + ConvStemToGrain => noahmp%biochem%flux%ConvStemToGrain ,& ! out, stem to grain conversion [gCH2O/m2] + RespirationPlantTot => noahmp%biochem%flux%RespirationPlantTot ,& ! out, total plant respiration [gC/m2/s C] + CarbonToAtmos => noahmp%biochem%flux%CarbonToAtmos ,& ! out, carbon flux to atmosphere [gC/m2/s] + GrossPriProduction => noahmp%biochem%flux%GrossPriProduction ,& ! out, gross primary production [gC/m2/s] + NetPriProductionTot => noahmp%biochem%flux%NetPriProductionTot ,& ! out, total net primary productivity [gC/m2/s] + NetPriProductionLeaf => noahmp%biochem%flux%NetPriProductionLeaf ,& ! out, leaf net primary productivity [gCH2O/m2/s] + NetPriProductionRoot => noahmp%biochem%flux%NetPriProductionRoot ,& ! out, root net primary productivity [gCH2O/m2/s] + NetPriProductionStem => noahmp%biochem%flux%NetPriProductionStem ,& ! out, stem net primary productivity [gCH2O/m2/s] + NetPriProductionGrain => noahmp%biochem%flux%NetPriProductionGrain ,& ! out, grain net primary productivity [gCH2O/m2/s] + NetEcoExchange => noahmp%biochem%flux%NetEcoExchange ,& ! out, net ecosystem exchange [gCO2/m2/s] + GrowthRespGrain => noahmp%biochem%flux%GrowthRespGrain ,& ! out, growth respiration rate for grain [gCH2O/m2/s] + GrowthRespLeaf => noahmp%biochem%flux%GrowthRespLeaf ,& ! out, growth respiration rate for leaf [gCH2O/m2/s] + GrowthRespRoot => noahmp%biochem%flux%GrowthRespRoot ,& ! out, growth respiration rate for root [gCH2O/m2/s] + GrowthRespStem => noahmp%biochem%flux%GrowthRespStem ,& ! out, growth respiration rate for stem [gCH2O/m2/s] + RespirationSoilOrg => noahmp%biochem%flux%RespirationSoilOrg ,& ! out, soil organic respiration rate [gC/m2/s] + LeafMassMaxChg => noahmp%biochem%flux%LeafMassMaxChg ,& ! out, maximum leaf mass available to change [gCH2O/m2/s] + StemMassMaxChg => noahmp%biochem%flux%StemMassMaxChg ,& ! out, maximum steam mass available to change [gCH2O/m2/s] + RespirationLeaf => noahmp%biochem%flux%RespirationLeaf ,& ! out, leaf respiration rate [umol CO2/m2/s] + RespirationStem => noahmp%biochem%flux%RespirationStem ,& ! out, stem respiration rate [gCH2O/m2/s] + RespirationLeafMaint => noahmp%biochem%flux%RespirationLeafMaint ,& ! out, leaf maintenance respiration rate [gCH2O/m2/s] + RespirationRoot => noahmp%biochem%flux%RespirationRoot ,& ! out, fine root respiration rate [gCH2O/m2/s] + RespirationSoil => noahmp%biochem%flux%RespirationSoil ,& ! out, soil respiration rate [gCH2O/m2/s] + RespirationGrain => noahmp%biochem%flux%RespirationGrain ,& ! out, grain respiration rate [gCH2O/m2/s] + DeathLeaf => noahmp%biochem%flux%DeathLeaf ,& ! out, death rate of leaf mass [gCH2O/m2/s] + CarbonDecayToStable => noahmp%biochem%flux%CarbonDecayToStable & ! out, decay rate of fast carbon to slow carbon [gCH2O/m2/s] + ) +!---------------------------------------------------------------------- + + ! initialization + StemAreaPerMass = 3.0 * 0.001 ! m2/kg -->m2/g + LeafMassMin = LeafAreaIndexMin / 0.035 + StemMassMin = StemAreaIndexMin / StemAreaPerMass + + !!! carbon assimilation starts + ! 1 mole -> 12 g carbon or 44 g CO2 or 30 g CH20 + CarbonAssim = PhotosynTotal * 12.0e-6 !*IndexPlanting !umol co2 /m2/ s -> g/m2/s C + CarbohydrAssim = PhotosynTotal * 30.0e-6 !*IndexPlanting !umol co2 /m2/ s -> g/m2/s CH2O + + ! mainteinance respiration + RespFacNitrogenFoliage = min(NitrogenConcFoliage / max(1.0e-06, NitrogenConcFoliageMax), 1.0) + RespFacTemperature = RespMaintQ10**((TemperatureCanopy - 298.16) / 10.0) + RespirationLeaf = RespMaintLeaf25C * RespFacTemperature * RespFacNitrogenFoliage * & + LeafAreaIndex * (1.0 - SoilWaterStress) ! umolCO2/m2/s + RespirationLeafMaint = min((LeafMass - LeafMassMin) / MainTimeStep, RespirationLeaf*30.0e-6) ! gCH2O/m2/s + RespirationRoot = RespMaintRoot25C * (RootMass * 1.0e-3) * RespFacTemperature * 30.0e-6 ! gCH2O/m2/s + RespirationStem = RespMaintStem25C * (StemMass * 1.0e-3) * RespFacTemperature * 30.0e-6 ! gCH2O/m2/s + RespirationGrain = RespMaintGrain25C * (GrainMass * 1.0e-3) * RespFacTemperature * 30.0e-6 ! gCH2O/m2/s + + ! calculate growth respiration for leaf, root and grain + GrowthRespLeaf = max(0.0, GrowthRespFrac * (CarbohydrFracToLeaf(PlantGrowStage)*CarbohydrAssim - RespirationLeafMaint)) ! gCH2O/m2/s + GrowthRespStem = max(0.0, GrowthRespFrac * (CarbohydrFracToStem(PlantGrowStage)*CarbohydrAssim - RespirationStem)) ! gCH2O/m2/s + GrowthRespRoot = max(0.0, GrowthRespFrac * (CarbohydrFracToRoot(PlantGrowStage)*CarbohydrAssim - RespirationRoot)) ! gCH2O/m2/s + GrowthRespGrain = max(0.0, GrowthRespFrac * (CarbohydrFracToGrain(PlantGrowStage)*CarbohydrAssim - RespirationGrain)) ! gCH2O/m2/s + + ! leaf turnover, stem turnover, root turnover and leaf death caused by soil water and soil temperature stress + TurnoverLeaf = TurnoverCoeffLeafCrop(PlantGrowStage) * 1.0e-6 * LeafMass ! gCH2O/m2/s + TurnoverRoot = TurnoverCoeffRootCrop(PlantGrowStage) * 1.0e-6 * RootMass ! gCH2O/m2/s + TurnoverStem = TurnoverCoeffStemCrop(PlantGrowStage) * 1.0e-6 * StemMass ! gCH2O/m2/s + DeathCoeffTemp = exp(-0.3 * max(0.0, TemperatureCanopy-TemperaureLeafFreeze)) * (LeafMass/120.0) + DeathCoeffWater = exp((SoilWaterStress - 1.0) * WaterStressCoeff) + DeathLeaf = LeafMass * 1.0e-6 * (LeafDeathWaterCoeffCrop(PlantGrowStage) * DeathCoeffWater + & + LeafDeathTempCoeffCrop(PlantGrowStage) * DeathCoeffTemp) ! gCH2O/m2/s + + ! Allocation of CarbohydrAssim to leaf, stem, root and grain at each growth stage + !NetPriProdLeafAdd = max(0.0, CarbohydrFracToLeaf(PlantGrowStage)*CarbohydrAssim - GrowthRespLeaf - RespirationLeafMaint) ! gCH2O/m2/s + NetPriProdLeafAdd = CarbohydrFracToLeaf(PlantGrowStage)*CarbohydrAssim - GrowthRespLeaf - RespirationLeafMaint ! gCH2O/m2/s + !NetPriProdStemAdd = max(0.0, CarbohydrFracToStem(PlantGrowStage)*CarbohydrAssim - GrowthRespStem - RespirationStem) ! gCH2O/m2/s + NetPriProdStemAdd = CarbohydrFracToStem(PlantGrowStage)*CarbohydrAssim - GrowthRespStem - RespirationStem ! gCH2O/m2/s + + ! avoid reducing leaf mass below its minimum value but conserve mass + LeafMassMaxChg = (LeafMass - LeafMassMin) / MainTimeStep ! gCH2O/m2/s + StemMassMaxChg = (StemMass - StemMassMin) / MainTimeStep ! gCH2O/m2/s + TurnoverLeaf = min(TurnoverLeaf, LeafMassMaxChg+NetPriProdLeafAdd) ! gCH2O/m2/s + TurnoverStem = min(TurnoverStem, StemMassMaxChg+NetPriProdStemAdd) ! gCH2O/m2/s + DeathLeaf = min(DeathLeaf, LeafMassMaxChg+NetPriProdLeafAdd-TurnoverLeaf) ! gCH2O/m2/s + + ! net primary productivities + !NetPriProductionLeaf = max(NetPriProdLeafAdd, -LeafMassMaxChg) ! gCH2O/m2/s + NetPriProductionLeaf = NetPriProdLeafAdd ! gCH2O/m2/s + !NetPriProductionStem = max(NetPriProdStemAdd, -StemMassMaxChg) ! gCH2O/m2/s + NetPriProductionStem = NetPriProdStemAdd ! gCH2O/m2/s + NetPriProductionRoot = CarbohydrFracToRoot(PlantGrowStage) * CarbohydrAssim - RespirationRoot - GrowthRespRoot ! gCH2O/m2/s + NetPriProductionGrain = CarbohydrFracToGrain(PlantGrowStage) * CarbohydrAssim - RespirationGrain - GrowthRespGrain ! gCH2O/m2/s + + ! masses of plant components + LeafMass = LeafMass + (NetPriProductionLeaf - TurnoverLeaf - DeathLeaf) * MainTimeStep ! gCH2O/m2 + StemMass = StemMass + (NetPriProductionStem - TurnoverStem) * MainTimeStep ! gCH2O/m2 + RootMass = RootMass + (NetPriProductionRoot - TurnoverRoot) * MainTimeStep ! gCH2O/m2 + GrainMass = GrainMass + NetPriProductionGrain * MainTimeStep ! gCH2O/m2 + GrossPriProduction = CarbohydrAssim * 0.4 ! gC/m2/s 0.4=12/30, CH20 to C + + ! carbon convert to grain ! Zhe Zhang 2020-07-13 + ConvLeafToGrain = 0.0 + ConvStemToGrain = 0.0 + ConvRootToGrain = 0.0 + ConvLeafToGrain = LeafMass * (CarbohydrLeafToGrain(PlantGrowStage) * MainTimeStep / 3600.0) ! gCH2O/m2 + ConvStemToGrain = StemMass * (CarbohydrStemToGrain(PlantGrowStage) * MainTimeStep / 3600.0) ! gCH2O/m2 + ConvRootToGrain = RootMass * (CarbohydrRootToGrain(PlantGrowStage) * MainTimeStep / 3600.0) ! gCH2O/m2 + LeafMass = LeafMass - ConvLeafToGrain ! gCH2O/m2 + StemMass = StemMass - ConvStemToGrain ! gCH2O/m2 + RootMass = RootMass - ConvRootToGrain ! gCH2O/m2 + GrainMass = GrainMass + ConvStemToGrain + ConvRootToGrain + ConvLeafToGrain ! gCH2O/m2 + !if ( PlantGrowStage==6 ) then + ! ConvStemToGrain = StemMass * (0.00005 * MainTimeStep / 3600.0) ! gCH2O/m2 + ! StemMass = StemMass - ConvStemToGrain ! gCH2O/m2 + ! ConvRootToGrain = RootMass * (0.0005 * MainTimeStep / 3600.0) ! gCH2O/m2 + ! RootMass = RootMass - ConvRootToGrain ! gCH2O/m2 + ! GrainMass = GrainMass + ConvStemToGrain + ConvRootToGrain ! gCH2O/m2 + !endif + + if ( RootMass < 0.0 ) then + TurnoverRoot = NetPriProductionRoot + RootMass = 0.0 + endif + if ( GrainMass < 0.0 ) then + GrainMass = 0.0 + endif + + ! soil carbon budgets + !if ( (PlantGrowStage == 1) .or. (PlantGrowStage == 2) .or. (PlantGrowStage == 8) ) then + ! CarbonMassShallowSoil = 1000 + !else + CarbonMassShallowSoil = CarbonMassShallowSoil + & + (TurnoverRoot+TurnoverLeaf+TurnoverStem+DeathLeaf) * MainTimeStep * 0.4 ! 0.4: gCH2O/m2 -> gC/m2 + !endif + MicroRespFactorSoilTemp = 2.0**((TemperatureSoilSnow(1) - 283.16) / 10.0) + MicroRespFactorSoilWater = SoilWaterRootZone / (0.20 + SoilWaterRootZone) * 0.23 / (0.23 + SoilWaterRootZone) + RespirationSoil = MicroRespFactorSoilWater * MicroRespFactorSoilTemp * & + MicroRespCoeff * max(0.0, CarbonMassShallowSoil*1.0e-3) * 30.0e-6 ! gCH2O/m2/s + CarbonDecayToStable = 0.1 * RespirationSoil ! gCH2O/m2/s + CarbonMassShallowSoil = CarbonMassShallowSoil - (RespirationSoil + CarbonDecayToStable) * MainTimeStep * 0.4 ! 0.4: gCH2O/m2 -> gC/m2 + CarbonMassDeepSoil = CarbonMassDeepSoil + CarbonDecayToStable * MainTimeStep * 0.4 ! 0.4: gCH2O/m2 -> gC/m2 + + ! total carbon flux + CarbonToAtmos = - CarbonAssim + (RespirationLeafMaint + RespirationRoot + RespirationStem + RespirationGrain + & + 0.9*RespirationSoil + GrowthRespLeaf + GrowthRespRoot + GrowthRespStem + GrowthRespGrain) * 0.4 ! gC/m2/s 0.4=12/30, CH20 to C + + ! for outputs + NetPriProductionTot = (NetPriProductionLeaf + NetPriProductionStem + & + NetPriProductionRoot + NetPriProductionGrain) * 0.4 ! gC/m2/s 0.4=12/30, CH20 to C + RespirationPlantTot = (RespirationRoot + RespirationGrain + RespirationLeafMaint + RespirationStem + & + GrowthRespLeaf + GrowthRespRoot + GrowthRespGrain + GrowthRespStem) * 0.4 ! gC/m2/s 0.4=12/30, CH20 to C + RespirationSoilOrg = 0.9 * RespirationSoil * 0.4 ! gC/m2/s 0.4=12/30, CH20 to C + NetEcoExchange = (RespirationPlantTot + RespirationSoilOrg - GrossPriProduction) * 44.0 / 12.0 ! gCO2/m2/s + CarbonMassSoilTot = CarbonMassShallowSoil + CarbonMassDeepSoil ! gC/m2 + CarbonMassLiveTot = (LeafMass + RootMass + StemMass + GrainMass) * 0.4 ! gC/m2 0.4=12/30, CH20 to C + + ! leaf area index and stem area index + LeafAreaIndex = max(LeafMass*LeafAreaPerBiomass, LeafAreaIndexMin) + StemAreaIndex = max(StemMass*StemAreaPerMass, StemAreaIndexMin) + + ! After harversting + !if ( PlantGrowStage == 8 ) then + ! LeafMass = 0.62 + ! StemMass = 0.0 + ! GrainMass = 0.0 + !endif + + !if ( (PlantGrowStage == 1) .or. (PlantGrowStage == 2) .or. (PlantGrowStage == 8) ) then + if ( (PlantGrowStage == 8) .and. & + ((GrainMass > 0) .or. (LeafMass > 0) .or. (StemMass > 0) .or. (RootMass > 0)) ) then + LeafAreaIndex = 0.05 + StemAreaIndex = 0.05 + LeafMass = LeafMassMin + StemMass = StemMassMin + RootMass = 0.0 + GrainMass = 0.0 + endif + + end associate + + end subroutine CarbonFluxCrop + +end module CarbonFluxCropMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/CarbonFluxNatureVegMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/CarbonFluxNatureVegMod.F90 new file mode 100644 index 000000000..38dc8b079 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/CarbonFluxNatureVegMod.F90 @@ -0,0 +1,248 @@ +module CarbonFluxNatureVegMod + +!!! Main Carbon assimilation for natural/generic vegetation +!!! based on RE Dickinson et al.(1998), modifed by Guo-Yue Niu, 2004 + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine CarbonFluxNatureVeg(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: CO2FLUX +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variables + real(kind=kind_noahmp) :: DeathCoeffTemp ! temperature stress death coefficient + real(kind=kind_noahmp) :: DeathCoeffWater ! water stress death coefficient + real(kind=kind_noahmp) :: NetPriProdLeafAdd ! leaf assimil after resp. losses removed [gC/m2/s] + real(kind=kind_noahmp) :: NetPriProdStemAdd ! stem assimil after resp. losses removed [gC/m2/s] + real(kind=kind_noahmp) :: RespTmp, Temp0 ! temperary vars for function below + RespTmp(Temp0) = exp(0.08 * (Temp0 - 298.16)) ! Respiration as a function of temperature + +!------------------------------------------------------------------------ + associate( & + VegType => noahmp%config%domain%VegType ,& ! in, vegetation type + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, main noahmp timestep [s] + IndexEBLForest => noahmp%config%domain%IndexEBLForest ,& ! in, flag for Evergreen Broadleaf Forest + WoodToRootRatio => noahmp%biochem%param%WoodToRootRatio ,& ! in, wood to root ratio + TurnoverCoeffLeafVeg => noahmp%biochem%param%TurnoverCoeffLeafVeg ,& ! in, leaf turnover coefficient [1/s] for generic vegetation + TemperaureLeafFreeze => noahmp%biochem%param%TemperaureLeafFreeze ,& ! in, characteristic temperature for leaf freezing [K] + LeafDeathWaterCoeffVeg => noahmp%biochem%param%LeafDeathWaterCoeffVeg ,& ! in, coeficient for leaf water stress death [1/s] for generic veg + LeafDeathTempCoeffVeg => noahmp%biochem%param%LeafDeathTempCoeffVeg ,& ! in, coeficient for leaf temp. stress death [1/s] for generic veg + GrowthRespFrac => noahmp%biochem%param%GrowthRespFrac ,& ! in, fraction of growth respiration + TemperatureMinPhotosyn => noahmp%biochem%param%TemperatureMinPhotosyn ,& ! in, minimum temperature for photosynthesis [K] + MicroRespCoeff => noahmp%biochem%param%MicroRespCoeff ,& ! in, microbial respiration parameter [umol CO2/kgC/s] + NitrogenConcFoliageMax => noahmp%biochem%param%NitrogenConcFoliageMax ,& ! in, foliage nitrogen concentration when f(n)=1 (%) + RespMaintQ10 => noahmp%biochem%param%RespMaintQ10 ,& ! in, q10 for maintenance respiration + RespMaintLeaf25C => noahmp%biochem%param%RespMaintLeaf25C ,& ! in, leaf maintenance respiration at 25c [umol CO2/m2/s] + RespMaintRoot25C => noahmp%biochem%param%RespMaintRoot25C ,& ! in, root maintenance respiration at 25c [umol CO2/kgC/s] + RespMaintStem25C => noahmp%biochem%param%RespMaintStem25C ,& ! in, stem maintenance respiration at 25c [umol CO2/kgC/s] + WoodPoolIndex => noahmp%biochem%param%WoodPoolIndex ,& ! in, wood pool index (0~1) depending on woody or not + TurnoverCoeffRootVeg => noahmp%biochem%param%TurnoverCoeffRootVeg ,& ! in, root turnover coefficient [1/s] for generic vegetation + WoodRespCoeff => noahmp%biochem%param%WoodRespCoeff ,& ! in, wood respiration coeficient [1/s] + WoodAllocFac => noahmp%biochem%param%WoodAllocFac ,& ! in, parameter for present wood allocation + WaterStressCoeff => noahmp%biochem%param%WaterStressCoeff ,& ! in, water stress coeficient + LeafAreaIndexMin => noahmp%biochem%param%LeafAreaIndexMin ,& ! in, minimum leaf area index [m2/m2] + StemAreaIndexMin => noahmp%biochem%param%StemAreaIndexMin ,& ! in, minimum stem area index [m2/m2] + IndexGrowSeason => noahmp%biochem%state%IndexGrowSeason ,& ! in, growing season index (0=off, 1=on) + NitrogenConcFoliage => noahmp%biochem%state%NitrogenConcFoliage ,& ! in, foliage nitrogen concentration [%] + LeafAreaPerMass => noahmp%biochem%state%LeafAreaPerMass ,& ! in, leaf area per unit mass [m2/g] + PhotosynTotal => noahmp%biochem%flux%PhotosynTotal ,& ! in, total leaf photosynthesis [umolCO2/m2/s] + SoilWaterRootZone => noahmp%water%state%SoilWaterRootZone ,& ! in, root zone soil water + SoilWaterStress => noahmp%water%state%SoilWaterStress ,& ! in, water stress coeficient (1.0 for wilting) + TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow ,& ! in, snow and soil layer temperature [K] + TemperatureCanopy => noahmp%energy%state%TemperatureCanopy ,& ! in, vegetation temperature [K] + LeafAreaIndex => noahmp%energy%state%LeafAreaIndex ,& ! inout, leaf area index + StemAreaIndex => noahmp%energy%state%StemAreaIndex ,& ! inout, stem area index + LeafMass => noahmp%biochem%state%LeafMass ,& ! inout, leaf mass [gC/m2] + RootMass => noahmp%biochem%state%RootMass ,& ! inout, mass of fine roots [gC/m2] + StemMass => noahmp%biochem%state%StemMass ,& ! inout, stem mass [gC/m2] + WoodMass => noahmp%biochem%state%WoodMass ,& ! inout, mass of wood (incl. woody roots) [gC/m2] + CarbonMassDeepSoil => noahmp%biochem%state%CarbonMassDeepSoil ,& ! inout, stable carbon in deep soil [gC/m2] + CarbonMassShallowSoil => noahmp%biochem%state%CarbonMassShallowSoil ,& ! inout, short-lived carbon in shallow soil [gC/m2] + CarbonMassSoilTot => noahmp%biochem%state%CarbonMassSoilTot ,& ! out, total soil carbon [gC/m2] + CarbonMassLiveTot => noahmp%biochem%state%CarbonMassLiveTot ,& ! out, total living carbon ([gC/m2] + LeafMassMin => noahmp%biochem%state%LeafMassMin ,& ! out, minimum leaf mass [gC/m2] + CarbonFracToLeaf => noahmp%biochem%state%CarbonFracToLeaf ,& ! out, fraction of carbon allocated to leaves + WoodCarbonFrac => noahmp%biochem%state%WoodCarbonFrac ,& ! out, calculated wood to root ratio + CarbonFracToWoodRoot => noahmp%biochem%state%CarbonFracToWoodRoot ,& ! out, fraction of carbon to root and wood + CarbonFracToRoot => noahmp%biochem%state%CarbonFracToRoot ,& ! out, fraction of carbon flux to roots + CarbonFracToWood => noahmp%biochem%state%CarbonFracToWood ,& ! out, fraction of carbon flux to wood + CarbonFracToStem => noahmp%biochem%state%CarbonFracToStem ,& ! out, fraction of carbon flux to stem + MicroRespFactorSoilWater => noahmp%biochem%state%MicroRespFactorSoilWater ,& ! out, soil water factor for microbial respiration + MicroRespFactorSoilTemp => noahmp%biochem%state%MicroRespFactorSoilTemp ,& ! out, soil temperature factor for microbial respiration + RespFacNitrogenFoliage => noahmp%biochem%state%RespFacNitrogenFoliage ,& ! out, foliage nitrogen adjustemt to respiration (<= 1) + RespFacTemperature => noahmp%biochem%state%RespFacTemperature ,& ! out, temperature factor + RespReductionFac => noahmp%biochem%state%RespReductionFac ,& ! out, respiration reduction factor (<= 1) + StemMassMin => noahmp%biochem%state%StemMassMin ,& ! out, minimum stem mass [gC/m2] + StemAreaPerMass => noahmp%biochem%state%StemAreaPerMass ,& ! out, stem area per unit mass [m2/g] + CarbonAssim => noahmp%biochem%flux%CarbonAssim ,& ! out, carbon assimilated rate [gC/m2/s] + GrossPriProduction => noahmp%biochem%flux%GrossPriProduction ,& ! out, gross primary production [gC/m2/s] + NetPriProductionTot => noahmp%biochem%flux%NetPriProductionTot ,& ! out, total net primary productivity [gC/m2/s] + NetEcoExchange => noahmp%biochem%flux%NetEcoExchange ,& ! out, net ecosystem exchange [gCO2/m2/s] + RespirationPlantTot => noahmp%biochem%flux%RespirationPlantTot ,& ! out, total plant respiration [gC/m2/s] + RespirationSoilOrg => noahmp%biochem%flux%RespirationSoilOrg ,& ! out, soil organic respiration [gC/m2/s] + CarbonToAtmos => noahmp%biochem%flux%CarbonToAtmos ,& ! out, carbon flux to atmosphere [gC/m2/s] + NetPriProductionLeaf => noahmp%biochem%flux%NetPriProductionLeaf ,& ! out, leaf net primary productivity [gC/m2/s] + NetPriProductionRoot => noahmp%biochem%flux%NetPriProductionRoot ,& ! out, root net primary productivity [gC/m2/s] + NetPriProductionWood => noahmp%biochem%flux%NetPriProductionWood ,& ! out, wood net primary productivity [gC/m2/s] + NetPriProductionStem => noahmp%biochem%flux%NetPriProductionStem ,& ! out, stem net primary productivity [gC/m2/s] + GrowthRespLeaf => noahmp%biochem%flux%GrowthRespLeaf ,& ! out, growth respiration rate for leaf [gC/m2/s] + GrowthRespRoot => noahmp%biochem%flux%GrowthRespRoot ,& ! out, growth respiration rate for root [gC/m2/s] + GrowthRespWood => noahmp%biochem%flux%GrowthRespWood ,& ! out, growth respiration rate for wood [gC/m2/s] + GrowthRespStem => noahmp%biochem%flux%GrowthRespStem ,& ! out, growth respiration rate for stem [gC/m2/s] + LeafMassMaxChg => noahmp%biochem%flux%LeafMassMaxChg ,& ! out, maximum leaf mass available to change [gC/m2/s] + CarbonDecayToStable => noahmp%biochem%flux%CarbonDecayToStable ,& ! out, decay rate of fast carbon to slow carbon [gC/m2/s] + RespirationLeaf => noahmp%biochem%flux%RespirationLeaf ,& ! out, leaf respiration rate [umol CO2/m2/s] + RespirationStem => noahmp%biochem%flux%RespirationStem ,& ! out, stem respiration rate [gC/m2/s] + RespirationWood => noahmp%biochem%flux%RespirationWood ,& ! out, wood respiration rate [gC/m2/s] + RespirationLeafMaint => noahmp%biochem%flux%RespirationLeafMaint ,& ! out, leaf maintenance respiration rate [gC/m2/s] + RespirationRoot => noahmp%biochem%flux%RespirationRoot ,& ! out, fine root respiration rate [gC/m2/s] + RespirationSoil => noahmp%biochem%flux%RespirationSoil ,& ! out, soil respiration rate [gC/m2/s] + DeathLeaf => noahmp%biochem%flux%DeathLeaf ,& ! out, death rate of leaf mass [gC/m2/s] + DeathStem => noahmp%biochem%flux%DeathStem ,& ! out, death rate of stem mass [gC/m2/s] + TurnoverLeaf => noahmp%biochem%flux%TurnoverLeaf ,& ! out, leaf turnover rate [gC/m2/s] + TurnoverStem => noahmp%biochem%flux%TurnoverStem ,& ! out, stem turnover rate [gC/m2/s] + TurnoverWood => noahmp%biochem%flux%TurnoverWood ,& ! out, wood turnover rate [gC/m2/s] + TurnoverRoot => noahmp%biochem%flux%TurnoverRoot ,& ! out, root turnover rate [gC/m2/s] + StemMassMaxChg => noahmp%biochem%flux%StemMassMaxChg & ! out, maximum steam mass available to change [gC/m2/s] + ) +!----------------------------------------------------------------------- + + ! initialization + StemAreaPerMass = 3.0 * 0.001 ! m2/kg -->m2/g + LeafMassMin = LeafAreaIndexMin / LeafAreaPerMass ! gC/m2 + StemMassMin = StemAreaIndexMin / StemAreaPerMass ! gC/m2 + + ! respiration + if ( IndexGrowSeason == 0.0 ) then + RespReductionFac = 0.5 + else + RespReductionFac = 1.0 + endif + RespFacNitrogenFoliage = min(NitrogenConcFoliage / max(1.0e-06,NitrogenConcFoliageMax), 1.0) + RespFacTemperature = RespMaintQ10**((TemperatureCanopy - 298.16) / 10.0) + RespirationLeaf = RespMaintLeaf25C * RespFacTemperature * RespFacNitrogenFoliage * & + LeafAreaIndex * RespReductionFac * (1.0 - SoilWaterStress) ! umol CO2/m2/s + RespirationLeafMaint = min((LeafMass-LeafMassMin)/MainTimeStep, RespirationLeaf*12.0e-6) ! gC/m2/s + RespirationRoot = RespMaintRoot25C * (RootMass*1.0e-3) * RespFacTemperature * RespReductionFac * 12.0e-6 ! gC/m2/s + RespirationStem = RespMaintStem25C * ((StemMass-StemMassMin) * 1.0e-3) * & + RespFacTemperature * RespReductionFac * 12.0e-6 ! gC/m2/s + RespirationWood = WoodRespCoeff * RespTmp(TemperatureCanopy) * WoodMass * WoodPoolIndex ! gC/m2/s + + !!! carbon assimilation start + ! 1 mole -> 12 g carbon or 44 g CO2; 1 umol -> 12.e-6 g carbon; + CarbonAssim = PhotosynTotal * 12.0e-6 ! umol CO2/m2/s -> gC/m2/s + + ! fraction of carbon into leaf versus nonleaf + CarbonFracToLeaf = exp(0.01 * (1.0 - exp(0.75*LeafAreaIndex)) * LeafAreaIndex) + if ( VegType == IndexEBLForest ) CarbonFracToLeaf = exp(0.01 * (1.0 - exp(0.50*LeafAreaIndex)) * LeafAreaIndex) + CarbonFracToWoodRoot = 1.0 - CarbonFracToLeaf + CarbonFracToStem = LeafAreaIndex / 10.0 * CarbonFracToLeaf + CarbonFracToLeaf = CarbonFracToLeaf - CarbonFracToStem + + ! fraction of carbon into wood versus root + if ( WoodMass > 1.0e-6 ) then + WoodCarbonFrac = (1.0 - exp(-WoodAllocFac * (WoodToRootRatio*RootMass/WoodMass)) / WoodAllocFac) * WoodPoolIndex + else + WoodCarbonFrac = WoodPoolIndex + endif + CarbonFracToRoot = CarbonFracToWoodRoot * (1.0 - WoodCarbonFrac) + CarbonFracToWood = CarbonFracToWoodRoot * WoodCarbonFrac + + ! leaf and root turnover per time step + TurnoverLeaf = TurnoverCoeffLeafVeg * 5.0e-7 * LeafMass ! gC/m2/s + TurnoverStem = TurnoverCoeffLeafVeg * 5.0e-7 * StemMass ! gC/m2/s + TurnoverRoot = TurnoverCoeffRootVeg * RootMass ! gC/m2/s + TurnoverWood = 9.5e-10 * WoodMass ! gC/m2/s + + ! seasonal leaf die rate dependent on temp and water stress + ! water stress is set to 1 at permanent wilting point + DeathCoeffTemp = exp(-0.3 * max(0.0, TemperatureCanopy-TemperaureLeafFreeze)) * (LeafMass / 120.0) + DeathCoeffWater = exp((SoilWaterStress - 1.0) * WaterStressCoeff) + DeathLeaf = LeafMass * 1.0e-6 * (LeafDeathWaterCoeffVeg * DeathCoeffWater + LeafDeathTempCoeffVeg * DeathCoeffTemp) ! gC/m2/s + DeathStem = StemMass * 1.0e-6 * (LeafDeathWaterCoeffVeg * DeathCoeffWater + LeafDeathTempCoeffVeg * DeathCoeffTemp) ! gC/m2/s + + ! calculate growth respiration for leaf, root and wood + GrowthRespLeaf = max(0.0, GrowthRespFrac * (CarbonFracToLeaf*CarbonAssim - RespirationLeafMaint)) ! gC/m2/s + GrowthRespStem = max(0.0, GrowthRespFrac * (CarbonFracToStem*CarbonAssim - RespirationStem)) ! gC/m2/s + GrowthRespRoot = max(0.0, GrowthRespFrac * (CarbonFracToRoot*CarbonAssim - RespirationRoot)) ! gC/m2/s + GrowthRespWood = max(0.0, GrowthRespFrac * (CarbonFracToWood*CarbonAssim - RespirationWood)) ! gC/m2/s + + ! Impose lower T limit for photosynthesis + NetPriProdLeafAdd = max(0.0, CarbonFracToLeaf*CarbonAssim - GrowthRespLeaf - RespirationLeafMaint) ! gC/m2/s + NetPriProdStemAdd = max(0.0, CarbonFracToStem*CarbonAssim - GrowthRespStem - RespirationStem) ! gC/m2/s + !NetPriProdLeafAdd = CarbonFracToLeaf*CarbonAssim - GrowthRespLeaf - RespirationLeafMaint ! MB: test Kjetil + !NetPriProdStemAdd = CarbonFracToStem*CarbonAssim - GrowthRespStem - RespirationStem ! MB: test Kjetil + if ( TemperatureCanopy < TemperatureMinPhotosyn ) NetPriProdLeafAdd = 0.0 + if ( TemperatureCanopy < TemperatureMinPhotosyn ) NetPriProdStemAdd = 0.0 + + ! update leaf, root, and wood carbon + ! avoid reducing leaf mass below its minimum value but conserve mass + LeafMassMaxChg = (LeafMass - LeafMassMin) / MainTimeStep ! gC/m2/s + StemMassMaxChg = (StemMass - StemMassMin) / MainTimeStep ! gC/m2/s + DeathLeaf = min(DeathLeaf, LeafMassMaxChg+NetPriProdLeafAdd-TurnoverLeaf) ! gC/m2/s + DeathStem = min(DeathStem, StemMassMaxChg+NetPriProdStemAdd-TurnoverStem) ! gC/m2/s + + ! net primary productivities + NetPriProductionLeaf = max(NetPriProdLeafAdd, -LeafMassMaxChg) ! gC/m2/s + NetPriProductionStem = max(NetPriProdStemAdd, -StemMassMaxChg) ! gC/m2/s + NetPriProductionRoot = CarbonFracToRoot * CarbonAssim - RespirationRoot - GrowthRespRoot ! gC/m2/s + NetPriProductionWood = CarbonFracToWood * CarbonAssim - RespirationWood - GrowthRespWood ! gC/m2/s + + ! masses of plant components + LeafMass = LeafMass + (NetPriProductionLeaf - TurnoverLeaf - DeathLeaf) * MainTimeStep ! gC/m2 + StemMass = StemMass + (NetPriProductionStem - TurnoverStem - DeathStem) * MainTimeStep ! gC/m2 + RootMass = RootMass + (NetPriProductionRoot - TurnoverRoot) * MainTimeStep ! gC/m2 + if ( RootMass < 0.0 ) then + TurnoverRoot = NetPriProductionRoot + RootMass = 0.0 + endif + WoodMass = (WoodMass + (NetPriProductionWood - TurnoverWood) * MainTimeStep ) * WoodPoolIndex ! gC/m2 + + ! soil carbon budgets + CarbonMassShallowSoil = CarbonMassShallowSoil + & + (TurnoverRoot+TurnoverLeaf+TurnoverStem+TurnoverWood+DeathLeaf+DeathStem) * MainTimeStep ! gC/m2, MB: add DeathStem v3.7 + MicroRespFactorSoilTemp = 2.0**( (TemperatureSoilSnow(1) - 283.16) / 10.0 ) + MicroRespFactorSoilWater = SoilWaterRootZone / (0.20 + SoilWaterRootZone) * 0.23 / (0.23 + SoilWaterRootZone) + RespirationSoil = MicroRespFactorSoilWater * MicroRespFactorSoilTemp * & + MicroRespCoeff * max(0.0, CarbonMassShallowSoil*1.0e-3) * 12.0e-6 ! gC/m2/s + CarbonDecayToStable = 0.1 * RespirationSoil ! gC/m2/s + CarbonMassShallowSoil = CarbonMassShallowSoil - (RespirationSoil + CarbonDecayToStable) * MainTimeStep ! gC/m2 + CarbonMassDeepSoil = CarbonMassDeepSoil + CarbonDecayToStable * MainTimeStep ! gC/m2 + + ! total carbon flux ! MB: add RespirationStem,GrowthRespStem,0.9*RespirationSoil v3.7 + CarbonToAtmos = - CarbonAssim + RespirationLeafMaint + RespirationRoot + RespirationWood + RespirationStem + & + 0.9*RespirationSoil + GrowthRespLeaf + GrowthRespRoot + GrowthRespWood + GrowthRespStem ! gC/m2/s + + ! for outputs ! MB: add RespirationStem, GrowthRespStem in RespirationPlantTot v3.7 + GrossPriProduction = CarbonAssim ! gC/m2/s + NetPriProductionTot = NetPriProductionLeaf + NetPriProductionWood + NetPriProductionRoot + NetPriProductionStem ! gC/m2/s + RespirationPlantTot = RespirationRoot + RespirationWood + RespirationLeafMaint + RespirationStem + & + GrowthRespLeaf + GrowthRespRoot + GrowthRespWood + GrowthRespStem ! gC/m2/s + RespirationSoilOrg = 0.9 * RespirationSoil ! gC/m2/s MB: add 0.9* v3.7 + NetEcoExchange = (RespirationPlantTot + RespirationSoilOrg - GrossPriProduction) * 44.0 / 12.0 ! gCO2/m2/s + CarbonMassSoilTot = CarbonMassShallowSoil + CarbonMassDeepSoil ! gC/m2 + CarbonMassLiveTot = LeafMass + RootMass + StemMass + WoodMass ! gC/m2 MB: add StemMass v3.7 + + ! leaf area index and stem area index + LeafAreaIndex = max(LeafMass*LeafAreaPerMass, LeafAreaIndexMin) + StemAreaIndex = max(StemMass*StemAreaPerMass, StemAreaIndexMin) + + end associate + + end subroutine CarbonFluxNatureVeg + +end module CarbonFluxNatureVegMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/ConfigVarInitMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/ConfigVarInitMod.F90 new file mode 100644 index 000000000..5c8af537b --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/ConfigVarInitMod.F90 @@ -0,0 +1,89 @@ +module ConfigVarInitMod + +!!! Initialize column (1-D) Noah-MP configuration variables +!!! Configuration variables should be first defined in ConfigVarType.F90 + +! ------------------------ Code history ------------------------------------ +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! -------------------------------------------------------------------------- + + use Machine + use NoahmpVarType + + implicit none + +contains + +!=== initialize with default values + subroutine ConfigVarInitDefault(noahmp) + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + + ! config namelist variable + noahmp%config%nmlist%OptDynamicVeg = undefined_int + noahmp%config%nmlist%OptRainSnowPartition = undefined_int + noahmp%config%nmlist%OptSoilWaterTranspiration = undefined_int + noahmp%config%nmlist%OptGroundResistanceEvap = undefined_int + noahmp%config%nmlist%OptSurfaceDrag = undefined_int + noahmp%config%nmlist%OptStomataResistance = undefined_int + noahmp%config%nmlist%OptSnowAlbedo = undefined_int + noahmp%config%nmlist%OptCanopyRadiationTransfer = undefined_int + noahmp%config%nmlist%OptSnowSoilTempTime = undefined_int + noahmp%config%nmlist%OptSnowThermConduct = undefined_int + noahmp%config%nmlist%OptSoilTemperatureBottom = undefined_int + noahmp%config%nmlist%OptSoilSupercoolWater = undefined_int + noahmp%config%nmlist%OptRunoffSurface = undefined_int + noahmp%config%nmlist%OptRunoffSubsurface = undefined_int + noahmp%config%nmlist%OptSoilPermeabilityFrozen = undefined_int + noahmp%config%nmlist%OptDynVicInfiltration = undefined_int + noahmp%config%nmlist%OptTileDrainage = undefined_int + noahmp%config%nmlist%OptIrrigation = undefined_int + noahmp%config%nmlist%OptIrrigationMethod = undefined_int + noahmp%config%nmlist%OptCropModel = undefined_int + noahmp%config%nmlist%OptSoilProperty = undefined_int + noahmp%config%nmlist%OptPedotransfer = undefined_int + noahmp%config%nmlist%OptGlacierTreatment = undefined_int + + ! config domain variable + noahmp%config%domain%LandUseDataName = "MODIFIED_IGBP_MODIS_NOAH" + noahmp%config%domain%FlagUrban = .false. + noahmp%config%domain%FlagCropland = .false. + noahmp%config%domain%FlagDynamicCrop = .false. + noahmp%config%domain%FlagDynamicVeg = .false. + noahmp%config%domain%FlagSoilProcess = .false. + noahmp%config%domain%NumSoilTimeStep = undefined_int + noahmp%config%domain%NumSnowLayerMax = undefined_int + noahmp%config%domain%NumSnowLayerNeg = undefined_int + noahmp%config%domain%NumSoilLayer = undefined_int + noahmp%config%domain%GridIndexI = undefined_int + noahmp%config%domain%GridIndexJ = undefined_int + noahmp%config%domain%VegType = undefined_int + noahmp%config%domain%CropType = undefined_int + noahmp%config%domain%SurfaceType = undefined_int + noahmp%config%domain%NumSwRadBand = undefined_int + noahmp%config%domain%SoilColor = undefined_int + noahmp%config%domain%IndicatorIceSfc = undefined_int + noahmp%config%domain%NumCropGrowStage = undefined_int + noahmp%config%domain%IndexWaterPoint = undefined_int + noahmp%config%domain%IndexBarrenPoint = undefined_int + noahmp%config%domain%IndexIcePoint = undefined_int + noahmp%config%domain%IndexCropPoint = undefined_int + noahmp%config%domain%IndexEBLForest = undefined_int + noahmp%config%domain%NumDayInYear = undefined_int + noahmp%config%domain%RunoffSlopeType = undefined_int + noahmp%config%domain%MainTimeStep = undefined_real + noahmp%config%domain%SoilTimeStep = undefined_real + noahmp%config%domain%GridSize = undefined_real + noahmp%config%domain%DayJulianInYear = undefined_real + noahmp%config%domain%CosSolarZenithAngle = undefined_real + noahmp%config%domain%RefHeightAboveSfc = undefined_real + noahmp%config%domain%ThicknessAtmosBotLayer = undefined_real + noahmp%config%domain%Latitude = undefined_real + noahmp%config%domain%DepthSoilTempBottom = undefined_real + + end subroutine ConfigVarInitDefault + +end module ConfigVarInitMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/ConfigVarType.F90 b/src/core_atmosphere/physics/physics_noahmp/src/ConfigVarType.F90 new file mode 100644 index 000000000..dc7979f3c --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/ConfigVarType.F90 @@ -0,0 +1,183 @@ +module ConfigVarType + +!!! Define column (1-D) Noah-MP configuration variables +!!! Configuration variable initialization is done in ConfigVarInitMod.F90 + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use Machine + + implicit none + save + private + +!=== define "namelist" sub-type of config (config%nmlist%variable) + type :: namelist_type + + integer :: OptDynamicVeg ! options for dynamic vegetation + ! 1 -> off (use table LeafAreaIndex; use VegFrac = VegFracGreen from input) + ! 2 -> on (together with OptStomataResistance = 1) + ! 3 -> off (use table LeafAreaIndex; calculate VegFrac) + ! 4 -> off (use table LeafAreaIndex; use maximum vegetation fraction) (default) + ! 5 -> on (use maximum vegetation fraction) + ! 6 -> on (use VegFrac = VegFracGreen from input) + ! 7 -> off (use input LeafAreaIndex; use VegFrac = VegFracGreen from input) + ! 8 -> off (use input LeafAreaIndex; calculate VegFrac) + ! 9 -> off (use input LeafAreaIndex; use maximum vegetation fraction) + integer :: OptRainSnowPartition ! options for partitioning precipitation into rainfall & snowfall + ! 1 -> Jordan (1991) scheme (default) + ! 2 -> BATS: when TemperatureAirRefHeight < freezing point+2.2 + ! 3 -> TemperatureAirRefHeight < freezing point + ! 4 -> Use WRF microphysics output + ! 5 -> Use wetbulb temperature (Wang et al., 2019) + integer :: OptSoilWaterTranspiration ! options for soil moisture factor for stomatal resistance & evapotranspiration + ! 1 -> Noah (soil moisture) (default) + ! 2 -> CLM (matric potential) + ! 3 -> SSiB (matric potential) + integer :: OptGroundResistanceEvap ! options for ground resistent to evaporation/sublimation + ! 1 -> Sakaguchi and Zeng, 2009 (default) + ! 2 -> Sellers (1992) + ! 3 -> adjusted Sellers to decrease ResistanceGrdEvap for wet soil + ! 4 -> option 1 for non-snow; rsurf = rsurf_snow for snow (set in table) + integer :: OptSurfaceDrag ! options for surface layer drag/exchange coefficient + ! 1 -> Monin-Obukhov (M-O) Similarity Theory (MOST) (default) + ! 2 -> original Noah (Chen et al. 1997) + integer :: OptStomataResistance ! options for canopy stomatal resistance + ! 1 -> Ball-Berry scheme (default) + ! 2 -> Jarvis scheme + integer :: OptSnowAlbedo ! options for ground snow surface albedo + ! 1 -> BATS snow albedo scheme (default) + ! 2 -> CLASS snow albedo scheme + integer :: OptCanopyRadiationTransfer ! options for canopy radiation transfer + ! 1 -> modified two-stream (gap=F(solar angle,3D structure, etc)<1-VegFrac) + ! 2 -> two-stream applied to grid-cell (gap = 0) + ! 3 -> two-stream applied to vegetated fraction (gap=1-VegFrac) (default) + integer :: OptSnowSoilTempTime ! options for snow/soil temperature time scheme (only layer 1) + ! 1 -> semi-implicit; flux top boundary condition (default) + ! 2 -> full implicit (original Noah); temperature top boundary condition + ! 3 -> same as 1, but snow cover for skin temperature calculation (generally improves snow) + integer :: OptSnowThermConduct ! options for snow thermal conductivity + ! 1 -> Stieglitz(yen,1965) scheme (default) + ! 2 -> Anderson, 1976 scheme + ! 3 -> constant + ! 4 -> Verseghy (1991) scheme + ! 5 -> Douvill(Yen, 1981) scheme + integer :: OptSoilTemperatureBottom ! options for lower boundary condition of soil temperature + ! 1 -> zero heat flux from bottom (DepthSoilTempBottom & TemperatureSoilBottom not used) + ! 2 -> TemperatureSoilBottom at DepthSoilTempBottom (8m) read from a file (original Noah) (default) + integer :: OptSoilSupercoolWater ! options for soil supercooled liquid water + ! 1 -> no iteration (Niu and Yang, 2006 JHM) (default) + ! 2 -> Koren's iteration (Koren et al., 1999 JGR) + integer :: OptRunoffSurface ! options for surface runoff + ! 1 -> TOPMODEL with groundwater + ! 2 -> TOPMODEL with an equilibrium water table + ! 3 -> original surface and subsurface runoff (free drainage) (default) + ! 4 -> BATS surface and subsurface runoff (free drainage) + ! 5 -> Miguez-Macho&Fan groundwater scheme + ! 6 -> Variable Infiltration Capacity Model surface runoff scheme + ! 7 -> Xinanjiang Infiltration and surface runoff scheme + ! 8 -> Dynamic VIC surface runoff scheme + integer :: OptRunoffSubsurface ! options for drainage & subsurface runoff + ! 1~8: similar to runoff option, separated from original NoahMP runoff option + ! currently tested & recommended the same option# as surface runoff (default) + integer :: OptSoilPermeabilityFrozen ! options for frozen soil permeability + ! 1 -> linear effects, more permeable (default) + ! 2 -> nonlinear effects, less permeable + integer :: OptDynVicInfiltration ! options for infiltration in dynamic VIC runoff scheme + ! 1 -> Philip scheme (default) + ! 2 -> Green-Ampt scheme + ! 3 -> Smith-Parlange scheme + integer :: OptTileDrainage ! options for tile drainage + ! currently only tested & calibrated to work with runoff option=3 + ! 0 -> No tile drainage (default) + ! 1 -> on (simple scheme) + ! 2 -> on (Hooghoudt's scheme) + integer :: OptIrrigation ! options for irrigation + ! 0 -> No irrigation (default) + ! 1 -> Irrigation ON + ! 2 -> irrigation trigger based on crop season Planting and harvesting dates + ! 3 -> irrigation trigger based on LeafAreaIndex threshold + integer :: OptIrrigationMethod ! options for irrigation method + ! only works when OptIrrigation > 0 + ! 0 -> method based on geo_em fractions (default) + ! 1 -> sprinkler method + ! 2 -> micro/drip irrigation + ! 3 -> surface flooding + integer :: OptCropModel ! options for crop model + ! 0 -> No crop model (default) + ! 1 -> Liu, et al. 2016 crop scheme + integer :: OptSoilProperty ! options for defining soil properties + ! 1 -> use input dominant soil texture (default) + ! 2 -> use input soil texture that varies with depth + ! 3 -> use soil composition (sand, clay, orgm) and pedotransfer function + ! 4 -> use input soil properties + integer :: OptPedotransfer ! options for pedotransfer functions + ! only works when OptSoilProperty = 3 + ! 1 -> Saxton and Rawls (2006) scheme (default) + integer :: OptGlacierTreatment ! options for glacier treatment + ! 1 -> include phase change of ice (default) + ! 2 -> ice treatment more like original Noah + + end type namelist_type + + +!=== define "domain" sub-type of config (config%domain%variable) + type :: domain_type + + character(len=256) :: LandUseDataName ! landuse dataset name (USGS or MODIFIED_IGBP_MODIS_NOAH) + logical :: FlagUrban ! flag for urban grid + logical :: FlagCropland ! flag to identify croplands + logical :: FlagDynamicCrop ! flag to activate dynamic crop model + logical :: FlagDynamicVeg ! flag to activate dynamic vegetation scheme + logical :: FlagSoilProcess ! flag to determine if calculating soil processes + integer :: GridIndexI ! model grid index in x-direction + integer :: GridIndexJ ! model grid index in y-direction + integer :: VegType ! vegetation type + integer :: CropType ! crop type + integer :: NumSoilLayer ! number of soil layers + integer :: NumSnowLayerMax ! maximum number of snow layers + integer :: NumSnowLayerNeg ! actual number of snow layers (negative) + integer :: SurfaceType ! surface type (1=soil; 2=lake) + integer :: NumSwRadBand ! number of shortwave radiation bands + integer :: SoilColor ! soil color type for albedo + integer :: IndicatorIceSfc ! indicator for ice surface/point (1=sea ice, 0=non-ice, -1=land ice) + integer :: IndexWaterPoint ! land type index for water point + integer :: IndexBarrenPoint ! land type index for barren land point + integer :: IndexIcePoint ! land type index for ice point + integer :: IndexCropPoint ! land type index for cropland point + integer :: IndexEBLForest ! land type index for evergreen broadleaf (EBL) Forest + integer :: NumCropGrowStage ! number of crop growth stages + integer :: NumDayInYear ! Number of days in the particular year + integer :: RunoffSlopeType ! underground runoff slope term type + integer :: NumSoilTimeStep ! number of timesteps to calculate soil processes + real(kind=kind_noahmp) :: MainTimeStep ! noahmp main timestep [sec] + real(kind=kind_noahmp) :: SoilTimeStep ! soil timestep [sec] + real(kind=kind_noahmp) :: GridSize ! noahmp model grid spacing [m] + real(kind=kind_noahmp) :: DayJulianInYear ! julian day of the year + real(kind=kind_noahmp) :: CosSolarZenithAngle ! cosine solar zenith angle + real(kind=kind_noahmp) :: RefHeightAboveSfc ! reference height [m] above surface zero plane (including vegetation) + real(kind=kind_noahmp) :: ThicknessAtmosBotLayer ! thickness of atmospheric bottom layers [m] + real(kind=kind_noahmp) :: Latitude ! latitude [degree] + real(kind=kind_noahmp) :: DepthSoilTempBottom ! depth [m, negative] from soil surface for lower boundary soil temperature forcing + + integer , allocatable, dimension(:) :: SoilType ! soil type for each soil layer + real(kind=kind_noahmp), allocatable, dimension(:) :: DepthSoilLayer ! depth [m] of layer-bottom from soil surface + real(kind=kind_noahmp), allocatable, dimension(:) :: ThicknessSnowSoilLayer ! snow and soil layer thickness [m] + real(kind=kind_noahmp), allocatable, dimension(:) :: DepthSnowSoilLayer ! snow and soil layer-bottom depth [m] + real(kind=kind_noahmp), allocatable, dimension(:) :: ThicknessSoilLayer ! soil layer thickness [m] + + end type domain_type + + +!=== define config type that includes namelist & domain subtypes + type, public :: config_type + + type(namelist_type) :: nmlist + type(domain_type) :: domain + + end type config_type + +end module ConfigVarType diff --git a/src/core_atmosphere/physics/physics_noahmp/src/ConstantDefineMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/ConstantDefineMod.F90 new file mode 100644 index 000000000..4fa3e9874 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/ConstantDefineMod.F90 @@ -0,0 +1,40 @@ +module ConstantDefineMod + +!!! Define Noah-MP constant variable values + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use Machine + + implicit none + save + private + + ! define specific physical constants + real(kind=kind_noahmp), public, parameter :: ConstGravityAcc = 9.80616 ! acceleration due to gravity [m/s2] + real(kind=kind_noahmp), public, parameter :: ConstStefanBoltzmann = 5.67e-08 ! Stefan-Boltzmann constant [W/m2/K4] + real(kind=kind_noahmp), public, parameter :: ConstVonKarman = 0.40 ! von Karman constant + real(kind=kind_noahmp), public, parameter :: ConstFreezePoint = 273.16 ! freezing/melting temperature point [K] + real(kind=kind_noahmp), public, parameter :: ConstLatHeatSublim = 2.8440e06 ! latent heat of sublimation [J/kg] + real(kind=kind_noahmp), public, parameter :: ConstLatHeatEvap = 2.5104e06 ! latent heat of vaporization [J/kg] + real(kind=kind_noahmp), public, parameter :: ConstLatHeatFusion = 0.3336e06 ! latent heat of fusion of water [J/kg] + real(kind=kind_noahmp), public, parameter :: ConstHeatCapacWater = 4.188e06 ! specific heat capacity of water [J/m3/K] + real(kind=kind_noahmp), public, parameter :: ConstHeatCapacIce = 2.094e06 ! specific heat capacity of ice [J/m3/K] + real(kind=kind_noahmp), public, parameter :: ConstHeatCapacAir = 1004.64 ! specific heat capacity of dry air [J/kg/K] + real(kind=kind_noahmp), public, parameter :: ConstThermConductWater = 0.57 ! thermal conductivity of water [W/m/K] + real(kind=kind_noahmp), public, parameter :: ConstThermConductIce = 2.2 ! thermal conductivity of ice [W/m/K] + real(kind=kind_noahmp), public, parameter :: ConstThermConductAir = 0.023 ! thermal conductivity of air [W/m/K] + real(kind=kind_noahmp), public, parameter :: ConstThermConductQuartz = 7.7 ! thermal conductivity for quartz [W/m/K] + real(kind=kind_noahmp), public, parameter :: ConstThermConductSoilOth = 2.0 ! thermal conductivity for other soil components [W/m/K] + real(kind=kind_noahmp), public, parameter :: ConstGasDryAir = 287.04 ! gas constant for dry air [J/kg/K] + real(kind=kind_noahmp), public, parameter :: ConstGasWaterVapor = 461.269 ! gas constant for water vapor [J/kg/K] + real(kind=kind_noahmp), public, parameter :: ConstDensityWater = 1000.0 ! density of water [kg/m3] + real(kind=kind_noahmp), public, parameter :: ConstDensityIce = 917.0 ! density of ice [kg/m3] + real(kind=kind_noahmp), public, parameter :: ConstPI = 3.14159265 ! pi value + real(kind=kind_noahmp), public, parameter :: ConstDensityGraupel = 500.0 ! graupel bulk density [kg/m3] + real(kind=kind_noahmp), public, parameter :: ConstDensityHail = 917.0 ! hail bulk density [kg/m3] + +end module ConstantDefineMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/CropGrowDegreeDayMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/CropGrowDegreeDayMod.F90 new file mode 100644 index 000000000..cbad4158e --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/CropGrowDegreeDayMod.F90 @@ -0,0 +1,107 @@ +module CropGrowDegreeDayMod + +!!! Compute crop growing degree days + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine CropGrowDegreeDay(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: GROWING_GDD +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variables + real(kind=kind_noahmp) :: GrowDegDayCnt ! gap bewtween GrowDegreeDay and GrowDegreeDay8 + real(kind=kind_noahmp) :: TemperatureDiff ! temperature difference for growing degree days calculation + real(kind=kind_noahmp) :: TemperatureAirC ! air temperature degC + +!------------------------------------------------------------------------ + associate( & + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, main noahmp timestep [s] + DayJulianInYear => noahmp%config%domain%DayJulianInYear ,& ! in, Julian day of year + TemperatureAir2m => noahmp%energy%state%TemperatureAir2m ,& ! in, 2-m air temperature [K] + DatePlanting => noahmp%biochem%param%DatePlanting ,& ! in, Planting day (day of year) + DateHarvest => noahmp%biochem%param%DateHarvest ,& ! in, Harvest date (day of year) + TempBaseGrowDegDay => noahmp%biochem%param%TempBaseGrowDegDay ,& ! in, Base temperature for grow degree day accumulation [C] + TempMaxGrowDegDay => noahmp%biochem%param%TempMaxGrowDegDay ,& ! in, Max temperature for grow degree day accumulation [C] + GrowDegDayEmerg => noahmp%biochem%param%GrowDegDayEmerg ,& ! in, grow degree day from seeding to emergence + GrowDegDayInitVeg => noahmp%biochem%param%GrowDegDayInitVeg ,& ! in, grow degree day from seeding to initial vegetative + GrowDegDayPostVeg => noahmp%biochem%param%GrowDegDayPostVeg ,& ! in, grow degree day from seeding to post vegetative + GrowDegDayInitReprod => noahmp%biochem%param%GrowDegDayInitReprod ,& ! in, grow degree day from seeding to intial reproductive + GrowDegDayMature => noahmp%biochem%param%GrowDegDayMature ,& ! in, grow degree day from seeding to physical maturity + GrowDegreeDay => noahmp%biochem%state%GrowDegreeDay ,& ! inout, crop growing degree days + IndexPlanting => noahmp%biochem%state%IndexPlanting ,& ! out, Planting index index (0=off, 1=on) + IndexHarvest => noahmp%biochem%state%IndexHarvest ,& ! out, Havest index (0=on,1=off) + PlantGrowStage => noahmp%biochem%state%PlantGrowStage & ! out, Plant growth stage (1=S1,2=S2,3=S3) + ) +!------------------------------------------------------------------------ + + ! initialize + TemperatureAirC = TemperatureAir2m - 273.15 + + ! Planting and Havest index + IndexPlanting = 1 ! planting on + IndexHarvest = 1 ! harvest off + + ! turn on/off the planting + if ( DayJulianInYear < DatePlanting ) IndexPlanting = 0 ! planting off + + ! turn on/off the harvesting + if ( DayJulianInYear >= DateHarvest ) IndexHarvest = 0 ! harvest on + + ! Calculate the growing degree days + if ( TemperatureAirC < TempBaseGrowDegDay ) then + TemperatureDiff = 0.0 + elseif ( TemperatureAirC >= TempMaxGrowDegDay ) then + TemperatureDiff = TempMaxGrowDegDay - TempBaseGrowDegDay + else + TemperatureDiff = TemperatureAirC - TempBaseGrowDegDay + endif + GrowDegreeDay = (GrowDegreeDay + TemperatureDiff * MainTimeStep / 86400.0) * IndexPlanting * IndexHarvest + GrowDegDayCnt = GrowDegreeDay + + ! Decide corn growth stage, based on Hybrid-Maize + ! PlantGrowStage = 1 : Before planting + ! PlantGrowStage = 2 : from tassel initiation to silking + ! PlantGrowStage = 3 : from silking to effective grain filling + ! PlantGrowStage = 4 : from effective grain filling to pysiological maturity + ! PlantGrowStage = 5 : GrowDegDayMax=1389 + ! PlantGrowStage = 6 : + ! PlantGrowStage = 7 : + ! PlantGrowStage = 8 : + ! GrowDegDayMax = 1389 + ! GrowDegDayMax = 1555 + ! GrowDegDayTmp = 0.41 * GrowDegDayMax + 145.4 + 150 ! from hybrid-maize + ! GrowDegDayEmerg = ((GrowDegDayTmp - 96) / 38.9 - 4) * 21 + ! GrowDegDayEmerg = 0.77 * GrowDegDayTmp + ! GrowDegDayPostVeg = GrowDegDayTmp + 170 + ! GrowDegDayPostVeg = 170 + + ! compute plant growth stage + PlantGrowStage = 1 ! MB: set PlantGrowStage = 1 (for initialization during growing season when no GDD) + if ( GrowDegDayCnt > 0.0 ) PlantGrowStage = 2 + if ( GrowDegDayCnt >= GrowDegDayEmerg ) PlantGrowStage = 3 + if ( GrowDegDayCnt >= GrowDegDayInitVeg ) PlantGrowStage = 4 + if ( GrowDegDayCnt >= GrowDegDayPostVeg ) PlantGrowStage = 5 + if ( GrowDegDayCnt >= GrowDegDayInitReprod ) PlantGrowStage = 6 + if ( GrowDegDayCnt >= GrowDegDayMature ) PlantGrowStage = 7 + if ( DayJulianInYear >= DateHarvest ) PlantGrowStage = 8 + if ( DayJulianInYear < DatePlanting ) PlantGrowStage = 1 + + end associate + + end subroutine CropGrowDegreeDay + +end module CropGrowDegreeDayMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/CropPhotosynthesisMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/CropPhotosynthesisMod.F90 new file mode 100644 index 000000000..1a7ff7074 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/CropPhotosynthesisMod.F90 @@ -0,0 +1,109 @@ +module CropPhotosynthesisMod + +!!! Compute crop photosynthesis + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine CropPhotosynthesis(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: PSN_CROP +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + real(kind=kind_noahmp) :: PhotosynRad ! photosynthetically active radiation (w/m2) 1 W m-2 = 0.0864 MJ m-2 day-1 + real(kind=kind_noahmp) :: Co2AssimMax ! Maximum CO2 assimulation rate g CO2/m2/s + real(kind=kind_noahmp) :: Co2AssimTot ! CO2 Assimilation g CO2/m2/s + real(kind=kind_noahmp) :: TemperatureAirC ! air temperature degC + real(kind=kind_noahmp) :: L1 ! Three Gaussian method + real(kind=kind_noahmp) :: L2 ! Three Gaussian method + real(kind=kind_noahmp) :: L3 ! Three Gaussian method + real(kind=kind_noahmp) :: I1 ! Three Gaussian method + real(kind=kind_noahmp) :: I2 ! Three Gaussian method + real(kind=kind_noahmp) :: I3 ! Three Gaussian method + real(kind=kind_noahmp) :: A1 ! Three Gaussian method + real(kind=kind_noahmp) :: A2 ! Three Gaussian method + real(kind=kind_noahmp) :: A3 ! Three Gaussian method + +!------------------------------------------------------------------------ + associate( & + RadSwDownRefHeight => noahmp%forcing%RadSwDownRefHeight ,& ! in, downward shortwave radiation [W/m2] at reference height + TemperatureAir2m => noahmp%energy%state%TemperatureAir2m ,& ! in, 2-m air temperature [K] + LeafAreaIndex => noahmp%energy%state%LeafAreaIndex ,& ! in, leaf area index, unadjusted for burying by snow + PhotosynRadFrac => noahmp%biochem%param%PhotosynRadFrac ,& ! in, Fraction of incoming radiation to photosynthetically active radiation + TempMinCarbonAssim => noahmp%biochem%param%TempMinCarbonAssim ,& ! in, Minimum temperature for CO2 assimilation [C] + TempMaxCarbonAssim => noahmp%biochem%param%TempMaxCarbonAssim ,& ! in, CO2 assim. linearly increasing until reaching this temperature [C] + TempMaxCarbonAssimMax => noahmp%biochem%param%TempMaxCarbonAssimMax ,& ! in, CO2 assim. remain at CarbonAssimRefMax until reaching this temperature [C] + CarbonAssimRefMax => noahmp%biochem%param%CarbonAssimRefMax ,& ! in, reference maximum CO2 assimilation rate + LightExtCoeff => noahmp%biochem%param%LightExtCoeff ,& ! in, light extinction coefficient + LightUseEfficiency => noahmp%biochem%param%LightUseEfficiency ,& ! in, initial light use efficiency + CarbonAssimReducFac => noahmp%biochem%param%CarbonAssimReducFac ,& ! in, CO2 assimulation reduction factor(0-1) (caused by e.g.pest,weeds) + PhotosynCrop => noahmp%biochem%flux%PhotosynCrop & ! out, crop photosynthesis [umol co2/m2/s] + ) +!------------------------------------------------------------------------ + + ! initialize + TemperatureAirC = TemperatureAir2m - 273.15 + PhotosynRad = PhotosynRadFrac * RadSwDownRefHeight * 0.0036 !w to MJ m-2 + + ! compute Maximum CO2 assimulation rate g/co2/s + if ( TemperatureAirC < TempMinCarbonAssim ) then + Co2AssimMax = 1.0e-10 + elseif ( (TemperatureAirC >= TempMinCarbonAssim) .and. (TemperatureAirC < TempMaxCarbonAssim) ) then + Co2AssimMax = (TemperatureAirC - TempMinCarbonAssim) * CarbonAssimRefMax / (TempMaxCarbonAssim - TempMinCarbonAssim) + elseif ( (TemperatureAirC >= TempMaxCarbonAssim) .and. (TemperatureAirC < TempMaxCarbonAssimMax) ) then + Co2AssimMax = CarbonAssimRefMax + else + Co2AssimMax = CarbonAssimRefMax - 0.2 * (TemperatureAir2m - TempMaxCarbonAssimMax) + endif + Co2AssimMax = max(Co2AssimMax, 0.01) + + ! compute coefficients + if ( LeafAreaIndex <= 0.05 ) then + L1 = 0.1127 * 0.05 ! use initial LeafAreaIndex(0.05), avoid error + L2 = 0.5 * 0.05 + L3 = 0.8873 * 0.05 + else + L1 = 0.1127 * LeafAreaIndex + L2 = 0.5 * LeafAreaIndex + L3 = 0.8873 * LeafAreaIndex + endif + + I1 = LightExtCoeff * PhotosynRad * exp(-LightExtCoeff * L1) + I2 = LightExtCoeff * PhotosynRad * exp(-LightExtCoeff * L2) + I3 = LightExtCoeff * PhotosynRad * exp(-LightExtCoeff * L3) + I1 = max(I1, 1.0e-10) + I2 = max(I2, 1.0e-10) + I3 = max(I3, 1.0e-10) + A1 = Co2AssimMax * (1 - exp(-LightUseEfficiency * I1 / Co2AssimMax)) + A2 = Co2AssimMax * (1 - exp(-LightUseEfficiency * I2 / Co2AssimMax)) * 1.6 + A3 = Co2AssimMax * (1 - exp(-LightUseEfficiency * I3 / Co2AssimMax)) + + ! compute photosynthesis rate + if ( LeafAreaIndex <= 0.05 ) then + Co2AssimTot = (A1 + A2 + A3) / 3.6 * 0.05 + elseif ( (LeafAreaIndex > 0.05) .and. (LeafAreaIndex <= 4.0) ) then + Co2AssimTot = (A1 + A2 + A3) / 3.6 * LeafAreaIndex + else + Co2AssimTot = (A1 + A2 + A3) / 3.6 * 4 + endif + Co2AssimTot = Co2AssimTot * CarbonAssimReducFac ! Attainable + PhotosynCrop = 6.313 * Co2AssimTot ! (1/44) * 1000000)/3600 = 6.313 + + end associate + + end subroutine CropPhotosynthesis + +end module CropPhotosynthesisMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/EnergyMainGlacierMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/EnergyMainGlacierMod.F90 new file mode 100644 index 000000000..3fc0bf071 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/EnergyMainGlacierMod.F90 @@ -0,0 +1,173 @@ +module EnergyMainGlacierMod + +!!! Main energy module for glacier points including all energy relevant processes +!!! snow thermal property -> radiation -> ground heat flux -> snow temperature solver -> snow/ice phase change + + use Machine + use NoahmpVarType + use ConstantDefineMod + use SnowCoverGlacierMod, only : SnowCoverGlacier + use GroundRoughnessPropertyGlacierMod, only : GroundRoughnessPropertyGlacier + use GroundThermalPropertyGlacierMod, only : GroundThermalPropertyGlacier + use SurfaceAlbedoGlacierMod, only : SurfaceAlbedoGlacier + use SurfaceRadiationGlacierMod, only : SurfaceRadiationGlacier + use SurfaceEmissivityGlacierMod, only : SurfaceEmissivityGlacier + use ResistanceGroundEvaporationGlacierMod, only : ResistanceGroundEvaporationGlacier + use PsychrometricVariableGlacierMod, only : PsychrometricVariableGlacier + use SurfaceEnergyFluxGlacierMod, only : SurfaceEnergyFluxGlacier + use GlacierTemperatureMainMod, only : GlacierTemperatureMain + use GlacierPhaseChangeMod, only : GlacierPhaseChange + + implicit none + +contains + + subroutine EnergyMainGlacier(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: ENERGY_GLACIER +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + +! -------------------------------------------------------------------- + associate( & + RadLwDownRefHeight => noahmp%forcing%RadLwDownRefHeight ,& ! in, downward longwave radiation [W/m2] at reference height + RadSwDownRefHeight => noahmp%forcing%RadSwDownRefHeight ,& ! in, downward shortwave radiation [W/m2] at reference height + OptSnowSoilTempTime => noahmp%config%nmlist%OptSnowSoilTempTime ,& ! in, options for snow/soil temperature time scheme + HeatPrecipAdvBareGrd => noahmp%energy%flux%HeatPrecipAdvBareGrd ,& ! in, precipitation advected heat - bare ground net [W/m2] + TemperatureSfc => noahmp%energy%state%TemperatureSfc ,& ! inout, surface temperature [K] + TemperatureGrd => noahmp%energy%state%TemperatureGrd ,& ! inout, ground temperature [K] + SpecHumiditySfc => noahmp%energy%state%SpecHumiditySfc ,& ! inout, specific humidity at bare surface + SpecHumiditySfcMean => noahmp%energy%state%SpecHumiditySfcMean ,& ! inout, specific humidity at surface grid mean + ExchCoeffMomSfc => noahmp%energy%state%ExchCoeffMomSfc ,& ! inout, exchange coefficient [m/s] for momentum, surface, grid mean + ExchCoeffShSfc => noahmp%energy%state%ExchCoeffShSfc ,& ! inout, exchange coefficient [m/s] for heat, surface, grid mean + SnowDepth => noahmp%water%state%SnowDepth ,& ! inout, snow depth [m] + RoughLenMomSfcToAtm => noahmp%energy%state%RoughLenMomSfcToAtm ,& ! out, roughness length, momentum, surface, sent to coupled model + WindStressEwSfc => noahmp%energy%state%WindStressEwSfc ,& ! out, wind stress: east-west [N/m2] grid mean + WindStressNsSfc => noahmp%energy%state%WindStressNsSfc ,& ! out, wind stress: north-south [N/m2] grid mean + TemperatureRadSfc => noahmp%energy%state%TemperatureRadSfc ,& ! out, radiative temperature [K] + TemperatureAir2m => noahmp%energy%state%TemperatureAir2m ,& ! out, grid mean 2-m air temperature [K] + TemperatureAir2mBare => noahmp%energy%state%TemperatureAir2mBare ,& ! out, 2 m height air temperature [K] bare ground + EmissivitySfc => noahmp%energy%state%EmissivitySfc ,& ! out, surface emissivity + RoughLenMomGrd => noahmp%energy%state%RoughLenMomGrd ,& ! out, roughness length, momentum, ground [m] + WindStressEwBare => noahmp%energy%state%WindStressEwBare ,& ! out, wind stress: east-west [N/m2] bare ground + WindStressNsBare => noahmp%energy%state%WindStressNsBare ,& ! out, wind stress: north-south [N/m2] bare ground + SpecHumidity2mBare => noahmp%energy%state%SpecHumidity2mBare ,& ! out, bare ground 2-m water vapor mixing ratio + SpecHumidity2m => noahmp%energy%state%SpecHumidity2m ,& ! out, grid mean 2-m water vapor mixing ratio + TemperatureGrdBare => noahmp%energy%state%TemperatureGrdBare ,& ! out, bare ground temperature [K] + ExchCoeffMomBare => noahmp%energy%state%ExchCoeffMomBare ,& ! out, exchange coeff [m/s] for momentum, above ZeroPlaneDisp, bare ground + ExchCoeffShBare => noahmp%energy%state%ExchCoeffShBare ,& ! out, exchange coeff [m/s] for heat, above ZeroPlaneDisp, bare ground + AlbedoSfc => noahmp%energy%state%AlbedoSfc ,& ! out, total shortwave surface albedo + RadSwReflSfc => noahmp%energy%flux%RadSwReflSfc ,& ! out, total reflected solar radiation [W/m2] + RadLwNetSfc => noahmp%energy%flux%RadLwNetSfc ,& ! out, total net longwave rad [W/m2] (+ to atm) + HeatSensibleSfc => noahmp%energy%flux%HeatSensibleSfc ,& ! out, total sensible heat [W/m2] (+ to atm) + HeatLatentGrd => noahmp%energy%flux%HeatLatentGrd ,& ! out, total ground latent heat [W/m2] (+ to atm) + HeatGroundTot => noahmp%energy%flux%HeatGroundTot ,& ! out, total ground heat flux [W/m2] (+ to soil/snow) + HeatPrecipAdvSfc => noahmp%energy%flux%HeatPrecipAdvSfc ,& ! out, precipitation advected heat - total [W/m2] + RadLwEmitSfc => noahmp%energy%flux%RadLwEmitSfc ,& ! out, emitted outgoing IR [W/m2] + RadLwNetBareGrd => noahmp%energy%flux%RadLwNetBareGrd ,& ! out, net longwave rad [W/m2] bare ground (+ to atm) + HeatSensibleBareGrd => noahmp%energy%flux%HeatSensibleBareGrd ,& ! out, sensible heat flux [W/m2] bare ground (+ to atm) + HeatLatentBareGrd => noahmp%energy%flux%HeatLatentBareGrd ,& ! out, latent heat flux [W/m2] bare ground (+ to atm) + HeatGroundBareGrd => noahmp%energy%flux%HeatGroundBareGrd & ! out, bare ground heat flux [W/m2] (+ to soil/snow) + ) +! ---------------------------------------------------------------------- + + ! glaicer snow cover fraction + call SnowCoverGlacier(noahmp) + + ! ground and surface roughness length and reference height + call GroundRoughnessPropertyGlacier(noahmp) + + ! Thermal properties of snow and glacier ice + call GroundThermalPropertyGlacier(noahmp) + + ! Glacier surface shortwave abeldo + call SurfaceAlbedoGlacier(noahmp) + + ! Glacier surface shortwave radiation + call SurfaceRadiationGlacier(noahmp) + + ! longwave emissivity for glacier surface + call SurfaceEmissivityGlacier(noahmp) + + ! glacier surface resistance for ground evaporation/sublimation + call ResistanceGroundEvaporationGlacier(noahmp) + + ! set psychrometric variable/constant + call PsychrometricVariableGlacier(noahmp) + + ! temperatures and energy fluxes of glacier ground + TemperatureGrdBare = TemperatureGrd + ExchCoeffMomBare = ExchCoeffMomSfc + ExchCoeffShBare = ExchCoeffShSfc + call SurfaceEnergyFluxGlacier(noahmp) + + ! assign glacier bare ground quantity to grid-level quantity + ! Energy balance at glacier (bare) ground: + ! RadSwAbsGrd + HeatPrecipAdvBareGrd = RadLwNetBareGrd + HeatSensibleBareGrd + HeatLatentBareGrd + HeatGroundBareGrd + WindStressEwSfc = WindStressEwBare + WindStressNsSfc = WindStressNsBare + RadLwNetSfc = RadLwNetBareGrd + HeatSensibleSfc = HeatSensibleBareGrd + HeatLatentGrd = HeatLatentBareGrd + HeatGroundTot = HeatGroundBareGrd + TemperatureGrd = TemperatureGrdBare + TemperatureAir2m = TemperatureAir2mBare + HeatPrecipAdvSfc = HeatPrecipAdvBareGrd + TemperatureSfc = TemperatureGrd + ExchCoeffMomSfc = ExchCoeffMomBare + ExchCoeffShSfc = ExchCoeffShBare + SpecHumiditySfcMean = SpecHumiditySfc + SpecHumidity2m = SpecHumidity2mBare + RoughLenMomSfcToAtm = RoughLenMomGrd + + ! emitted longwave radiation and physical check + RadLwEmitSfc = RadLwDownRefHeight + RadLwNetSfc + if ( RadLwEmitSfc <= 0.0 ) then + write(*,*) "emitted longwave <0; skin T may be wrong due to inconsistent" + write(*,*) "RadLwDownRefHeight = ", RadLwDownRefHeight, "RadLwNetSfc = ", RadLwNetSfc, "SnowDepth = ", SnowDepth + stop "Error: Longwave radiation budget problem in NoahMP LSM" + endif + + ! radiative temperature: subtract from the emitted IR the + ! reflected portion of the incoming longwave radiation, so just + ! considering the IR originating/emitted in the ground system. + ! Old TemperatureRadSfc calculation not taking into account Emissivity: + ! TemperatureRadSfc = (RadLwEmitSfc/ConstStefanBoltzmann)**0.25 + TemperatureRadSfc = ((RadLwEmitSfc - (1.0 - EmissivitySfc)*RadLwDownRefHeight) / & + (EmissivitySfc * ConstStefanBoltzmann)) ** 0.25 + + ! compute snow and glacier ice temperature + call GlacierTemperatureMain(noahmp) + + ! adjusting suface temperature based on snow condition + if ( OptSnowSoilTempTime == 2 ) then + if ( (SnowDepth > 0.05) .and. (TemperatureGrd > ConstFreezePoint) ) then + TemperatureGrdBare = ConstFreezePoint + TemperatureGrd = TemperatureGrdBare + TemperatureSfc = TemperatureGrdBare + endif + endif + + ! Phase change and Energy released or consumed by snow & glacier ice + call GlacierPhaseChange(noahmp) + + ! update total surface albedo + if ( RadSwDownRefHeight > 0.0 ) then + AlbedoSfc = RadSwReflSfc / RadSwDownRefHeight + else + AlbedoSfc = undefined_real + endif + + end associate + + end subroutine EnergyMainGlacier + +end module EnergyMainGlacierMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/EnergyMainMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/EnergyMainMod.F90 new file mode 100644 index 000000000..ab9e71015 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/EnergyMainMod.F90 @@ -0,0 +1,360 @@ +module EnergyMainMod + +!!! Main energy module including all energy relevant processes +!!! soil/snow thermal property -> radiation -> ground/vegtation heat flux -> snow/soil temperature solver -> soil/snow phase change +! +! -------------------------------------------------------------------------------------------------- +! NoahMP uses different approaches to deal with subgrid features of radiation transfer and turbulent +! transfer. It uses 'tile' approach to compute turbulent fluxes, while it uses two-stream approx. +! to compute radiation transfer. Tile approach, assemblying vegetation canopies together, +! may expose too much ground surfaces (either covered by snow or grass) to solar radiation. The +! modified two-stream assumes vegetation covers fully the gridcell but with gaps between tree crowns. +! -------------------------------------------------------------------------------------------------- +! turbulence transfer : 'tile' approach to compute energy fluxes in vegetated fraction and +! bare fraction separately and then sum them up weighted by fraction +! -------------------------------------- +! / O O O O O O O O / / +! / | | | | | | | | / / +! / O O O O O O O O / / +! / | | |tile1| | | | / tile2 / +! / O O O O O O O O / bare / +! / | | | vegetated | | / / +! / O O O O O O O O / / +! / | | | | | | | | / / +! -------------------------------------- +! -------------------------------------------------------------------------------------------------- +! radiation transfer : modified two-stream (Yang and Friedl, 2003, JGR; Niu ang Yang, 2004, JGR) +! -------------------------------------- two-stream treats leaves as +! / O O O O O O O O / cloud over the entire grid-cell, +! / | | | | | | | | / while the modified two-stream +! / O O O O O O O O / aggregates cloudy leaves into +! / | | | | | | | | / tree crowns with gaps (as shown in +! / O O O O O O O O / the left figure). We assume these +! / | | | | | | | | / tree crowns are evenly distributed +! / O O O O O O O O / within the gridcell with 100% veg +! / | | | | | | | | / fraction, but with gaps. The 'tile' +! -------------------------------------- approach overlaps too much shadows. +! -------------------------------------------------------------------------------------------------- + + use Machine + use NoahmpVarType + use ConstantDefineMod + use SnowCoverGroundNiu07Mod, only : SnowCoverGroundNiu07 + use GroundRoughnessPropertyMod, only : GroundRoughnessProperty + use GroundThermalPropertyMod, only : GroundThermalProperty + use SurfaceAlbedoMod, only : SurfaceAlbedo + use SurfaceRadiationMod, only : SurfaceRadiation + use SurfaceEmissivityMod, only : SurfaceEmissivity + use SoilWaterTranspirationMod, only : SoilWaterTranspiration + use ResistanceGroundEvaporationMod, only : ResistanceGroundEvaporation + use PsychrometricVariableMod, only : PsychrometricVariable + use SurfaceEnergyFluxVegetatedMod, only : SurfaceEnergyFluxVegetated + use SurfaceEnergyFluxBareGroundMod, only : SurfaceEnergyFluxBareGround + use SoilSnowTemperatureMainMod, only : SoilSnowTemperatureMain + use SoilSnowWaterPhaseChangeMod, only : SoilSnowWaterPhaseChange + + use mpas_log + + implicit none + +contains + + subroutine EnergyMain(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: ENERGY +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + logical :: FlagVegSfc ! flag: true if vegetated surface + +! -------------------------------------------------------------------- + associate( & + PressureAirRefHeight => noahmp%forcing%PressureAirRefHeight ,& ! in, air pressure [Pa] at reference height + RadLwDownRefHeight => noahmp%forcing%RadLwDownRefHeight ,& ! in, downward longwave radiation [W/m2] at reference height + RadSwDownRefHeight => noahmp%forcing%RadSwDownRefHeight ,& ! in, downward shortwave radiation [W/m2] at reference height + OptSnowSoilTempTime => noahmp%config%nmlist%OptSnowSoilTempTime ,& ! in, options for snow/soil temperature time scheme + FlagCropland => noahmp%config%domain%FlagCropland ,& ! in, flag to identify croplands + FlagSoilProcess => noahmp%config%domain%FlagSoilProcess ,& ! in, flag to determine if calculating soil processes + NumSoilTimeStep => noahmp%config%domain%NumSoilTimeStep ,& ! in, number of time step for calculating soil processes + SoilTimeStep => noahmp%config%domain%SoilTimeStep ,& ! in, soil process timestep [s] + IrriFracThreshold => noahmp%water%param%IrriFracThreshold ,& ! in, irrigation fraction parameter + IrrigationFracGrid => noahmp%water%state%IrrigationFracGrid ,& ! in, total input irrigation fraction + LeafAreaIndEff => noahmp%energy%state%LeafAreaIndEff ,& ! in, leaf area index, after burying by snow + StemAreaIndEff => noahmp%energy%state%StemAreaIndEff ,& ! in, stem area index, after burying by snow + VegFrac => noahmp%energy%state%VegFrac ,& ! in, greeness vegetation fraction + HeatLatentIrriEvap => noahmp%energy%flux%HeatLatentIrriEvap ,& ! in, latent heating due to sprinkler evaporation [W/m2] + HeatPrecipAdvCanopy => noahmp%energy%flux%HeatPrecipAdvCanopy ,& ! in, precipitation advected heat - vegetation net [W/m2] + HeatPrecipAdvVegGrd => noahmp%energy%flux%HeatPrecipAdvVegGrd ,& ! in, precipitation advected heat - under canopy net [W/m2] + HeatPrecipAdvBareGrd => noahmp%energy%flux%HeatPrecipAdvBareGrd ,& ! in, precipitation advected heat - bare ground net [W/m2] + TemperatureSfc => noahmp%energy%state%TemperatureSfc ,& ! inout, surface temperature [K] + TemperatureGrd => noahmp%energy%state%TemperatureGrd ,& ! inout, ground temperature [K] + TemperatureCanopy => noahmp%energy%state%TemperatureCanopy ,& ! inout, vegetation temperature [K] + SpecHumiditySfc => noahmp%energy%state%SpecHumiditySfc ,& ! inout, specific humidity [kg/kg] at bare/veg/urban surface + SpecHumiditySfcMean => noahmp%energy%state%SpecHumiditySfcMean ,& ! inout, specific humidity [kg/kg] at surface grid mean + PressureVaporCanAir => noahmp%energy%state%PressureVaporCanAir ,& ! inout, canopy air vapor pressure [Pa] + ExchCoeffMomSfc => noahmp%energy%state%ExchCoeffMomSfc ,& ! inout, exchange coefficient [m/s] for momentum, surface, grid mean + ExchCoeffShSfc => noahmp%energy%state%ExchCoeffShSfc ,& ! inout, exchange coefficient [m/s] for heat, surface, grid mean + HeatGroundTotAcc => noahmp%energy%flux%HeatGroundTotAcc ,& ! inout, accumulated total ground heat flux per soil timestep [W/m2 * dt_soil/dt_main] + SnowDepth => noahmp%water%state%SnowDepth ,& ! inout, snow depth [m] + RoughLenMomSfcToAtm => noahmp%energy%state%RoughLenMomSfcToAtm ,& ! out, roughness length, momentum, surface, sent to coupled model + WindStressEwSfc => noahmp%energy%state%WindStressEwSfc ,& ! out, wind stress: east-west [N/m2] grid mean + WindStressNsSfc => noahmp%energy%state%WindStressNsSfc ,& ! out, wind stress: north-south [N/m2] grid mean + TemperatureRadSfc => noahmp%energy%state%TemperatureRadSfc ,& ! out, surface radiative temperature [K] + TemperatureAir2m => noahmp%energy%state%TemperatureAir2m ,& ! out, grid mean 2-m air temperature [K] + ResistanceStomataSunlit => noahmp%energy%state%ResistanceStomataSunlit ,& ! out, sunlit leaf stomatal resistance [s/m] + ResistanceStomataShade => noahmp%energy%state%ResistanceStomataShade ,& ! out, shaded leaf stomatal resistance [s/m] + TemperatureAir2mVeg => noahmp%energy%state%TemperatureAir2mVeg ,& ! out, 2 m height air temperature [K], vegetated + TemperatureAir2mBare => noahmp%energy%state%TemperatureAir2mBare ,& ! out, 2 m height air temperature [K] bare ground + LeafAreaIndSunlit => noahmp%energy%state%LeafAreaIndSunlit ,& ! out, sunlit leaf area index, one-sided [m2/m2] + LeafAreaIndShade => noahmp%energy%state%LeafAreaIndShade ,& ! out, shaded leaf area index, one-sided [m2/m2] + EmissivitySfc => noahmp%energy%state%EmissivitySfc ,& ! out, surface emissivity + VegAreaIndEff => noahmp%energy%state%VegAreaIndEff ,& ! out, one-sided leaf+stem area index [m2/m2] + RoughLenMomSfc => noahmp%energy%state%RoughLenMomSfc ,& ! out, roughness length [m], momentum, surface + RoughLenMomGrd => noahmp%energy%state%RoughLenMomGrd ,& ! out, roughness length [m], momentum, ground + WindStressEwVeg => noahmp%energy%state%WindStressEwVeg ,& ! out, wind stress: east-west [N/m2] above canopy + WindStressNsVeg => noahmp%energy%state%WindStressNsVeg ,& ! out, wind stress: north-south [N/m2] above canopy + WindStressEwBare => noahmp%energy%state%WindStressEwBare ,& ! out, wind stress: east-west [N/m2] bare ground + WindStressNsBare => noahmp%energy%state%WindStressNsBare ,& ! out, wind stress: north-south [N/m2] bare ground + SpecHumidity2mVeg => noahmp%energy%state%SpecHumidity2mVeg ,& ! out, water vapor mixing ratio at 2m vegetated + SpecHumidity2mBare => noahmp%energy%state%SpecHumidity2mBare ,& ! out, bare ground 2-m water vapor mixing ratio + SpecHumidity2m => noahmp%energy%state%SpecHumidity2m ,& ! out, grid mean 2-m water vapor mixing ratio + TemperatureGrdVeg => noahmp%energy%state%TemperatureGrdVeg ,& ! out, vegetated ground (below-canopy) temperature [K] + TemperatureGrdBare => noahmp%energy%state%TemperatureGrdBare ,& ! out, bare ground temperature [K] + ExchCoeffMomAbvCan => noahmp%energy%state%ExchCoeffMomAbvCan ,& ! out, exchange coeff [m/s] for momentum, above ZeroPlaneDisp, vegetated + ExchCoeffMomBare => noahmp%energy%state%ExchCoeffMomBare ,& ! out, exchange coeff [m/s] for momentum, above ZeroPlaneDisp, bare ground + ExchCoeffShAbvCan => noahmp%energy%state%ExchCoeffShAbvCan ,& ! out, exchange coeff [m/s] for heat, above ZeroPlaneDisp, vegetated + ExchCoeffShBare => noahmp%energy%state%ExchCoeffShBare ,& ! out, exchange coeff [m/s] for heat, above ZeroPlaneDisp, bare ground + ExchCoeffShLeaf => noahmp%energy%state%ExchCoeffShLeaf ,& ! out, leaf sensible heat exchange coeff [m/s], leaf to canopy air + ExchCoeffShUndCan => noahmp%energy%state%ExchCoeffShUndCan ,& ! out, under canopy sensible heat exchange coefficient [m/s] + ExchCoeffSh2mVeg => noahmp%energy%state%ExchCoeffSh2mVeg ,& ! out, 2m sensible heat exchange coefficient [m/s] vegetated + AlbedoSfc => noahmp%energy%state%AlbedoSfc ,& ! out, total shortwave surface albedo + RadSwReflSfc => noahmp%energy%flux%RadSwReflSfc ,& ! out, total reflected solar radiation [W/m2] + RadLwNetSfc => noahmp%energy%flux%RadLwNetSfc ,& ! out, total net longwave rad [W/m2] (+ to atm) + HeatSensibleSfc => noahmp%energy%flux%HeatSensibleSfc ,& ! out, total sensible heat [W/m2] (+ to atm) + HeatLatentGrd => noahmp%energy%flux%HeatLatentGrd ,& ! out, total ground latent heat [W/m2] (+ to atm) + HeatLatentCanopy => noahmp%energy%flux%HeatLatentCanopy ,& ! out, canopy latent heat flux [W/m2] (+ to atm) + HeatLatentTransp => noahmp%energy%flux%HeatLatentTransp ,& ! out, latent heat flux from transpiration [W/m2] (+ to atm) + RadPhotoActAbsCan => noahmp%energy%flux%RadPhotoActAbsCan ,& ! out, total photosyn. active energy [W/m2) absorbed by canopy + RadPhotoActAbsSunlit => noahmp%energy%flux%RadPhotoActAbsSunlit ,& ! out, average absorbed par for sunlit leaves [W/m2] + RadPhotoActAbsShade => noahmp%energy%flux%RadPhotoActAbsShade ,& ! out, average absorbed par for shaded leaves [W/m2] + HeatGroundTot => noahmp%energy%flux%HeatGroundTot ,& ! out, total ground heat flux [W/m2] (+ to soil/snow) + HeatPrecipAdvSfc => noahmp%energy%flux%HeatPrecipAdvSfc ,& ! out, precipitation advected heat - total [W/m2] + RadLwEmitSfc => noahmp%energy%flux%RadLwEmitSfc ,& ! out, emitted outgoing IR [W/m2] + RadLwNetCanopy => noahmp%energy%flux%RadLwNetCanopy ,& ! out, canopy net longwave radiation [W/m2] (+ to atm) + RadLwNetVegGrd => noahmp%energy%flux%RadLwNetVegGrd ,& ! out, ground net longwave radiation [W/m2] (+ to atm) + RadLwNetBareGrd => noahmp%energy%flux%RadLwNetBareGrd ,& ! out, net longwave rad [W/m2] bare ground (+ to atm) + HeatSensibleCanopy => noahmp%energy%flux%HeatSensibleCanopy ,& ! out, canopy sensible heat flux [W/m2] (+ to atm) + HeatSensibleVegGrd => noahmp%energy%flux%HeatSensibleVegGrd ,& ! out, vegetated ground sensible heat flux [W/m2] (+ to atm) + HeatSensibleBareGrd => noahmp%energy%flux%HeatSensibleBareGrd ,& ! out, sensible heat flux [W/m2] bare ground (+ to atm) + HeatLatentVegGrd => noahmp%energy%flux%HeatLatentVegGrd ,& ! out, ground evaporation heat flux [W/m2] (+ to atm) + HeatLatentBareGrd => noahmp%energy%flux%HeatLatentBareGrd ,& ! out, latent heat flux [W/m2] bare ground (+ to atm) + HeatLatentCanEvap => noahmp%energy%flux%HeatLatentCanEvap ,& ! out, canopy evaporation heat flux [W/m2] (+ to atm) + HeatLatentCanTransp => noahmp%energy%flux%HeatLatentCanTransp ,& ! out, canopy transpiration heat flux [W/m2] (+ to atm) + HeatGroundVegGrd => noahmp%energy%flux%HeatGroundVegGrd ,& ! out, vegetated ground heat [W/m2] (+ to soil/snow) + HeatGroundBareGrd => noahmp%energy%flux%HeatGroundBareGrd ,& ! out, bare ground heat flux [W/m2] (+ to soil/snow) + HeatCanStorageChg => noahmp%energy%flux%HeatCanStorageChg ,& ! out, canopy heat storage change [W/m2] + HeatFromSoilBot => noahmp%energy%flux%HeatFromSoilBot ,& ! out, energy influx from soil bottom [J/m2] during soil timestep + HeatGroundTotMean => noahmp%energy%flux%HeatGroundTotMean ,& ! out, mean ground heat flux during soil timestep [W/m2] + PhotosynTotal => noahmp%biochem%flux%PhotosynTotal ,& ! out, total leaf photosynthesis [umol co2 /m2 /s] + PhotosynLeafSunlit => noahmp%biochem%flux%PhotosynLeafSunlit ,& ! out, sunlit leaf photosynthesis [umol co2 /m2 /s] + PhotosynLeafShade => noahmp%biochem%flux%PhotosynLeafShade & ! out, shaded leaf photosynthesis [umol co2 /m2 /s] + ) +! ---------------------------------------------------------------------- + + ! initialization + WindStressEwVeg = 0.0 + WindStressNsVeg = 0.0 + RadLwNetCanopy = 0.0 + HeatSensibleCanopy = 0.0 + RadLwNetVegGrd = 0.0 + HeatSensibleVegGrd = 0.0 + HeatLatentVegGrd = 0.0 + HeatLatentCanEvap = 0.0 + HeatLatentCanTransp = 0.0 + HeatGroundVegGrd = 0.0 + PhotosynLeafSunlit = 0.0 + PhotosynLeafShade = 0.0 + TemperatureAir2mVeg = 0.0 + SpecHumidity2mVeg = 0.0 + ExchCoeffShAbvCan = 0.0 + ExchCoeffShLeaf = 0.0 + ExchCoeffShUndCan = 0.0 + ExchCoeffSh2mVeg = 0.0 + HeatPrecipAdvSfc = 0.0 + HeatCanStorageChg = 0.0 + + ! vegetated or non-vegetated + VegAreaIndEff = LeafAreaIndEff + StemAreaIndEff + FlagVegSfc = .false. + if ( VegAreaIndEff > 0.0 ) FlagVegSfc = .true. + + ! ground snow cover fraction [Niu and Yang, 2007, JGR] + call SnowCoverGroundNiu07(noahmp) + + ! ground and surface roughness length and reference height + call GroundRoughnessProperty(noahmp, FlagVegSfc) + + ! Thermal properties of soil, snow, lake, and frozen soil + call GroundThermalProperty(noahmp) + + ! Surface shortwave albedo: ground and canopy radiative transfer + call SurfaceAlbedo(noahmp) + + ! Surface shortwave radiation: absorbed & reflected by the ground and canopy + call SurfaceRadiation(noahmp) + + ! longwave emissivity for vegetation, ground, total net surface + call SurfaceEmissivity(noahmp) + + ! soil water transpiration factor controlling stomatal resistance and evapotranspiration + call SoilWaterTranspiration(noahmp) + + ! soil surface resistance for ground evaporation/sublimation + call ResistanceGroundEvaporation(noahmp) + + ! set psychrometric variable/constant + call PsychrometricVariable(noahmp) + + ! temperatures and energy fluxes of canopy and below-canopy ground + if ( (FlagVegSfc .eqv. .true.) .and. (VegFrac > 0) ) then ! vegetated portion of the grid + TemperatureGrdVeg = TemperatureGrd + ExchCoeffMomAbvCan = ExchCoeffMomSfc + ExchCoeffShAbvCan = ExchCoeffShSfc + call SurfaceEnergyFluxVegetated(noahmp) + endif + + ! temperatures and energy fluxes of bare ground + TemperatureGrdBare = TemperatureGrd + ExchCoeffMomBare = ExchCoeffMomSfc + ExchCoeffShBare = ExchCoeffShSfc + call SurfaceEnergyFluxBareGround(noahmp) + + ! compute grid mean quantities by weighting vegetated and bare portions + ! Energy balance at vege canopy: + ! RadSwAbsVeg = (RadLwNetCanopy + HeatSensibleCanopy + HeatLatentCanEvap + HeatLatentCanTransp) * VegFrac at VegFrac + ! Energy balance at vege ground: + ! RadSwAbsGrd * VegFrac = (RadLwNetVegGrd + HeatSensibleVegGrd + HeatLatentVegGrd + HeatGroundVegGrd) * VegFrac at VegFrac + ! Energy balance at bare ground: + ! RadSwAbsGrd * (1-VegFrac) = (RadLwNetBareGrd + HeatSensibleBareGrd + HeatLatentBareGrd + HeatGroundBareGrd) * (1-VegFrac) at 1-VegFrac + if ( (FlagVegSfc .eqv. .true.) .and. (VegFrac > 0) ) then + WindStressEwSfc = VegFrac * WindStressEwVeg + (1.0 - VegFrac) * WindStressEwBare + WindStressNsSfc = VegFrac * WindStressNsVeg + (1.0 - VegFrac) * WindStressNsBare + RadLwNetSfc = VegFrac * RadLwNetVegGrd + (1.0 - VegFrac) * RadLwNetBareGrd + RadLwNetCanopy + HeatSensibleSfc = VegFrac * HeatSensibleVegGrd + (1.0 - VegFrac) * HeatSensibleBareGrd + HeatSensibleCanopy + HeatLatentGrd = VegFrac * HeatLatentVegGrd + (1.0 - VegFrac) * HeatLatentBareGrd + HeatGroundTot = VegFrac * HeatGroundVegGrd + (1.0 - VegFrac) * HeatGroundBareGrd + HeatLatentCanopy = HeatLatentCanEvap + HeatLatentTransp = HeatLatentCanTransp + HeatPrecipAdvSfc = VegFrac * HeatPrecipAdvVegGrd + (1.0 - VegFrac) * HeatPrecipAdvBareGrd + HeatPrecipAdvCanopy + TemperatureGrd = VegFrac * TemperatureGrdVeg + (1.0 - VegFrac) * TemperatureGrdBare + TemperatureAir2m = VegFrac * TemperatureAir2mVeg + (1.0 - VegFrac) * TemperatureAir2mBare + TemperatureSfc = VegFrac * TemperatureCanopy + (1.0 - VegFrac) * TemperatureGrdBare + ExchCoeffMomSfc = VegFrac * ExchCoeffMomAbvCan + (1.0 - VegFrac) * ExchCoeffMomBare ! better way to average? + ExchCoeffShSfc = VegFrac * ExchCoeffShAbvCan + (1.0 - VegFrac) * ExchCoeffShBare + SpecHumidity2m = VegFrac * SpecHumidity2mVeg + (1.0 - VegFrac) * SpecHumidity2mBare + SpecHumiditySfcMean = VegFrac * (PressureVaporCanAir * 0.622 / & + (PressureAirRefHeight - 0.378*PressureVaporCanAir)) + (1.0 - VegFrac) * SpecHumiditySfc + RoughLenMomSfcToAtm = RoughLenMomSfc + else + WindStressEwSfc = WindStressEwBare + WindStressNsSfc = WindStressNsBare + RadLwNetSfc = RadLwNetBareGrd + HeatSensibleSfc = HeatSensibleBareGrd + HeatLatentGrd = HeatLatentBareGrd + HeatGroundTot = HeatGroundBareGrd + TemperatureGrd = TemperatureGrdBare + TemperatureAir2m = TemperatureAir2mBare + HeatLatentCanopy = 0.0 + HeatLatentTransp = 0.0 + HeatPrecipAdvSfc = HeatPrecipAdvBareGrd + TemperatureSfc = TemperatureGrd + ExchCoeffMomSfc = ExchCoeffMomBare + ExchCoeffShSfc = ExchCoeffShBare + SpecHumiditySfcMean = SpecHumiditySfc + SpecHumidity2m = SpecHumidity2mBare + ResistanceStomataSunlit = 0.0 + ResistanceStomataShade = 0.0 + TemperatureGrdVeg = TemperatureGrdBare + ExchCoeffShAbvCan = ExchCoeffShBare + RoughLenMomSfcToAtm = RoughLenMomGrd + endif + + ! emitted longwave radiation and physical check + RadLwEmitSfc = RadLwDownRefHeight + RadLwNetSfc + if ( RadLwEmitSfc <= 0.0 ) then + write(*,*) "emitted longwave <0; skin T may be wrong due to inconsistent" + write(*,*) "input of VegFracGreen with LeafAreaIndex" + write(*,*) "VegFrac = ", VegFrac, "VegAreaIndEff = ", VegAreaIndEff, & + "TemperatureCanopy = ", TemperatureCanopy, "TemperatureGrd = ", TemperatureGrd + write(*,*) "RadLwDownRefHeight = ", RadLwDownRefHeight, "RadLwNetSfc = ", RadLwNetSfc, "SnowDepth = ", SnowDepth + stop "Error: Longwave radiation budget problem in NoahMP LSM" + endif + + ! radiative temperature: subtract from the emitted IR the + ! reflected portion of the incoming longwave radiation, so just + ! considering the IR originating/emitted in the canopy/ground system. + ! Old TemperatureRadSfc calculation not taking into account Emissivity: + ! TemperatureRadSfc = (RadLwEmitSfc/ConstStefanBoltzmann)**0.25 + TemperatureRadSfc = ((RadLwEmitSfc - (1.0-EmissivitySfc)*RadLwDownRefHeight) / (EmissivitySfc*ConstStefanBoltzmann))**0.25 + + ! other photosynthesis related quantities for biochem process + RadPhotoActAbsCan = RadPhotoActAbsSunlit * LeafAreaIndSunlit + RadPhotoActAbsShade * LeafAreaIndShade + PhotosynTotal = PhotosynLeafSunlit * LeafAreaIndSunlit + PhotosynLeafShade * LeafAreaIndShade + + ! compute snow and soil layer temperature at soil timestep + HeatFromSoilBot = 0.0 + HeatGroundTotAcc = HeatGroundTotAcc + HeatGroundTot + + + if ( FlagSoilProcess .eqv. .true. ) then + HeatGroundTotMean = HeatGroundTotAcc / NumSoilTimeStep + call SoilSnowTemperatureMain(noahmp) + endif ! FlagSoilProcess + + ! adjusting suface temperature based on snow condition + if ( OptSnowSoilTempTime == 2 ) then + if ( (SnowDepth > 0.05) .and. (TemperatureGrd > ConstFreezePoint) ) then + TemperatureGrdVeg = ConstFreezePoint + TemperatureGrdBare = ConstFreezePoint + if ( (FlagVegSfc .eqv. .true.) .and. (VegFrac > 0) ) then + TemperatureGrd = VegFrac * TemperatureGrdVeg + (1.0 - VegFrac) * TemperatureGrdBare + TemperatureSfc = VegFrac * TemperatureCanopy + (1.0 - VegFrac) * TemperatureGrdBare + else + TemperatureGrd = TemperatureGrdBare + TemperatureSfc = TemperatureGrdBare + endif + endif + endif + +! call mpas_log_write('noahmp input max tslb=$r', realArgs=(/maxval(noahmp%energy%state%TemperatureSoilSnow)/)) +! call mpas_log_write('noahmp input min tslb=$r', realArgs=(/minval(noahmp%energy%state%TemperatureSoilSnow)/)) + + ! Phase change and Energy released or consumed by snow & frozen soil + call SoilSnowWaterPhaseChange(noahmp) + +! call mpas_log_write('noahmp output max tslb=$r', realArgs=(/maxval(noahmp%energy%state%TemperatureSoilSnow)/)) +! call mpas_log_write('noahmp output min tslb=$r', realArgs=(/minval(noahmp%energy%state%TemperatureSoilSnow)/)) + + ! update sensible heat flux due to sprinkler irrigation evaporation + if ( (FlagCropland .eqv. .true.) .and. (IrrigationFracGrid >= IrriFracThreshold) ) & + HeatSensibleSfc = HeatSensibleSfc - HeatLatentIrriEvap + + ! update total surface albedo + if ( RadSwDownRefHeight > 0.0 ) then + AlbedoSfc = RadSwReflSfc / RadSwDownRefHeight + else + AlbedoSfc = undefined_real + endif + + end associate + + end subroutine EnergyMain + +end module EnergyMainMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/EnergyVarInitMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/EnergyVarInitMod.F90 new file mode 100644 index 000000000..16484712b --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/EnergyVarInitMod.F90 @@ -0,0 +1,398 @@ +module EnergyVarInitMod + +!!! Initialize column (1-D) Noah-MP energy variables +!!! Energy variables should be first defined in EnergyVarType.F90 + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use Machine + use NoahmpVarType + + implicit none + +contains + +!=== initialize with default values + subroutine EnergyVarInitDefault(noahmp) + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + + associate( & + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& + NumSwRadBand => noahmp%config%domain%NumSwRadBand & + ) + + ! energy state variables + noahmp%energy%state%FlagFrozenCanopy = .false. + noahmp%energy%state%FlagFrozenGround = .false. + noahmp%energy%state%LeafAreaIndEff = undefined_real + noahmp%energy%state%StemAreaIndEff = undefined_real + noahmp%energy%state%LeafAreaIndex = undefined_real + noahmp%energy%state%StemAreaIndex = undefined_real + noahmp%energy%state%VegAreaIndEff = undefined_real + noahmp%energy%state%VegFrac = undefined_real + noahmp%energy%state%PressureVaporRefHeight = undefined_real + noahmp%energy%state%SnowAgeFac = undefined_real + noahmp%energy%state%SnowAgeNondim = undefined_real + noahmp%energy%state%AlbedoSnowPrev = undefined_real + noahmp%energy%state%VegAreaProjDir = undefined_real + noahmp%energy%state%GapBtwCanopy = undefined_real + noahmp%energy%state%GapInCanopy = undefined_real + noahmp%energy%state%GapCanopyDif = undefined_real + noahmp%energy%state%GapCanopyDir = undefined_real + noahmp%energy%state%CanopySunlitFrac = undefined_real + noahmp%energy%state%CanopyShadeFrac = undefined_real + noahmp%energy%state%LeafAreaIndSunlit = undefined_real + noahmp%energy%state%LeafAreaIndShade = undefined_real + noahmp%energy%state%VapPresSatCanopy = undefined_real + noahmp%energy%state%VapPresSatGrdVeg = undefined_real + noahmp%energy%state%VapPresSatGrdBare = undefined_real + noahmp%energy%state%VapPresSatCanTempD = undefined_real + noahmp%energy%state%VapPresSatGrdVegTempD = undefined_real + noahmp%energy%state%VapPresSatGrdBareTempD = undefined_real + noahmp%energy%state%PressureVaporCanAir = undefined_real + noahmp%energy%state%PressureAtmosCO2 = undefined_real + noahmp%energy%state%PressureAtmosO2 = undefined_real + noahmp%energy%state%ResistanceStomataSunlit = undefined_real + noahmp%energy%state%ResistanceStomataShade = undefined_real + noahmp%energy%state%DensityAirRefHeight = undefined_real + noahmp%energy%state%TemperatureCanopyAir = undefined_real + noahmp%energy%state%ZeroPlaneDispSfc = undefined_real + noahmp%energy%state%ZeroPlaneDispGrd = undefined_real + noahmp%energy%state%RoughLenMomGrd = undefined_real + noahmp%energy%state%RoughLenMomSfc = undefined_real + noahmp%energy%state%CanopyHeight = undefined_real + noahmp%energy%state%WindSpdCanopyTop = undefined_real + noahmp%energy%state%RoughLenShCanopy = undefined_real + noahmp%energy%state%RoughLenShVegGrd = undefined_real + noahmp%energy%state%RoughLenShBareGrd = undefined_real + noahmp%energy%state%FrictionVelVeg = undefined_real + noahmp%energy%state%FrictionVelBare = undefined_real + noahmp%energy%state%WindExtCoeffCanopy = undefined_real + noahmp%energy%state%MoStabParaUndCan = undefined_real + noahmp%energy%state%MoStabParaAbvCan = undefined_real + noahmp%energy%state%MoStabParaBare = undefined_real + noahmp%energy%state%MoStabParaVeg2m = undefined_real + noahmp%energy%state%MoStabParaBare2m = undefined_real + noahmp%energy%state%MoLengthUndCan = undefined_real + noahmp%energy%state%MoLengthAbvCan = undefined_real + noahmp%energy%state%MoLengthBare = undefined_real + noahmp%energy%state%MoStabCorrShUndCan = undefined_real + noahmp%energy%state%MoStabCorrMomAbvCan = undefined_real + noahmp%energy%state%MoStabCorrShAbvCan = undefined_real + noahmp%energy%state%MoStabCorrMomVeg2m = undefined_real + noahmp%energy%state%MoStabCorrShVeg2m = undefined_real + noahmp%energy%state%MoStabCorrShBare = undefined_real + noahmp%energy%state%MoStabCorrMomBare = undefined_real + noahmp%energy%state%MoStabCorrMomBare2m = undefined_real + noahmp%energy%state%MoStabCorrShBare2m = undefined_real + noahmp%energy%state%ExchCoeffMomSfc = undefined_real + noahmp%energy%state%ExchCoeffMomAbvCan = undefined_real + noahmp%energy%state%ExchCoeffMomBare = undefined_real + noahmp%energy%state%ExchCoeffShSfc = undefined_real + noahmp%energy%state%ExchCoeffShBare = undefined_real + noahmp%energy%state%ExchCoeffShAbvCan = undefined_real + noahmp%energy%state%ExchCoeffShLeaf = undefined_real + noahmp%energy%state%ExchCoeffShUndCan = undefined_real + noahmp%energy%state%ExchCoeffSh2mVegMo = undefined_real + noahmp%energy%state%ExchCoeffSh2mBareMo = undefined_real + noahmp%energy%state%ExchCoeffSh2mVeg = undefined_real + noahmp%energy%state%ExchCoeffSh2mBare = undefined_real + noahmp%energy%state%ExchCoeffLhAbvCan = undefined_real + noahmp%energy%state%ExchCoeffLhTransp = undefined_real + noahmp%energy%state%ExchCoeffLhEvap = undefined_real + noahmp%energy%state%ExchCoeffLhUndCan = undefined_real + noahmp%energy%state%ResistanceMomUndCan = undefined_real + noahmp%energy%state%ResistanceShUndCan = undefined_real + noahmp%energy%state%ResistanceLhUndCan = undefined_real + noahmp%energy%state%ResistanceMomAbvCan = undefined_real + noahmp%energy%state%ResistanceShAbvCan = undefined_real + noahmp%energy%state%ResistanceLhAbvCan = undefined_real + noahmp%energy%state%ResistanceMomBareGrd = undefined_real + noahmp%energy%state%ResistanceShBareGrd = undefined_real + noahmp%energy%state%ResistanceLhBareGrd = undefined_real + noahmp%energy%state%ResistanceLeafBoundary = undefined_real + noahmp%energy%state%TemperaturePotRefHeight = undefined_real + noahmp%energy%state%WindSpdRefHeight = undefined_real + noahmp%energy%state%FrictionVelVertVeg = undefined_real + noahmp%energy%state%FrictionVelVertBare = undefined_real + noahmp%energy%state%EmissivityVeg = undefined_real + noahmp%energy%state%EmissivityGrd = undefined_real + noahmp%energy%state%ResistanceGrdEvap = undefined_real + noahmp%energy%state%PsychConstCanopy = undefined_real + noahmp%energy%state%LatHeatVapCanopy = undefined_real + noahmp%energy%state%PsychConstGrd = undefined_real + noahmp%energy%state%LatHeatVapGrd = undefined_real + noahmp%energy%state%RelHumidityGrd = undefined_real + noahmp%energy%state%SpecHumiditySfcMean = undefined_real + noahmp%energy%state%SpecHumiditySfc = undefined_real + noahmp%energy%state%SpecHumidity2mVeg = undefined_real + noahmp%energy%state%SpecHumidity2mBare = undefined_real + noahmp%energy%state%SpecHumidity2m = undefined_real + noahmp%energy%state%TemperatureSfc = undefined_real + noahmp%energy%state%TemperatureGrd = undefined_real + noahmp%energy%state%TemperatureCanopy = undefined_real + noahmp%energy%state%TemperatureGrdVeg = undefined_real + noahmp%energy%state%TemperatureGrdBare = undefined_real + noahmp%energy%state%TemperatureRootZone = undefined_real + noahmp%energy%state%WindStressEwVeg = undefined_real + noahmp%energy%state%WindStressNsVeg = undefined_real + noahmp%energy%state%WindStressEwBare = undefined_real + noahmp%energy%state%WindStressNsBare = undefined_real + noahmp%energy%state%WindStressEwSfc = undefined_real + noahmp%energy%state%WindStressNsSfc = undefined_real + noahmp%energy%state%TemperatureAir2mVeg = undefined_real + noahmp%energy%state%TemperatureAir2mBare = undefined_real + noahmp%energy%state%TemperatureAir2m = undefined_real + noahmp%energy%state%CanopyFracSnowBury = undefined_real + noahmp%energy%state%DepthSoilTempBotToSno = undefined_real + noahmp%energy%state%RoughLenMomSfcToAtm = undefined_real + noahmp%energy%state%TemperatureRadSfc = undefined_real + noahmp%energy%state%EmissivitySfc = undefined_real + noahmp%energy%state%AlbedoSfc = undefined_real + noahmp%energy%state%EnergyBalanceError = undefined_real + noahmp%energy%state%RadSwBalanceError = undefined_real + noahmp%energy%state%RefHeightAboveGrd = undefined_real + + if ( .not. allocated(noahmp%energy%state%TemperatureSoilSnow) ) & + allocate( noahmp%energy%state%TemperatureSoilSnow(-NumSnowLayerMax+1:NumSoilLayer) ) + if ( .not. allocated(noahmp%energy%state%ThermConductSoilSnow) ) & + allocate( noahmp%energy%state%ThermConductSoilSnow(-NumSnowLayerMax+1:NumSoilLayer) ) + if ( .not. allocated(noahmp%energy%state%HeatCapacSoilSnow) ) & + allocate( noahmp%energy%state%HeatCapacSoilSnow(-NumSnowLayerMax+1:NumSoilLayer) ) + if ( .not. allocated(noahmp%energy%state%PhaseChgFacSoilSnow) ) & + allocate( noahmp%energy%state%PhaseChgFacSoilSnow(-NumSnowLayerMax+1:NumSoilLayer) ) + if ( .not. allocated(noahmp%energy%state%HeatCapacVolSnow) ) & + allocate( noahmp%energy%state%HeatCapacVolSnow(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%energy%state%ThermConductSnow) ) & + allocate( noahmp%energy%state%ThermConductSnow(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%energy%state%HeatCapacVolSoil) ) & + allocate( noahmp%energy%state%HeatCapacVolSoil(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%energy%state%ThermConductSoil) ) & + allocate( noahmp%energy%state%ThermConductSoil(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%energy%state%HeatCapacGlaIce) ) & + allocate( noahmp%energy%state%HeatCapacGlaIce(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%energy%state%ThermConductGlaIce) ) & + allocate( noahmp%energy%state%ThermConductGlaIce(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%energy%state%AlbedoSnowDir) ) & + allocate( noahmp%energy%state%AlbedoSnowDir(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%state%AlbedoSnowDif) ) & + allocate( noahmp%energy%state%AlbedoSnowDif(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%state%AlbedoSoilDir) ) & + allocate( noahmp%energy%state%AlbedoSoilDir(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%state%AlbedoSoilDif) ) & + allocate( noahmp%energy%state%AlbedoSoilDif(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%state%AlbedoGrdDir) ) & + allocate( noahmp%energy%state%AlbedoGrdDir(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%state%AlbedoGrdDif) ) & + allocate( noahmp%energy%state%AlbedoGrdDif(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%state%ReflectanceVeg) ) & + allocate( noahmp%energy%state%ReflectanceVeg(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%state%TransmittanceVeg) ) & + allocate( noahmp%energy%state%TransmittanceVeg(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%state%AlbedoSfcDir) ) & + allocate( noahmp%energy%state%AlbedoSfcDir(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%state%AlbedoSfcDif) ) & + allocate( noahmp%energy%state%AlbedoSfcDif(1:NumSwRadBand) ) + + noahmp%energy%state%TemperatureSoilSnow (:) = undefined_real + noahmp%energy%state%ThermConductSoilSnow(:) = undefined_real + noahmp%energy%state%HeatCapacSoilSnow (:) = undefined_real + noahmp%energy%state%PhaseChgFacSoilSnow (:) = undefined_real + noahmp%energy%state%HeatCapacVolSnow (:) = undefined_real + noahmp%energy%state%ThermConductSnow (:) = undefined_real + noahmp%energy%state%HeatCapacVolSoil (:) = undefined_real + noahmp%energy%state%ThermConductSoil (:) = undefined_real + noahmp%energy%state%HeatCapacGlaIce (:) = undefined_real + noahmp%energy%state%ThermConductGlaIce (:) = undefined_real + noahmp%energy%state%AlbedoSnowDir (:) = undefined_real + noahmp%energy%state%AlbedoSnowDif (:) = undefined_real + noahmp%energy%state%AlbedoSoilDir (:) = undefined_real + noahmp%energy%state%AlbedoSoilDif (:) = undefined_real + noahmp%energy%state%AlbedoGrdDir (:) = undefined_real + noahmp%energy%state%AlbedoGrdDif (:) = undefined_real + noahmp%energy%state%ReflectanceVeg (:) = undefined_real + noahmp%energy%state%TransmittanceVeg (:) = undefined_real + noahmp%energy%state%AlbedoSfcDir (:) = undefined_real + noahmp%energy%state%AlbedoSfcDif (:) = undefined_real + + ! energy flux variables + noahmp%energy%flux%HeatLatentCanopy = undefined_real + noahmp%energy%flux%HeatLatentTransp = undefined_real + noahmp%energy%flux%HeatLatentGrd = undefined_real + noahmp%energy%flux%HeatPrecipAdvCanopy = undefined_real + noahmp%energy%flux%HeatPrecipAdvVegGrd = undefined_real + noahmp%energy%flux%HeatPrecipAdvBareGrd = undefined_real + noahmp%energy%flux%HeatPrecipAdvSfc = undefined_real + noahmp%energy%flux%RadPhotoActAbsSunlit = undefined_real + noahmp%energy%flux%RadPhotoActAbsShade = undefined_real + noahmp%energy%flux%RadSwAbsVeg = undefined_real + noahmp%energy%flux%RadSwAbsGrd = undefined_real + noahmp%energy%flux%RadSwAbsSfc = undefined_real + noahmp%energy%flux%RadSwReflSfc = undefined_real + noahmp%energy%flux%RadSwReflVeg = undefined_real + noahmp%energy%flux%RadSwReflGrd = undefined_real + noahmp%energy%flux%RadLwNetCanopy = undefined_real + noahmp%energy%flux%HeatSensibleCanopy = undefined_real + noahmp%energy%flux%HeatLatentCanEvap = undefined_real + noahmp%energy%flux%RadLwNetVegGrd = undefined_real + noahmp%energy%flux%HeatSensibleVegGrd = undefined_real + noahmp%energy%flux%HeatLatentVegGrd = undefined_real + noahmp%energy%flux%HeatLatentCanTransp = undefined_real + noahmp%energy%flux%HeatGroundVegGrd = undefined_real + noahmp%energy%flux%RadLwNetBareGrd = undefined_real + noahmp%energy%flux%HeatSensibleBareGrd = undefined_real + noahmp%energy%flux%HeatLatentBareGrd = undefined_real + noahmp%energy%flux%HeatGroundBareGrd = undefined_real + noahmp%energy%flux%HeatGroundTot = undefined_real + noahmp%energy%flux%HeatFromSoilBot = undefined_real + noahmp%energy%flux%RadLwNetSfc = undefined_real + noahmp%energy%flux%HeatSensibleSfc = undefined_real + noahmp%energy%flux%RadPhotoActAbsCan = undefined_real + noahmp%energy%flux%RadLwEmitSfc = undefined_real + noahmp%energy%flux%HeatCanStorageChg = undefined_real + noahmp%energy%flux%HeatGroundTotAcc = undefined_real + noahmp%energy%flux%HeatGroundTotMean = undefined_real + noahmp%energy%flux%HeatLatentIrriEvap = 0.0 + + if ( .not. allocated(noahmp%energy%flux%RadSwAbsVegDir) ) & + allocate( noahmp%energy%flux%RadSwAbsVegDir(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%flux%RadSwAbsVegDif) ) & + allocate( noahmp%energy%flux%RadSwAbsVegDif(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%flux%RadSwDirTranGrdDir) ) & + allocate( noahmp%energy%flux%RadSwDirTranGrdDir(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%flux%RadSwDirTranGrdDif) ) & + allocate( noahmp%energy%flux%RadSwDirTranGrdDif(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%flux%RadSwDifTranGrdDir) ) & + allocate( noahmp%energy%flux%RadSwDifTranGrdDir(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%flux%RadSwDifTranGrdDif) ) & + allocate( noahmp%energy%flux%RadSwDifTranGrdDif(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%flux%RadSwReflVegDir) ) & + allocate( noahmp%energy%flux%RadSwReflVegDir(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%flux%RadSwReflVegDif) ) & + allocate( noahmp%energy%flux%RadSwReflVegDif(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%flux%RadSwReflGrdDir) ) & + allocate( noahmp%energy%flux%RadSwReflGrdDir(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%flux%RadSwReflGrdDif) ) & + allocate( noahmp%energy%flux%RadSwReflGrdDif(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%flux%RadSwDownDir) ) & + allocate( noahmp%energy%flux%RadSwDownDir(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%flux%RadSwDownDif) ) & + allocate( noahmp%energy%flux%RadSwDownDif(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%flux%RadSwPenetrateGrd) ) & + allocate( noahmp%energy%flux%RadSwPenetrateGrd(-NumSnowLayerMax+1:NumSoilLayer) ) + + noahmp%energy%flux%RadSwAbsVegDir (:) = undefined_real + noahmp%energy%flux%RadSwAbsVegDif (:) = undefined_real + noahmp%energy%flux%RadSwDirTranGrdDir(:) = undefined_real + noahmp%energy%flux%RadSwDirTranGrdDif(:) = undefined_real + noahmp%energy%flux%RadSwDifTranGrdDir(:) = undefined_real + noahmp%energy%flux%RadSwDifTranGrdDif(:) = undefined_real + noahmp%energy%flux%RadSwReflVegDir (:) = undefined_real + noahmp%energy%flux%RadSwReflVegDif (:) = undefined_real + noahmp%energy%flux%RadSwReflGrdDir (:) = undefined_real + noahmp%energy%flux%RadSwReflGrdDif (:) = undefined_real + noahmp%energy%flux%RadSwDownDir (:) = undefined_real + noahmp%energy%flux%RadSwDownDif (:) = undefined_real + noahmp%energy%flux%RadSwPenetrateGrd (:) = undefined_real + + ! energy parameter variables + noahmp%energy%param%TreeCrownRadius = undefined_real + noahmp%energy%param%HeightCanopyTop = undefined_real + noahmp%energy%param%HeightCanopyBot = undefined_real + noahmp%energy%param%RoughLenMomVeg = undefined_real + noahmp%energy%param%TreeDensity = undefined_real + noahmp%energy%param%CanopyOrientIndex = undefined_real + noahmp%energy%param%UpscatterCoeffSnowDir = undefined_real + noahmp%energy%param%UpscatterCoeffSnowDif = undefined_real + noahmp%energy%param%SoilHeatCapacity = undefined_real + noahmp%energy%param%SnowAgeFacBats = undefined_real + noahmp%energy%param%SnowGrowVapFacBats = undefined_real + noahmp%energy%param%SnowSootFacBats = undefined_real + noahmp%energy%param%SnowGrowFrzFacBats = undefined_real + noahmp%energy%param%SolarZenithAdjBats = undefined_real + noahmp%energy%param%FreshSnoAlbVisBats = undefined_real + noahmp%energy%param%FreshSnoAlbNirBats = undefined_real + noahmp%energy%param%SnoAgeFacDifVisBats = undefined_real + noahmp%energy%param%SnoAgeFacDifNirBats = undefined_real + noahmp%energy%param%SzaFacDirVisBats = undefined_real + noahmp%energy%param%SzaFacDirNirBats = undefined_real + noahmp%energy%param%SnowAlbRefClass = undefined_real + noahmp%energy%param%SnowAgeFacClass = undefined_real + noahmp%energy%param%SnowAlbFreshClass = undefined_real + noahmp%energy%param%ConductanceLeafMin = undefined_real + noahmp%energy%param%Co2MmConst25C = undefined_real + noahmp%energy%param%O2MmConst25C = undefined_real + noahmp%energy%param%Co2MmConstQ10 = undefined_real + noahmp%energy%param%O2MmConstQ10 = undefined_real + noahmp%energy%param%RadiationStressFac = undefined_real + noahmp%energy%param%ResistanceStomataMin = undefined_real + noahmp%energy%param%ResistanceStomataMax = undefined_real + noahmp%energy%param%AirTempOptimTransp = undefined_real + noahmp%energy%param%VaporPresDeficitFac = undefined_real + noahmp%energy%param%LeafDimLength = undefined_real + noahmp%energy%param%ZilitinkevichCoeff = undefined_real + noahmp%energy%param%EmissivitySnow = undefined_real + noahmp%energy%param%CanopyWindExtFac = undefined_real + noahmp%energy%param%RoughLenMomSnow = undefined_real + noahmp%energy%param%RoughLenMomSoil = undefined_real + noahmp%energy%param%RoughLenMomLake = undefined_real + noahmp%energy%param%EmissivityIceSfc = undefined_real + noahmp%energy%param%ResistanceSoilExp = undefined_real + noahmp%energy%param%ResistanceSnowSfc = undefined_real + noahmp%energy%param%VegFracAnnMax = undefined_real + noahmp%energy%param%VegFracGreen = undefined_real + noahmp%energy%param%HeatCapacCanFac = undefined_real + + if ( .not. allocated(noahmp%energy%param%LeafAreaIndexMon) ) & + allocate( noahmp%energy%param%LeafAreaIndexMon(1:12) ) + if ( .not. allocated(noahmp%energy%param%StemAreaIndexMon) ) & + allocate( noahmp%energy%param%StemAreaIndexMon(1:12) ) + if ( .not. allocated(noahmp%energy%param%SoilQuartzFrac) ) & + allocate( noahmp%energy%param%SoilQuartzFrac(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%energy%param%AlbedoSoilSat) ) & + allocate( noahmp%energy%param%AlbedoSoilSat(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%param%AlbedoSoilDry) ) & + allocate( noahmp%energy%param%AlbedoSoilDry(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%param%AlbedoLakeFrz) ) & + allocate( noahmp%energy%param%AlbedoLakeFrz(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%param%ScatterCoeffSnow) ) & + allocate( noahmp%energy%param%ScatterCoeffSnow(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%param%ReflectanceLeaf) ) & + allocate( noahmp%energy%param%ReflectanceLeaf(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%param%ReflectanceStem) ) & + allocate( noahmp%energy%param%ReflectanceStem(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%param%TransmittanceLeaf) ) & + allocate( noahmp%energy%param%TransmittanceLeaf(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%param%TransmittanceStem) ) & + allocate( noahmp%energy%param%TransmittanceStem(1:NumSwRadBand) ) + if ( .not. allocated(noahmp%energy%param%EmissivitySoilLake) ) & + allocate( noahmp%energy%param%EmissivitySoilLake(1:2) ) + if ( .not. allocated(noahmp%energy%param%AlbedoLandIce) ) & + allocate( noahmp%energy%param%AlbedoLandIce(1:NumSwRadBand) ) + + noahmp%energy%param%LeafAreaIndexMon (:) = undefined_real + noahmp%energy%param%StemAreaIndexMon (:) = undefined_real + noahmp%energy%param%SoilQuartzFrac (:) = undefined_real + noahmp%energy%param%AlbedoSoilSat (:) = undefined_real + noahmp%energy%param%AlbedoSoilDry (:) = undefined_real + noahmp%energy%param%AlbedoLakeFrz (:) = undefined_real + noahmp%energy%param%ScatterCoeffSnow (:) = undefined_real + noahmp%energy%param%ReflectanceLeaf (:) = undefined_real + noahmp%energy%param%ReflectanceStem (:) = undefined_real + noahmp%energy%param%TransmittanceLeaf (:) = undefined_real + noahmp%energy%param%TransmittanceStem (:) = undefined_real + noahmp%energy%param%EmissivitySoilLake(:) = undefined_real + noahmp%energy%param%AlbedoLandIce (:) = undefined_real + + end associate + + end subroutine EnergyVarInitDefault + +end module EnergyVarInitMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/EnergyVarType.F90 b/src/core_atmosphere/physics/physics_noahmp/src/EnergyVarType.F90 new file mode 100644 index 000000000..0805d3034 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/EnergyVarType.F90 @@ -0,0 +1,309 @@ +module EnergyVarType + +!!! Define column (1-D) Noah-MP Energy variables +!!! Energy variable initialization is done in EnergyVarInitMod.F90 + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use Machine + + implicit none + save + private + +!=== define "flux" sub-type of energy (energy%flux%variable) + type :: flux_type + + real(kind=kind_noahmp) :: HeatLatentCanopy ! canopy latent heat flux [W/m2] (+ to atm) + real(kind=kind_noahmp) :: HeatLatentTransp ! latent heat flux from transpiration [W/m2] (+ to atm) + real(kind=kind_noahmp) :: HeatLatentGrd ! total ground latent heat [W/m2] (+ to atm) + real(kind=kind_noahmp) :: HeatLatentIrriEvap ! latent heating due to sprinkler irrigation evaporation [W/m2] + real(kind=kind_noahmp) :: HeatPrecipAdvCanopy ! precipitation advected heat - canopy net [W/m2] + real(kind=kind_noahmp) :: HeatPrecipAdvVegGrd ! precipitation advected heat - vegetated ground net [W/m2] + real(kind=kind_noahmp) :: HeatPrecipAdvBareGrd ! precipitation advected heat - bare ground net [W/m2] + real(kind=kind_noahmp) :: HeatPrecipAdvSfc ! precipitation advected heat - total [W/m2] + real(kind=kind_noahmp) :: HeatSensibleCanopy ! canopy sensible heat flux [W/m2] (+ to atm) + real(kind=kind_noahmp) :: HeatLatentCanEvap ! canopy evaporation heat flux [W/m2] (+ to atm) + real(kind=kind_noahmp) :: HeatSensibleVegGrd ! vegetated ground sensible heat flux [W/m2] (+ to atm) + real(kind=kind_noahmp) :: HeatSensibleSfc ! total sensible heat [W/m2] (+ to atm) + real(kind=kind_noahmp) :: HeatLatentVegGrd ! vegetated ground latent heat flux [W/m2] (+ to atm) + real(kind=kind_noahmp) :: HeatLatentCanTransp ! canopy transpiration latent heat flux [W/m2] (+ to atm) + real(kind=kind_noahmp) :: HeatGroundVegGrd ! vegetated ground heat flux [W/m2] (+ to soil/snow) + real(kind=kind_noahmp) :: HeatSensibleBareGrd ! bare ground sensible heat flux [W/m2] (+ to atm) + real(kind=kind_noahmp) :: HeatLatentBareGrd ! bare ground latent heat flux [W/m2] (+ to atm) + real(kind=kind_noahmp) :: HeatGroundBareGrd ! bare ground heat flux [W/m2] (+ to soil/snow) + real(kind=kind_noahmp) :: HeatGroundTot ! total ground heat flux [W/m2] (+ to soil/snow) + real(kind=kind_noahmp) :: HeatGroundTotMean ! total ground heat flux [W/m2] averaged over soil timestep + real(kind=kind_noahmp) :: HeatFromSoilBot ! energy influx from soil bottom [W/m2] + real(kind=kind_noahmp) :: HeatCanStorageChg ! canopy heat storage change [W/m2] + real(kind=kind_noahmp) :: HeatGroundTotAcc ! accumulated total ground heat flux per soil timestep [W/m2 * dt_soil/dt_main] (+ to soil/snow) + real(kind=kind_noahmp) :: RadPhotoActAbsSunlit ! absorbed photosyn. active radiation for sunlit leaves [W/m2] + real(kind=kind_noahmp) :: RadPhotoActAbsShade ! absorbed photosyn. active radiation for shaded leaves [W/m2] + real(kind=kind_noahmp) :: RadSwAbsVeg ! solar radiation absorbed by vegetation [W/m2] + real(kind=kind_noahmp) :: RadSwAbsGrd ! solar radiation absorbed by ground [W/m2] + real(kind=kind_noahmp) :: RadSwAbsSfc ! total absorbed solar radiation [W/m2] + real(kind=kind_noahmp) :: RadSwReflSfc ! total reflected solar radiation [W/m2] + real(kind=kind_noahmp) :: RadSwReflVeg ! reflected solar radiation by vegetation [W/m2] + real(kind=kind_noahmp) :: RadSwReflGrd ! reflected solar radiation by ground [W/m2] + real(kind=kind_noahmp) :: RadLwNetCanopy ! canopy net longwave radiation [W/m2] (+ to atm) + real(kind=kind_noahmp) :: RadLwNetSfc ! total net longwave radiation [W/m2] (+ to atm) + real(kind=kind_noahmp) :: RadPhotoActAbsCan ! total photosyn. active energy [W/m2] absorbed by canopy + real(kind=kind_noahmp) :: RadLwEmitSfc ! emitted outgoing longwave radiation [W/m2] + real(kind=kind_noahmp) :: RadLwNetVegGrd ! vegetated ground net longwave radiation [W/m2] (+ to atm) + real(kind=kind_noahmp) :: RadLwNetBareGrd ! bare ground net longwave rad [W/m2] (+ to atm) + + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwAbsVegDir ! solar flux absorbed by veg per unit direct flux + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwAbsVegDif ! solar flux absorbed by veg per unit diffuse flux + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwDirTranGrdDir ! transmitted direct flux below veg per unit direct flux + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwDirTranGrdDif ! transmitted direct flux below veg per unit diffuse flux + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwDifTranGrdDir ! transmitted diffuse flux below veg per unit direct flux + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwDifTranGrdDif ! transmitted diffuse flux below veg per unit diffuse flux + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwReflVegDir ! solar flux reflected by veg layer per unit direct flux + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwReflVegDif ! solar flux reflected by veg layer per unit diffuse flux + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwReflGrdDir ! solar flux reflected by ground per unit direct flux + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwReflGrdDif ! solar flux reflected by ground per unit diffuse flux + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwDownDir ! incoming direct solar radiation [W/m2] + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwDownDif ! incoming diffuse solar radiation [W/m2] + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwPenetrateGrd ! light penetrating through soil/snow water [W/m2] + + end type flux_type + + +!=== define "state" sub-type of energy (energy%state%variable) + type :: state_type + + logical :: FlagFrozenCanopy ! frozen canopy flag used to define latent heat pathway + logical :: FlagFrozenGround ! frozen ground flag used to define latent heat pathway + real(kind=kind_noahmp) :: LeafAreaIndEff ! effective leaf area index, after burying by snow + real(kind=kind_noahmp) :: StemAreaIndEff ! effective stem area index, after burying by snow + real(kind=kind_noahmp) :: LeafAreaIndex ! leaf area index + real(kind=kind_noahmp) :: StemAreaIndex ! stem area index + real(kind=kind_noahmp) :: VegAreaIndEff ! one-sided leaf+stem area index [m2/m2], after burying by snow + real(kind=kind_noahmp) :: VegFrac ! greeness vegetation fraction + real(kind=kind_noahmp) :: TemperatureGrd ! ground temperature [K] + real(kind=kind_noahmp) :: TemperatureCanopy ! vegetation/canopy temperature [K] + real(kind=kind_noahmp) :: TemperatureSfc ! surface temperature [K] + real(kind=kind_noahmp) :: TemperatureRootZone ! root-zone averaged temperature [K] + real(kind=kind_noahmp) :: PressureVaporRefHeight ! vapor pressure air [Pa] + real(kind=kind_noahmp) :: SnowAgeFac ! snow age factor + real(kind=kind_noahmp) :: SnowAgeNondim ! non-dimensional snow age + real(kind=kind_noahmp) :: AlbedoSnowPrev ! snow albedo at last time step + real(kind=kind_noahmp) :: VegAreaProjDir ! projected leaf+stem area in solar direction + real(kind=kind_noahmp) :: GapBtwCanopy ! between canopy gap fraction for beam + real(kind=kind_noahmp) :: GapInCanopy ! within canopy gap fraction for beam + real(kind=kind_noahmp) :: GapCanopyDif ! gap fraction for diffue light + real(kind=kind_noahmp) :: GapCanopyDir ! total gap fraction for beam (<=1-shafac) + real(kind=kind_noahmp) :: CanopySunlitFrac ! sunlit fraction of canopy + real(kind=kind_noahmp) :: CanopyShadeFrac ! shaded fraction of canopy + real(kind=kind_noahmp) :: LeafAreaIndSunlit ! sunlit leaf area + real(kind=kind_noahmp) :: LeafAreaIndShade ! shaded leaf area + real(kind=kind_noahmp) :: VapPresSatCanopy ! canopy saturation vapor pressure at veg temperature [Pa] + real(kind=kind_noahmp) :: VapPresSatGrdVeg ! below-canopy saturation vapor pressure at ground temperature [Pa] + real(kind=kind_noahmp) :: VapPresSatGrdBare ! bare ground saturation vapor pressure at ground temperature [Pa] + real(kind=kind_noahmp) :: VapPresSatCanTempD ! canopy saturation vapor pressure derivative with temperature at veg temp. [Pa/K] + real(kind=kind_noahmp) :: VapPresSatGrdVegTempD ! below-canopy saturation vapor pressure derivative with temperature at ground temp. [Pa/K] + real(kind=kind_noahmp) :: VapPresSatGrdBareTempD ! bare ground saturation vapor pressure derivative with temperature at ground temp. [Pa/K] + real(kind=kind_noahmp) :: PressureVaporCanAir ! canopy air vapor pressure [Pa] + real(kind=kind_noahmp) :: PressureAtmosCO2 ! atmospheric co2 partial pressure [Pa] + real(kind=kind_noahmp) :: PressureAtmosO2 ! atmospheric o2 partial pressure [Pa] + real(kind=kind_noahmp) :: ResistanceStomataSunlit ! sunlit leaf stomatal resistance [s/m] + real(kind=kind_noahmp) :: ResistanceStomataShade ! shaded leaf stomatal resistance [s/m] + real(kind=kind_noahmp) :: DensityAirRefHeight ! density air [kg/m3] at reference height + real(kind=kind_noahmp) :: TemperatureCanopyAir ! canopy air temperature [K] + real(kind=kind_noahmp) :: ZeroPlaneDispSfc ! surface zero plane displacement [m] + real(kind=kind_noahmp) :: ZeroPlaneDispGrd ! ground zero plane displacement [m] + real(kind=kind_noahmp) :: RoughLenMomGrd ! roughness length, momentum, ground [m] + real(kind=kind_noahmp) :: RoughLenMomSfc ! roughness length, momentum, surface [m] + real(kind=kind_noahmp) :: RoughLenShCanopy ! roughness length, sensible heat, canopy [m] + real(kind=kind_noahmp) :: RoughLenShVegGrd ! roughness length, sensible heat, ground, below canopy [m] + real(kind=kind_noahmp) :: RoughLenShBareGrd ! roughness length, sensible heat, bare ground [m] + real(kind=kind_noahmp) :: CanopyHeight ! canopy height [m] + real(kind=kind_noahmp) :: WindSpdCanopyTop ! wind speed at top of canopy [m/s] + real(kind=kind_noahmp) :: FrictionVelVeg ! friction velocity [m/s], vegetated + real(kind=kind_noahmp) :: FrictionVelBare ! friction velocity [m/s], bare ground + real(kind=kind_noahmp) :: WindExtCoeffCanopy ! canopy wind extinction coefficient + real(kind=kind_noahmp) :: MoStabParaUndCan ! M-O stability parameter ground, below canopy + real(kind=kind_noahmp) :: MoStabParaAbvCan ! M-O stability parameter (z/L), above ZeroPlaneDisp, vegetated + real(kind=kind_noahmp) :: MoStabParaBare ! M-O stability parameter (z/L), above ZeroPlaneDisp, bare ground + real(kind=kind_noahmp) :: MoStabParaVeg2m ! M-O stability parameter (2/L), 2m, vegetated + real(kind=kind_noahmp) :: MoStabParaBare2m ! M-O stability parameter (2/L), 2m, bare ground + real(kind=kind_noahmp) :: MoLengthUndCan ! M-O length [m], ground, below canopy + real(kind=kind_noahmp) :: MoLengthAbvCan ! M-O length [m], above ZeroPlaneDisp, vegetated + real(kind=kind_noahmp) :: MoLengthBare ! M-O length [m], above ZeroPlaneDisp, bare ground + real(kind=kind_noahmp) :: MoStabCorrShUndCan ! M-O stability correction ground, below canopy + real(kind=kind_noahmp) :: MoStabCorrMomAbvCan ! M-O momentum stability correction, above ZeroPlaneDisp, vegetated + real(kind=kind_noahmp) :: MoStabCorrShAbvCan ! M-O sensible heat stability correction, above ZeroPlaneDisp, vegetated + real(kind=kind_noahmp) :: MoStabCorrMomVeg2m ! M-O momentum stability correction, 2m, vegetated + real(kind=kind_noahmp) :: MoStabCorrShVeg2m ! M-O sensible heat stability correction, 2m, vegetated + real(kind=kind_noahmp) :: MoStabCorrShBare ! M-O sensible heat stability correction, above ZeroPlaneDisp, bare ground + real(kind=kind_noahmp) :: MoStabCorrMomBare ! M-O momentum stability correction, above ZeroPlaneDisp, bare ground + real(kind=kind_noahmp) :: MoStabCorrMomBare2m ! M-O momentum stability correction, 2m, bare ground + real(kind=kind_noahmp) :: MoStabCorrShBare2m ! M-O sensible heat stability correction, 2m, bare ground + real(kind=kind_noahmp) :: ExchCoeffMomSfc ! exchange coefficient [m/s] for momentum, surface, grid mean + real(kind=kind_noahmp) :: ExchCoeffMomAbvCan ! exchange coefficient [m/s] for momentum, above ZeroPlaneDisp, vegetated + real(kind=kind_noahmp) :: ExchCoeffMomBare ! exchange coefficient [m/s] for momentum, above ZeroPlaneDisp, bare ground + real(kind=kind_noahmp) :: ExchCoeffShSfc ! exchange coefficient [m/s] for sensible heat, surface, grid mean + real(kind=kind_noahmp) :: ExchCoeffShAbvCan ! exchange coefficient [m/s] for sensible heat, above ZeroPlaneDisp, vegetated + real(kind=kind_noahmp) :: ExchCoeffShBare ! exchange coefficient [m/s] for sensible heat, above ZeroPlaneDisp, bare ground + real(kind=kind_noahmp) :: ExchCoeffSh2mVegMo ! exchange coefficient [m/s] for sensible heat, 2m, vegetated (M-O) + real(kind=kind_noahmp) :: ExchCoeffSh2mBareMo ! exchange coefficient [m/s] for sensible heat, 2m, bare ground (M-O) + real(kind=kind_noahmp) :: ExchCoeffSh2mVeg ! exchange coefficient [m/s] for sensible heat, 2m, vegetated (diagnostic) + real(kind=kind_noahmp) :: ExchCoeffLhAbvCan ! exchange coefficient [m/s] for latent heat, canopy air to ref height + real(kind=kind_noahmp) :: ExchCoeffLhTransp ! exchange coefficient [m/s] for transpiration, leaf to canopy air + real(kind=kind_noahmp) :: ExchCoeffLhEvap ! exchange coefficient [m/s] for leaf evaporation, leaf to canopy air + real(kind=kind_noahmp) :: ExchCoeffLhUndCan ! exchange coefficient [m/s] for latent heat, ground to canopy air + real(kind=kind_noahmp) :: ResistanceMomUndCan ! aerodynamic resistance [s/m] for momentum, ground, below canopy + real(kind=kind_noahmp) :: ResistanceShUndCan ! aerodynamic resistance [s/m] for sensible heat, ground, below canopy + real(kind=kind_noahmp) :: ResistanceLhUndCan ! aerodynamic resistance [s/m] for water vapor, ground, below canopy + real(kind=kind_noahmp) :: ResistanceMomAbvCan ! aerodynamic resistance [s/m] for momentum, above canopy + real(kind=kind_noahmp) :: ResistanceShAbvCan ! aerodynamic resistance [s/m] for sensible heat, above canopy + real(kind=kind_noahmp) :: ResistanceLhAbvCan ! aerodynamic resistance [s/m] for water vapor, above canopy + real(kind=kind_noahmp) :: ResistanceMomBareGrd ! aerodynamic resistance [s/m] for momentum, bare ground + real(kind=kind_noahmp) :: ResistanceShBareGrd ! aerodynamic resistance [s/m] for sensible heat, bare ground + real(kind=kind_noahmp) :: ResistanceLhBareGrd ! aerodynamic resistance [s/m] for water vapor, bare ground + real(kind=kind_noahmp) :: ResistanceLeafBoundary ! bulk leaf boundary layer resistance [s/m] + real(kind=kind_noahmp) :: TemperaturePotRefHeight ! potential temp at reference height [K] + real(kind=kind_noahmp) :: WindSpdRefHeight ! wind speed [m/s] at reference height + real(kind=kind_noahmp) :: FrictionVelVertVeg ! friction velocity in vertical direction [m/s], vegetated (only for Chen97) + real(kind=kind_noahmp) :: FrictionVelVertBare ! friction velocity in vertical direction [m/s], bare ground (only for Chen97) + real(kind=kind_noahmp) :: EmissivityVeg ! vegetation emissivity + real(kind=kind_noahmp) :: EmissivityGrd ! ground emissivity + real(kind=kind_noahmp) :: ResistanceGrdEvap ! ground surface resistance [s/m] to evaporation/sublimation + real(kind=kind_noahmp) :: PsychConstCanopy ! psychrometric constant [Pa/K], canopy + real(kind=kind_noahmp) :: LatHeatVapCanopy ! latent heat of vaporization/subli [J/kg], canopy + real(kind=kind_noahmp) :: PsychConstGrd ! psychrometric constant [Pa/K], ground + real(kind=kind_noahmp) :: LatHeatVapGrd ! latent heat of vaporization/subli [J/kg], ground + real(kind=kind_noahmp) :: RelHumidityGrd ! raltive humidity in surface soil/snow air space (-) + real(kind=kind_noahmp) :: SpecHumiditySfc ! specific humidity at surface (bare or vegetated or urban) + real(kind=kind_noahmp) :: SpecHumiditySfcMean ! specific humidity at surface grid mean + real(kind=kind_noahmp) :: SpecHumidity2mVeg ! specific humidity at 2m vegetated + real(kind=kind_noahmp) :: SpecHumidity2mBare ! specific humidity at 2m bare ground + real(kind=kind_noahmp) :: SpecHumidity2m ! specific humidity at 2m grid mean + real(kind=kind_noahmp) :: TemperatureGrdVeg ! vegetated ground (below-canopy) temperature [K] + real(kind=kind_noahmp) :: TemperatureGrdBare ! bare ground temperature [K] + real(kind=kind_noahmp) :: WindStressEwVeg ! wind stress [N/m2]: east-west above canopy + real(kind=kind_noahmp) :: WindStressNsVeg ! wind stress [N/m2]: north-south above canopy + real(kind=kind_noahmp) :: WindStressEwBare ! wind stress [N/m2]: east-west bare ground + real(kind=kind_noahmp) :: WindStressNsBare ! wind stress [N/m2]: north-south bare ground + real(kind=kind_noahmp) :: WindStressEwSfc ! wind stress [N/m2]: east-west grid mean + real(kind=kind_noahmp) :: WindStressNsSfc ! wind stress [N/m2]: north-south grid mean + real(kind=kind_noahmp) :: TemperatureAir2mVeg ! 2 m height air temperature [K], vegetated + real(kind=kind_noahmp) :: TemperatureAir2mBare ! 2 m height air temperature [K], bare ground + real(kind=kind_noahmp) :: TemperatureAir2m ! 2 m height air temperature [K], grid mean + real(kind=kind_noahmp) :: ExchCoeffShLeaf ! leaf sensible heat exchange coefficient [m/s] + real(kind=kind_noahmp) :: ExchCoeffShUndCan ! under canopy sensible heat exchange coefficient [m/s] + real(kind=kind_noahmp) :: ExchCoeffSh2mBare ! bare ground 2-m sensible heat exchange coefficient [m/s] (diagnostic) + real(kind=kind_noahmp) :: RefHeightAboveGrd ! reference height [m] above ground + real(kind=kind_noahmp) :: CanopyFracSnowBury ! fraction of canopy buried by snow + real(kind=kind_noahmp) :: DepthSoilTempBotToSno ! depth of soil temperature lower boundary condition from snow surface [m] + real(kind=kind_noahmp) :: RoughLenMomSfcToAtm ! roughness length, momentum, surface, sent to coupled atmos model + real(kind=kind_noahmp) :: TemperatureRadSfc ! radiative temperature [K] + real(kind=kind_noahmp) :: EmissivitySfc ! surface emissivity + real(kind=kind_noahmp) :: AlbedoSfc ! total surface albedo + real(kind=kind_noahmp) :: EnergyBalanceError ! error in surface energy balance [W/m2] + real(kind=kind_noahmp) :: RadSwBalanceError ! error in shortwave radiation balance [W/m2] + + real(kind=kind_noahmp), allocatable, dimension(:) :: TemperatureSoilSnow ! snow and soil layer temperature [K] + real(kind=kind_noahmp), allocatable, dimension(:) :: HeatCapacVolSnow ! snow layer volumetric specific heat capacity [J/m3/K] + real(kind=kind_noahmp), allocatable, dimension(:) :: ThermConductSnow ! snow layer thermal conductivity [W/m/K] + real(kind=kind_noahmp), allocatable, dimension(:) :: HeatCapacVolSoil ! soil layer volumetric specific heat capacity [J/m3/K] + real(kind=kind_noahmp), allocatable, dimension(:) :: ThermConductSoil ! soil layer thermal conductivity [W/m/K] + real(kind=kind_noahmp), allocatable, dimension(:) :: HeatCapacGlaIce ! glacier ice layer volumetric specific heat [J/m3/K] + real(kind=kind_noahmp), allocatable, dimension(:) :: ThermConductGlaIce ! glacier ice thermal conductivity [W/m/K] + real(kind=kind_noahmp), allocatable, dimension(:) :: ThermConductSoilSnow ! thermal conductivity for all soil and snow layers [W/m/K] + real(kind=kind_noahmp), allocatable, dimension(:) :: HeatCapacSoilSnow ! heat capacity for all snow and soil layers [J/m3/K] + real(kind=kind_noahmp), allocatable, dimension(:) :: PhaseChgFacSoilSnow ! energy factor for soil and snow phase change + real(kind=kind_noahmp), allocatable, dimension(:) :: AlbedoSnowDir ! snow albedo for direct(1=vis, 2=nir) + real(kind=kind_noahmp), allocatable, dimension(:) :: AlbedoSnowDif ! snow albedo for diffuse(1=vis, 2=nir) + real(kind=kind_noahmp), allocatable, dimension(:) :: AlbedoSoilDir ! soil albedo (direct) + real(kind=kind_noahmp), allocatable, dimension(:) :: AlbedoSoilDif ! soil albedo (diffuse) + real(kind=kind_noahmp), allocatable, dimension(:) :: AlbedoGrdDir ! ground albedo (direct beam: vis, nir) + real(kind=kind_noahmp), allocatable, dimension(:) :: AlbedoGrdDif ! ground albedo (diffuse: vis, nir) + real(kind=kind_noahmp), allocatable, dimension(:) :: ReflectanceVeg ! leaf/stem reflectance weighted by LeafAreaIndex and StemAreaIndex + real(kind=kind_noahmp), allocatable, dimension(:) :: TransmittanceVeg ! leaf/stem transmittance weighted by LeafAreaIndex and StemAreaIndex + real(kind=kind_noahmp), allocatable, dimension(:) :: AlbedoSfcDir ! surface albedo (direct) + real(kind=kind_noahmp), allocatable, dimension(:) :: AlbedoSfcDif ! surface albedo (diffuse) + + end type state_type + + +!=== define "parameter" sub-type of energy (energy%param%variable) + type :: parameter_type + + real(kind=kind_noahmp) :: TreeCrownRadius ! tree crown radius [m] + real(kind=kind_noahmp) :: HeightCanopyTop ! height of canopy top [m] + real(kind=kind_noahmp) :: HeightCanopyBot ! height of canopy bottom [m] + real(kind=kind_noahmp) :: RoughLenMomVeg ! momentum roughness length [m] vegetated + real(kind=kind_noahmp) :: TreeDensity ! tree density [no. of trunks per m2] + real(kind=kind_noahmp) :: CanopyOrientIndex ! leaf/stem orientation index + real(kind=kind_noahmp) :: UpscatterCoeffSnowDir ! Upscattering parameters for snow for direct radiation + real(kind=kind_noahmp) :: UpscatterCoeffSnowDif ! Upscattering parameters for snow for diffuse radiation + real(kind=kind_noahmp) :: SoilHeatCapacity ! volumetric soil heat capacity [j/m3/K] + real(kind=kind_noahmp) :: SnowAgeFacBats ! snow aging parameter for BATS snow albedo + real(kind=kind_noahmp) :: SnowGrowVapFacBats ! vapor diffusion snow growth factor for BATS snow albedo + real(kind=kind_noahmp) :: SnowSootFacBats ! dirt and soot effect factor for BATS snow albedo + real(kind=kind_noahmp) :: SnowGrowFrzFacBats ! extra snow growth factor near freezing for BATS snow albedo + real(kind=kind_noahmp) :: SolarZenithAdjBats ! zenith angle snow albedo adjustment + real(kind=kind_noahmp) :: FreshSnoAlbVisBats ! new snow visible albedo for BATS + real(kind=kind_noahmp) :: FreshSnoAlbNirBats ! new snow NIR albedo for BATS + real(kind=kind_noahmp) :: SnoAgeFacDifVisBats ! age factor for diffuse visible snow albedo for BATS + real(kind=kind_noahmp) :: SnoAgeFacDifNirBats ! age factor for diffuse NIR snow albedo for BATS + real(kind=kind_noahmp) :: SzaFacDirVisBats ! cosz factor for direct visible snow albedo for BATS + real(kind=kind_noahmp) :: SzaFacDirNirBats ! cosz factor for direct NIR snow albedo for BATS + real(kind=kind_noahmp) :: SnowAlbRefClass ! reference snow albedo in CLASS scheme + real(kind=kind_noahmp) :: SnowAgeFacClass ! snow aging e-folding time [s] in CLASS albedo scheme + real(kind=kind_noahmp) :: SnowAlbFreshClass ! fresh snow albedo in CLASS albedo scheme + real(kind=kind_noahmp) :: ConductanceLeafMin ! minimum leaf conductance [umol/m2/s] + real(kind=kind_noahmp) :: Co2MmConst25C ! co2 michaelis-menten constant at 25c [Pa] + real(kind=kind_noahmp) :: O2MmConst25C ! o2 michaelis-menten constant at 25c [Pa] + real(kind=kind_noahmp) :: Co2MmConstQ10 ! change in co2 Michaelis-Menten constant for every 10-deg C temperature change + real(kind=kind_noahmp) :: O2MmConstQ10 ! change in o2 michaelis-menten constant for every 10-deg C temperature change + real(kind=kind_noahmp) :: RadiationStressFac ! Parameter used in radiation stress function in Jarvis scheme + real(kind=kind_noahmp) :: ResistanceStomataMin ! Minimum stomatal resistance [s/m] in Jarvis scheme + real(kind=kind_noahmp) :: ResistanceStomataMax ! Maximal stomatal resistance [s/m] in Jarvis scheme + real(kind=kind_noahmp) :: AirTempOptimTransp ! Optimum transpiration air temperature [K] in Jarvis scheme + real(kind=kind_noahmp) :: VaporPresDeficitFac ! Parameter used in vapor pressure deficit function in Jarvis scheme + real(kind=kind_noahmp) :: LeafDimLength ! characteristic leaf dimension [m] + real(kind=kind_noahmp) :: ZilitinkevichCoeff ! Zilitinkevich coefficient for heat exchange coefficient calculation + real(kind=kind_noahmp) :: EmissivitySnow ! snow emissivity + real(kind=kind_noahmp) :: CanopyWindExtFac ! empirical canopy wind extinction parameter + real(kind=kind_noahmp) :: RoughLenMomSnow ! snow surface roughness length [m] + real(kind=kind_noahmp) :: RoughLenMomSoil ! Bare-soil roughness length [m] + real(kind=kind_noahmp) :: RoughLenMomLake ! lake surface roughness length [m] + real(kind=kind_noahmp) :: EmissivityIceSfc ! ice surface emissivity + real(kind=kind_noahmp) :: ResistanceSoilExp ! exponent in the shape parameter for soil resistance option 1 + real(kind=kind_noahmp) :: ResistanceSnowSfc ! surface resistance for snow [s/m] + real(kind=kind_noahmp) :: VegFracGreen ! green vegetation fraction + real(kind=kind_noahmp) :: VegFracAnnMax ! annual maximum vegetation fraction + real(kind=kind_noahmp) :: HeatCapacCanFac ! canopy biomass heat capacity parameter [m] + + real(kind=kind_noahmp), allocatable, dimension(:) :: LeafAreaIndexMon ! monthly leaf area index, one-sided + real(kind=kind_noahmp), allocatable, dimension(:) :: StemAreaIndexMon ! monthly stem area index, one-sided + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilQuartzFrac ! soil quartz content + real(kind=kind_noahmp), allocatable, dimension(:) :: AlbedoSoilSat ! saturated soil albedos: 1=vis, 2=nir + real(kind=kind_noahmp), allocatable, dimension(:) :: AlbedoSoilDry ! dry soil albedos: 1=vis, 2=nir + real(kind=kind_noahmp), allocatable, dimension(:) :: AlbedoLakeFrz ! albedo frozen lakes: 1=vis, 2=nir + real(kind=kind_noahmp), allocatable, dimension(:) :: ScatterCoeffSnow ! Scattering coefficient for snow + real(kind=kind_noahmp), allocatable, dimension(:) :: ReflectanceLeaf ! leaf reflectance: 1=vis, 2=nir + real(kind=kind_noahmp), allocatable, dimension(:) :: ReflectanceStem ! stem reflectance: 1=vis, 2=nir + real(kind=kind_noahmp), allocatable, dimension(:) :: TransmittanceLeaf ! leaf transmittance: 1=vis, 2=nir + real(kind=kind_noahmp), allocatable, dimension(:) :: TransmittanceStem ! stem transmittance: 1=vis, 2=nir + real(kind=kind_noahmp), allocatable, dimension(:) :: EmissivitySoilLake ! emissivity soil surface: 1=soil, 2=lake + real(kind=kind_noahmp), allocatable, dimension(:) :: AlbedoLandIce ! land/glacier ice albedo: 1=vis, 2=nir + + end type parameter_type + + +!=== define energy type that includes 3 subtypes (flux,state,parameter) + type, public :: energy_type + + type(flux_type) :: flux + type(state_type) :: state + type(parameter_type) :: param + + end type energy_type + +end module EnergyVarType diff --git a/src/core_atmosphere/physics/physics_noahmp/src/ForcingVarInitMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/ForcingVarInitMod.F90 new file mode 100644 index 000000000..b69c589e0 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/ForcingVarInitMod.F90 @@ -0,0 +1,43 @@ +module ForcingVarInitMod + +!!! Initialize column (1-D) Noah-MP forcing variables +!!! Forcing variables should be first defined in ForcingVarType.F90 + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use Machine + use NoahmpVarType + + implicit none + +contains + +!=== initialize with default values + subroutine ForcingVarInitDefault(noahmp) + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + + noahmp%forcing%SpecHumidityRefHeight = undefined_real + noahmp%forcing%TemperatureAirRefHeight = undefined_real + noahmp%forcing%WindEastwardRefHeight = undefined_real + noahmp%forcing%WindNorthwardRefHeight = undefined_real + noahmp%forcing%RadLwDownRefHeight = undefined_real + noahmp%forcing%RadSwDownRefHeight = undefined_real + noahmp%forcing%PrecipConvRefHeight = undefined_real + noahmp%forcing%PrecipNonConvRefHeight = undefined_real + noahmp%forcing%PrecipShConvRefHeight = undefined_real + noahmp%forcing%PrecipSnowRefHeight = undefined_real + noahmp%forcing%PrecipGraupelRefHeight = undefined_real + noahmp%forcing%PrecipHailRefHeight = undefined_real + noahmp%forcing%PressureAirSurface = undefined_real + noahmp%forcing%PressureAirRefHeight = undefined_real + noahmp%forcing%TemperatureSoilBottom = undefined_real + + end subroutine ForcingVarInitDefault + +end module ForcingVarInitMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/ForcingVarType.F90 b/src/core_atmosphere/physics/physics_noahmp/src/ForcingVarType.F90 new file mode 100644 index 000000000..a88aa316b --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/ForcingVarType.F90 @@ -0,0 +1,37 @@ +module ForcingVarType + +!!! Define column (1-D) Noah-MP forcing variables +!!! Forcing variable initialization is done in ForcingVarInitMod.F90 + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use Machine + + implicit none + save + private + + type, public :: forcing_type + + real(kind=kind_noahmp) :: SpecHumidityRefHeight ! Specific humidity [kg water vapor / kg moist air] forcing at reference height + real(kind=kind_noahmp) :: TemperatureAirRefHeight ! Air temperature [K] forcing at reference height + real(kind=kind_noahmp) :: WindEastwardRefHeight ! wind speed [m/s] in eastward dir at reference height + real(kind=kind_noahmp) :: WindNorthwardRefHeight ! wind speed [m/s] in northward dir at reference height + real(kind=kind_noahmp) :: RadSwDownRefHeight ! downward shortwave radiation [W/m2] at reference height + real(kind=kind_noahmp) :: RadLwDownRefHeight ! downward longwave radiation [W/m2] at reference height + real(kind=kind_noahmp) :: PressureAirRefHeight ! air pressure [Pa] at reference height + real(kind=kind_noahmp) :: PressureAirSurface ! air pressure [Pa] at surface-atmosphere interface (lowest atmos model boundary) + real(kind=kind_noahmp) :: PrecipConvRefHeight ! convective precipitation rate [mm/s] at reference height + real(kind=kind_noahmp) :: PrecipNonConvRefHeight ! non-convective precipitation rate [mm/s] at reference height + real(kind=kind_noahmp) :: PrecipShConvRefHeight ! shallow convective precipitation rate [mm/s] at reference height + real(kind=kind_noahmp) :: PrecipSnowRefHeight ! snowfall rate [mm/s] at reference height + real(kind=kind_noahmp) :: PrecipGraupelRefHeight ! graupel rate [mm/s] at reference height + real(kind=kind_noahmp) :: PrecipHailRefHeight ! hail rate [mm/s] at reference height + real(kind=kind_noahmp) :: TemperatureSoilBottom ! bottom boundary condition for soil temperature [K] + + end type forcing_type + +end module ForcingVarType diff --git a/src/core_atmosphere/physics/physics_noahmp/src/GeneralInitGlacierMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/GeneralInitGlacierMod.F90 new file mode 100644 index 000000000..278c8eeda --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/GeneralInitGlacierMod.F90 @@ -0,0 +1,50 @@ +module GeneralInitGlacierMod + +!!! General initialization for glacier variables + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine GeneralInitGlacier(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: None (embedded in NOAHMP_GLACIER) +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: LoopInd ! loop index + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! in, actual number of snow layers (negative) + DepthSnowSoilLayer => noahmp%config%domain%DepthSnowSoilLayer ,& ! in, depth of snow/soil layer-bottom [m] + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer & ! out, thickness of snow/soil layers [m] + ) +! ---------------------------------------------------------------------- + + ! initialize snow/soil layer thickness + do LoopInd = NumSnowLayerNeg+1, NumSoilLayer + if ( LoopInd == (NumSnowLayerNeg+1) ) then + ThicknessSnowSoilLayer(LoopInd) = - DepthSnowSoilLayer(LoopInd) + else + ThicknessSnowSoilLayer(LoopInd) = DepthSnowSoilLayer(LoopInd-1) - DepthSnowSoilLayer(LoopInd) + endif + enddo + + end associate + + end subroutine GeneralInitGlacier + +end module GeneralInitGlacierMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/GeneralInitMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/GeneralInitMod.F90 new file mode 100644 index 000000000..551e0176d --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/GeneralInitMod.F90 @@ -0,0 +1,61 @@ +module GeneralInitMod + +!!! General initialization for variables + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine GeneralInit(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: None (embedded in NOAHMP_SFLX) +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: LoopInd ! loop index + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth [m] of layer-bottom from soil surface + NumSoilLayerRoot => noahmp%water%param%NumSoilLayerRoot ,& ! in, number of soil layers with root present + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! in, actual number of snow layers (negative) + DepthSnowSoilLayer => noahmp%config%domain%DepthSnowSoilLayer ,& ! in, depth of snow/soil layer-bottom [m] + TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow ,& ! in, snow and soil layer temperature [K] + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! out, thickness of snow/soil layers [m] + TemperatureRootZone => noahmp%energy%state%TemperatureRootZone & ! out, root-zone averaged temperature [K] + ) +! ---------------------------------------------------------------------- + + ! initialize snow/soil layer thickness + do LoopInd = NumSnowLayerNeg+1, NumSoilLayer + if ( LoopInd == NumSnowLayerNeg+1 ) then + ThicknessSnowSoilLayer(LoopInd) = - DepthSnowSoilLayer(LoopInd) + else + ThicknessSnowSoilLayer(LoopInd) = DepthSnowSoilLayer(LoopInd-1) - DepthSnowSoilLayer(LoopInd) + endif + enddo + + ! initialize root-zone soil temperature + TemperatureRootZone = 0.0 + do LoopInd = 1, NumSoilLayerRoot + TemperatureRootZone = TemperatureRootZone + & + TemperatureSoilSnow(LoopInd) * ThicknessSnowSoilLayer(LoopInd) / (-DepthSoilLayer(NumSoilLayerRoot)) + enddo + + end associate + + end subroutine GeneralInit + +end module GeneralInitMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/GlacierIceThermalPropertyMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/GlacierIceThermalPropertyMod.F90 new file mode 100644 index 000000000..27f9ca14b --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/GlacierIceThermalPropertyMod.F90 @@ -0,0 +1,51 @@ +module GlacierIceThermalPropertyMod + +!!! Compute glacier ice thermal conductivity based on Noah scheme + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine GlacierIceThermalProperty(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: none (embedded in ENERGY_GLACIER) +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: LoopInd1, LoopInd2 ! loop index + real(kind=kind_noahmp) :: DepthIceLayerMid ! mid-point ice layer depth + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! in, thickness of snow/soil layers [m] + HeatCapacGlaIce => noahmp%energy%state%HeatCapacGlaIce ,& ! out, glacier ice layer volumetric specific heat [J/m3/K] + ThermConductGlaIce => noahmp%energy%state%ThermConductGlaIce & ! out, glacier ice layer thermal conductivity [W/m/K] + ) +! ---------------------------------------------------------------------- + + do LoopInd1 = 1, NumSoilLayer + DepthIceLayerMid = 0.5 * ThicknessSnowSoilLayer(LoopInd1) + do LoopInd2 = 1, LoopInd1-1 + DepthIceLayerMid = DepthIceLayerMid + ThicknessSnowSoilLayer(LoopInd2) + enddo + HeatCapacGlaIce(LoopInd1) = 1.0e6 * (0.8194 + 0.1309 * DepthIceLayerMid) + ThermConductGlaIce(LoopInd1) = 0.32333 + (0.10073 * DepthIceLayerMid) + enddo + + end associate + + end subroutine GlacierIceThermalProperty + +end module GlacierIceThermalPropertyMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/GlacierPhaseChangeMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/GlacierPhaseChangeMod.F90 new file mode 100644 index 000000000..3ce21f71c --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/GlacierPhaseChangeMod.F90 @@ -0,0 +1,440 @@ +module GlacierPhaseChangeMod + +!!! Compute the phase change (melting/freezing) of snow and glacier ice + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine GlacierPhaseChange(noahmp) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: PHASECHANGE_GLACIER +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! in & out variables + type(noahmp_type) , intent(inout) :: noahmp + +! local variable + integer :: LoopInd1, LoopInd2 ! loop index + real(kind=kind_noahmp) :: SnowWaterPrev ! old/previous snow water equivalent [kg/m2] + real(kind=kind_noahmp) :: SnowWaterRatio ! ratio of previous vs updated snow water equivalent + real(kind=kind_noahmp) :: HeatLhTotPhsChg ! total latent heat of phase change + real(kind=kind_noahmp), allocatable, dimension(:) :: EnergyRes ! energy residual [W/m2] + real(kind=kind_noahmp), allocatable, dimension(:) :: GlacierPhaseChg ! melting or freezing glacier water [kg/m2] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassWatTotInit ! initial total water (ice + liq) mass + real(kind=kind_noahmp), allocatable, dimension(:) :: MassWatIceInit ! initial ice content + real(kind=kind_noahmp), allocatable, dimension(:) :: MassWatLiqInit ! initial liquid content + real(kind=kind_noahmp), allocatable, dimension(:) :: MassWatIceTmp ! soil/snow ice mass [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassWatLiqTmp ! soil/snow liquid water mass [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: EnergyResLeft ! energy residual or loss after melting/freezing + +! -------------------------------------------------------------------- + associate( & + OptGlacierTreatment => noahmp%config%nmlist%OptGlacierTreatment ,& ! in, options for glacier treatment + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! in, actual number of snow layers (negative) + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, main noahmp timestep [s] + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! in, thickness of snow/soil layers [m] + PhaseChgFacSoilSnow => noahmp%energy%state%PhaseChgFacSoilSnow ,& ! in, energy factor for soil & snow phase change + TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow ,& ! inout, snow and soil layer temperature [K] + SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! inout, soil water content [m3/m3] + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! inout, total soil moisture [m3/m3] + SnowIce => noahmp%water%state%SnowIce ,& ! inout, snow layer ice [mm] + SnowLiqWater => noahmp%water%state%SnowLiqWater ,& ! inout, snow layer liquid water [mm] + SnowDepth => noahmp%water%state%SnowDepth ,& ! inout, snow depth [m] + SnowWaterEquiv => noahmp%water%state%SnowWaterEquiv ,& ! inout, snow water equivalent [mm] + IndexPhaseChange => noahmp%water%state%IndexPhaseChange ,& ! out, phase change index [0-none;1-melt;2-refreeze] + MeltGroundSnow => noahmp%water%flux%MeltGroundSnow ,& ! out, ground snowmelt rate [mm/s] + PondSfcThinSnwMelt => noahmp%water%state%PondSfcThinSnwMelt & ! out, surface ponding [mm] from snowmelt when thin snow has no layer + ) +! ---------------------------------------------------------------------- + + !--- Initialization + if (.not. allocated(EnergyRes) ) allocate(EnergyRes (-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(GlacierPhaseChg)) allocate(GlacierPhaseChg(-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(MassWatTotInit) ) allocate(MassWatTotInit (-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(MassWatIceInit) ) allocate(MassWatIceInit (-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(MassWatLiqInit) ) allocate(MassWatLiqInit (-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(MassWatIceTmp) ) allocate(MassWatIceTmp (-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(MassWatLiqTmp) ) allocate(MassWatLiqTmp (-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(EnergyResLeft) ) allocate(EnergyResLeft (-NumSnowLayerMax+1:NumSoilLayer)) + EnergyRes = 0.0 + GlacierPhaseChg = 0.0 + MassWatTotInit = 0.0 + MassWatIceInit = 0.0 + MassWatLiqInit = 0.0 + MassWatIceTmp = 0.0 + MassWatLiqTmp = 0.0 + EnergyResLeft = 0.0 + MeltGroundSnow = 0.0 + PondSfcThinSnwMelt = 0.0 + HeatLhTotPhsChg = 0.0 + + !--- treat snowpack over glacier ice first + + ! snow layer water mass + do LoopInd1 = NumSnowLayerNeg+1, 0 + MassWatIceTmp(LoopInd1) = SnowIce(LoopInd1) + MassWatLiqTmp(LoopInd1) = SnowLiqWater(LoopInd1) + enddo + + ! other required variables + do LoopInd1 = NumSnowLayerNeg+1, 0 + IndexPhaseChange(LoopInd1) = 0 + EnergyRes (LoopInd1) = 0.0 + GlacierPhaseChg (LoopInd1) = 0.0 + EnergyResLeft (LoopInd1) = 0.0 + MassWatIceInit (LoopInd1) = MassWatIceTmp(LoopInd1) + MassWatLiqInit (LoopInd1) = MassWatLiqTmp(LoopInd1) + MassWatTotInit (LoopInd1) = MassWatIceTmp(LoopInd1) + MassWatLiqTmp(LoopInd1) + enddo + + ! determine melting or freezing state + do LoopInd1 = NumSnowLayerNeg+1, 0 + if ( (MassWatIceTmp(LoopInd1) > 0.0) .and. (TemperatureSoilSnow(LoopInd1) >= ConstFreezePoint) ) then + IndexPhaseChange(LoopInd1) = 1 ! melting + endif + if ( (MassWatLiqTmp(LoopInd1) > 0.0) .and. (TemperatureSoilSnow(LoopInd1) < ConstFreezePoint) ) then + IndexPhaseChange(LoopInd1) = 2 ! freezing + endif + enddo + + ! Calculate the energy surplus and loss for melting and freezing + do LoopInd1 = NumSnowLayerNeg+1, 0 + if ( IndexPhaseChange(LoopInd1) > 0 ) then + EnergyRes(LoopInd1) = (TemperatureSoilSnow(LoopInd1) - ConstFreezePoint) / PhaseChgFacSoilSnow(LoopInd1) + TemperatureSoilSnow(LoopInd1) = ConstFreezePoint + endif + if ( (IndexPhaseChange(LoopInd1) == 1) .and. (EnergyRes(LoopInd1) < 0.0) ) then + EnergyRes(LoopInd1) = 0.0 + IndexPhaseChange(LoopInd1) = 0 + endif + if ( (IndexPhaseChange(LoopInd1) == 2) .and. (EnergyRes(LoopInd1) > 0.0) ) then + EnergyRes(LoopInd1) = 0.0 + IndexPhaseChange(LoopInd1) = 0 + endif + GlacierPhaseChg(LoopInd1) = EnergyRes(LoopInd1) * MainTimeStep / ConstLatHeatFusion + enddo + + ! The rate of melting for snow without a layer, needs more work. + if ( OptGlacierTreatment == 2 ) then + if ( (NumSnowLayerNeg == 0) .and. (SnowWaterEquiv > 0.0) .and. (TemperatureSoilSnow(1) > ConstFreezePoint) ) then + EnergyRes(1) = (TemperatureSoilSnow(1) - ConstFreezePoint) / PhaseChgFacSoilSnow(1) ! available heat + TemperatureSoilSnow(1) = ConstFreezePoint ! set T to freezing + GlacierPhaseChg(1) = EnergyRes(1) * MainTimeStep / ConstLatHeatFusion ! total snow melt possible + SnowWaterPrev = SnowWaterEquiv + SnowWaterEquiv = max(0.0, SnowWaterPrev-GlacierPhaseChg(1)) ! snow remaining + SnowWaterRatio = SnowWaterEquiv / SnowWaterPrev ! fraction melted + SnowDepth = max(0.0, SnowWaterRatio*SnowDepth) ! new snow height + SnowDepth = min(max(SnowDepth,SnowWaterEquiv/500.0), SnowWaterEquiv/50.0) ! limit to a reasonable snow density + EnergyResLeft(1) = EnergyRes(1) - ConstLatHeatFusion * (SnowWaterPrev - SnowWaterEquiv) / MainTimeStep ! excess heat + if ( EnergyResLeft(1) > 0.0 ) then + GlacierPhaseChg(1) = EnergyResLeft(1) * MainTimeStep / ConstLatHeatFusion + TemperatureSoilSnow(1) = TemperatureSoilSnow(1) + PhaseChgFacSoilSnow(1) * EnergyResLeft(1) ! re-heat ice + else + GlacierPhaseChg(1) = 0.0 + EnergyRes(1) = 0.0 + endif + MeltGroundSnow = max(0.0, SnowWaterPrev-SnowWaterEquiv) / MainTimeStep ! melted snow rate + HeatLhTotPhsChg = ConstLatHeatFusion * MeltGroundSnow ! melted snow energy + PondSfcThinSnwMelt = SnowWaterPrev - SnowWaterEquiv ! melt water + endif + endif ! OptGlacierTreatment==2 + + ! The rate of melting and freezing for multi-layer snow + do LoopInd1 = NumSnowLayerNeg+1, 0 + if ( (IndexPhaseChange(LoopInd1) > 0) .and. (abs(EnergyRes(LoopInd1)) > 0.0) ) then + EnergyResLeft(LoopInd1) = 0.0 + if ( GlacierPhaseChg(LoopInd1) > 0.0 ) then + MassWatIceTmp(LoopInd1) = max(0.0, MassWatIceInit(LoopInd1)-GlacierPhaseChg(LoopInd1)) + EnergyResLeft(LoopInd1) = EnergyRes(LoopInd1) - ConstLatHeatFusion * & + (MassWatIceInit(LoopInd1) - MassWatIceTmp(LoopInd1)) / MainTimeStep + elseif ( GlacierPhaseChg(LoopInd1) < 0.0 ) then + MassWatIceTmp(LoopInd1) = min(MassWatTotInit(LoopInd1), MassWatIceInit(LoopInd1)-GlacierPhaseChg(LoopInd1)) + EnergyResLeft(LoopInd1) = EnergyRes(LoopInd1) - ConstLatHeatFusion * & + (MassWatIceInit(LoopInd1) - MassWatIceTmp(LoopInd1)) / MainTimeStep + endif + MassWatLiqTmp(LoopInd1) = max(0.0, MassWatTotInit(LoopInd1)-MassWatIceTmp(LoopInd1)) ! update liquid water mass + + ! update snow temperature and energy surplus/loss + if ( abs(EnergyResLeft(LoopInd1)) > 0.0 ) then + TemperatureSoilSnow(LoopInd1) = TemperatureSoilSnow(LoopInd1) + & + PhaseChgFacSoilSnow(LoopInd1) * EnergyResLeft(LoopInd1) + if ( (MassWatLiqTmp(LoopInd1)*MassWatIceTmp(LoopInd1)) > 0.0 ) & + TemperatureSoilSnow(LoopInd1) = ConstFreezePoint + endif + HeatLhTotPhsChg = HeatLhTotPhsChg + & + ConstLatHeatFusion * (MassWatIceInit(LoopInd1) - MassWatIceTmp(LoopInd1)) / MainTimeStep + + ! snow melting rate + MeltGroundSnow = MeltGroundSnow + max(0.0, (MassWatIceInit(LoopInd1)-MassWatIceTmp(LoopInd1))) / MainTimeStep + endif + enddo + + !---- glacier ice layer treatment + + if ( OptGlacierTreatment == 1 ) then + + ! ice layer water mass + do LoopInd1 = 1, NumSoilLayer + MassWatLiqTmp(LoopInd1) = SoilLiqWater(LoopInd1) * ThicknessSnowSoilLayer(LoopInd1) * 1000.0 + MassWatIceTmp(LoopInd1) = (SoilMoisture(LoopInd1) - SoilLiqWater(LoopInd1)) * ThicknessSnowSoilLayer(LoopInd1) * 1000.0 + enddo + + ! other required variables + do LoopInd1 = 1, NumSoilLayer + IndexPhaseChange(LoopInd1) = 0 + EnergyRes(LoopInd1) = 0.0 + GlacierPhaseChg(LoopInd1) = 0.0 + EnergyResLeft(LoopInd1) = 0.0 + MassWatIceInit(LoopInd1) = MassWatIceTmp(LoopInd1) + MassWatLiqInit(LoopInd1) = MassWatLiqTmp(LoopInd1) + MassWatTotInit(LoopInd1) = MassWatIceTmp(LoopInd1) + MassWatLiqTmp(LoopInd1) + enddo + + ! determine melting or freezing state + do LoopInd1 = 1, NumSoilLayer + if ( (MassWatIceTmp(LoopInd1) > 0.0) .and. (TemperatureSoilSnow(LoopInd1) >= ConstFreezePoint) ) then + IndexPhaseChange(LoopInd1) = 1 ! melting + endif + if ( (MassWatLiqTmp(LoopInd1) > 0.0) .and. (TemperatureSoilSnow(LoopInd1) < ConstFreezePoint) ) then + IndexPhaseChange(LoopInd1) = 2 ! freezing + endif + ! If snow exists, but its thickness is not enough to create a layer + if ( (NumSnowLayerNeg == 0) .and. (SnowWaterEquiv > 0.0) .and. (LoopInd1 == 1) ) then + if ( TemperatureSoilSnow(LoopInd1) >= ConstFreezePoint ) then + IndexPhaseChange(LoopInd1) = 1 + endif + endif + enddo + + ! Calculate the energy surplus and loss for melting and freezing + do LoopInd1 = 1, NumSoilLayer + if ( IndexPhaseChange(LoopInd1) > 0 ) then + EnergyRes(LoopInd1) = (TemperatureSoilSnow(LoopInd1) - ConstFreezePoint) / PhaseChgFacSoilSnow(LoopInd1) + TemperatureSoilSnow(LoopInd1) = ConstFreezePoint + endif + if ( (IndexPhaseChange(LoopInd1) == 1) .and. (EnergyRes(LoopInd1) < 0.0) ) then + EnergyRes(LoopInd1) = 0.0 + IndexPhaseChange(LoopInd1) = 0 + endif + if ( (IndexPhaseChange(LoopInd1) == 2) .and. (EnergyRes(LoopInd1) > 0.0) ) then + EnergyRes(LoopInd1) = 0.0 + IndexPhaseChange(LoopInd1) = 0 + endif + GlacierPhaseChg(LoopInd1) = EnergyRes(LoopInd1) * MainTimeStep / ConstLatHeatFusion + enddo + + ! The rate of melting for snow without a layer, needs more work. + if ( (NumSnowLayerNeg == 0) .and. (SnowWaterEquiv > 0.0) .and. (GlacierPhaseChg(1) > 0.0) ) then + SnowWaterPrev = SnowWaterEquiv + SnowWaterEquiv = max(0.0, SnowWaterPrev-GlacierPhaseChg(1)) + SnowWaterRatio = SnowWaterEquiv / SnowWaterPrev + SnowDepth = max(0.0, SnowWaterRatio*SnowDepth) + SnowDepth = min(max(SnowDepth,SnowWaterEquiv/500.0), SnowWaterEquiv/50.0) ! limit to a reasonable snow density + EnergyResLeft(1) = EnergyRes(1) - ConstLatHeatFusion * (SnowWaterPrev - SnowWaterEquiv) / MainTimeStep + if ( EnergyResLeft(1) > 0.0 ) then + GlacierPhaseChg(1) = EnergyResLeft(1) * MainTimeStep / ConstLatHeatFusion + EnergyRes(1) = EnergyResLeft(1) + IndexPhaseChange(1) = 1 + else + GlacierPhaseChg(1) = 0.0 + EnergyRes(1) = 0.0 + IndexPhaseChange(1) = 0 + endif + MeltGroundSnow = max(0.0, (SnowWaterPrev-SnowWaterEquiv)) / MainTimeStep + HeatLhTotPhsChg = ConstLatHeatFusion * MeltGroundSnow + PondSfcThinSnwMelt = SnowWaterPrev - SnowWaterEquiv + endif + + ! The rate of melting and freezing for glacier ice + do LoopInd1 = 1, NumSoilLayer + if ( (IndexPhaseChange(LoopInd1) > 0) .and. (abs(EnergyRes(LoopInd1)) > 0.0) ) then + EnergyResLeft(LoopInd1) = 0.0 + if ( GlacierPhaseChg(LoopInd1) > 0.0 ) then + MassWatIceTmp(LoopInd1) = max(0.0, MassWatIceInit(LoopInd1)-GlacierPhaseChg(LoopInd1)) + EnergyResLeft(LoopInd1) = EnergyRes(LoopInd1) - ConstLatHeatFusion * & + (MassWatIceInit(LoopInd1) - MassWatIceTmp(LoopInd1)) / MainTimeStep + elseif ( GlacierPhaseChg(LoopInd1) < 0.0 ) then + MassWatIceTmp(LoopInd1) = min(MassWatTotInit(LoopInd1), MassWatIceInit(LoopInd1)-GlacierPhaseChg(LoopInd1)) + EnergyResLeft(LoopInd1) = EnergyRes(LoopInd1) - ConstLatHeatFusion * & + (MassWatIceInit(LoopInd1) - MassWatIceTmp(LoopInd1)) / MainTimeStep + endif + MassWatLiqTmp(LoopInd1) = max(0.0, MassWatTotInit(LoopInd1)-MassWatIceTmp(LoopInd1)) ! update liquid water mass + + ! update ice temperature and energy surplus/loss + if ( abs(EnergyResLeft(LoopInd1)) > 0.0 ) then + TemperatureSoilSnow(LoopInd1) = TemperatureSoilSnow(LoopInd1) + & + PhaseChgFacSoilSnow(LoopInd1) * EnergyResLeft(LoopInd1) + endif + HeatLhTotPhsChg = HeatLhTotPhsChg + & + ConstLatHeatFusion * (MassWatIceInit(LoopInd1) - MassWatIceTmp(LoopInd1)) / MainTimeStep + endif + enddo + EnergyResLeft = 0.0 + GlacierPhaseChg = 0.0 + + !--- Deal with residuals in ice/soil + + ! first remove excess heat by reducing layer temperature + if ( any(TemperatureSoilSnow(1:NumSoilLayer) > ConstFreezePoint) .and. & + any(TemperatureSoilSnow(1:NumSoilLayer) < ConstFreezePoint) ) then + do LoopInd1 = 1, NumSoilLayer + if ( TemperatureSoilSnow(LoopInd1) > ConstFreezePoint ) then + EnergyResLeft(LoopInd1) = (TemperatureSoilSnow(LoopInd1) - ConstFreezePoint) / PhaseChgFacSoilSnow(LoopInd1) + do LoopInd2 = 1, NumSoilLayer + if ( (LoopInd1 /= LoopInd2) .and. (TemperatureSoilSnow(LoopInd2) < ConstFreezePoint) .and. & + (EnergyResLeft(LoopInd1) > 0.1) ) then + EnergyResLeft(LoopInd2) = (TemperatureSoilSnow(LoopInd2) - ConstFreezePoint) / & + PhaseChgFacSoilSnow(LoopInd2) + if ( abs(EnergyResLeft(LoopInd2)) > EnergyResLeft(LoopInd1) ) then ! LAYER ABSORBS ALL + EnergyResLeft(LoopInd2) = EnergyResLeft(LoopInd2) + EnergyResLeft(LoopInd1) + TemperatureSoilSnow(LoopInd2) = ConstFreezePoint + & + EnergyResLeft(LoopInd2) * PhaseChgFacSoilSnow(LoopInd2) + EnergyResLeft(LoopInd1) = 0.0 + else + EnergyResLeft(LoopInd1) = EnergyResLeft(LoopInd1) + EnergyResLeft(LoopInd2) + EnergyResLeft(LoopInd2) = 0.0 + TemperatureSoilSnow(LoopInd2) = ConstFreezePoint + endif + endif + enddo + TemperatureSoilSnow(LoopInd1) = ConstFreezePoint + EnergyResLeft(LoopInd1) * PhaseChgFacSoilSnow(LoopInd1) + endif + enddo + endif + + ! now remove excess cold by increasing temperture (may not be necessary with above loop) + if ( any(TemperatureSoilSnow(1:NumSoilLayer) > ConstFreezePoint) .and. & + any(TemperatureSoilSnow(1:NumSoilLayer) < ConstFreezePoint) ) then + do LoopInd1 = 1, NumSoilLayer + if ( TemperatureSoilSnow(LoopInd1) < ConstFreezePoint ) then + EnergyResLeft(LoopInd1) = (TemperatureSoilSnow(LoopInd1) - ConstFreezePoint) / PhaseChgFacSoilSnow(LoopInd1) + do LoopInd2 = 1, NumSoilLayer + if ( (LoopInd1 /= LoopInd2) .and. (TemperatureSoilSnow(LoopInd2) > ConstFreezePoint) .and. & + (EnergyResLeft(LoopInd1) < -0.1) ) then + EnergyResLeft(LoopInd2) = (TemperatureSoilSnow(LoopInd2) - ConstFreezePoint) / & + PhaseChgFacSoilSnow(LoopInd2) + if ( EnergyResLeft(LoopInd2) > abs(EnergyResLeft(LoopInd1)) ) then ! LAYER ABSORBS ALL + EnergyResLeft(LoopInd2) = EnergyResLeft(LoopInd2) + EnergyResLeft(LoopInd1) + TemperatureSoilSnow(LoopInd2) = ConstFreezePoint + & + EnergyResLeft(LoopInd2) * PhaseChgFacSoilSnow(LoopInd2) + EnergyResLeft(LoopInd1) = 0.0 + else + EnergyResLeft(LoopInd1) = EnergyResLeft(LoopInd1) + EnergyResLeft(LoopInd2) + EnergyResLeft(LoopInd2) = 0.0 + TemperatureSoilSnow(LoopInd2) = ConstFreezePoint + endif + endif + enddo + TemperatureSoilSnow(LoopInd1) = ConstFreezePoint + EnergyResLeft(LoopInd1) * PhaseChgFacSoilSnow(LoopInd1) + endif + enddo + endif + + ! now remove excess heat by melting ice + if ( any(TemperatureSoilSnow(1:NumSoilLayer) > ConstFreezePoint) .and. & + any(MassWatIceTmp(1:NumSoilLayer) > 0.0) ) then + do LoopInd1 = 1, NumSoilLayer + if ( TemperatureSoilSnow(LoopInd1) > ConstFreezePoint ) then + EnergyResLeft(LoopInd1) = (TemperatureSoilSnow(LoopInd1) - ConstFreezePoint) / PhaseChgFacSoilSnow(LoopInd1) + GlacierPhaseChg(LoopInd1) = EnergyResLeft(LoopInd1) * MainTimeStep / ConstLatHeatFusion + do LoopInd2 = 1, NumSoilLayer + if ( (LoopInd1 /= LoopInd2) .and. (MassWatIceTmp(LoopInd2) > 0.0) .and. & + (GlacierPhaseChg(LoopInd1) > 0.1) ) then + if ( MassWatIceTmp(LoopInd2) > GlacierPhaseChg(LoopInd1) ) then ! LAYER ABSORBS ALL + MassWatIceTmp(LoopInd2) = MassWatIceTmp(LoopInd2) - GlacierPhaseChg(LoopInd1) + HeatLhTotPhsChg = HeatLhTotPhsChg + & + ConstLatHeatFusion * GlacierPhaseChg(LoopInd1)/MainTimeStep + TemperatureSoilSnow(LoopInd2) = ConstFreezePoint + GlacierPhaseChg(LoopInd1) = 0.0 + else + GlacierPhaseChg(LoopInd1) = GlacierPhaseChg(LoopInd1) - MassWatIceTmp(LoopInd2) + HeatLhTotPhsChg = HeatLhTotPhsChg + & + ConstLatHeatFusion * MassWatIceTmp(LoopInd2) / MainTimeStep + MassWatIceTmp(LoopInd2) = 0.0 + TemperatureSoilSnow(LoopInd2) = ConstFreezePoint + endif + MassWatLiqTmp(LoopInd2) = max(0.0, MassWatTotInit(LoopInd2)-MassWatIceTmp(LoopInd2)) + endif + enddo + EnergyResLeft(LoopInd1) = GlacierPhaseChg(LoopInd1) * ConstLatHeatFusion / MainTimeStep + TemperatureSoilSnow(LoopInd1) = ConstFreezePoint + EnergyResLeft(LoopInd1) * PhaseChgFacSoilSnow(LoopInd1) + endif + enddo + endif + + ! snow remove excess cold by refreezing liquid (may not be necessary with above loop) + if ( any(TemperatureSoilSnow(1:NumSoilLayer) < ConstFreezePoint) .and. & + any(MassWatLiqTmp(1:NumSoilLayer) > 0.0) ) then + do LoopInd1 = 1, NumSoilLayer + if ( TemperatureSoilSnow(LoopInd1) < ConstFreezePoint ) then + EnergyResLeft(LoopInd1) = (TemperatureSoilSnow(LoopInd1) - ConstFreezePoint) / PhaseChgFacSoilSnow(LoopInd1) + GlacierPhaseChg(LoopInd1) = EnergyResLeft(LoopInd1) * MainTimeStep / ConstLatHeatFusion + do LoopInd2 = 1, NumSoilLayer + if ( (LoopInd1 /= LoopInd2) .and. (MassWatLiqTmp(LoopInd2) > 0.0) .and. & + (GlacierPhaseChg(LoopInd1) < -0.1) ) then + if ( MassWatLiqTmp(LoopInd2) > abs(GlacierPhaseChg(LoopInd1)) ) then ! LAYER ABSORBS ALL + MassWatIceTmp(LoopInd2) = MassWatIceTmp(LoopInd2) - GlacierPhaseChg(LoopInd1) + HeatLhTotPhsChg = HeatLhTotPhsChg + & + ConstLatHeatFusion * GlacierPhaseChg(LoopInd1) / MainTimeStep + TemperatureSoilSnow(LoopInd2) = ConstFreezePoint + GlacierPhaseChg(LoopInd1) = 0.0 + else + GlacierPhaseChg(LoopInd1) = GlacierPhaseChg(LoopInd1) + MassWatLiqTmp(LoopInd2) + HeatLhTotPhsChg = HeatLhTotPhsChg - & + ConstLatHeatFusion * MassWatLiqTmp(LoopInd2) / MainTimeStep + MassWatIceTmp(LoopInd2) = MassWatTotInit(LoopInd2) + TemperatureSoilSnow(LoopInd2) = ConstFreezePoint + endif + MassWatLiqTmp(LoopInd2) = max(0.0, MassWatTotInit(LoopInd2)-MassWatIceTmp(LoopInd2)) + endif + enddo + EnergyResLeft(LoopInd1) = GlacierPhaseChg(LoopInd1) * ConstLatHeatFusion / MainTimeStep + TemperatureSoilSnow(LoopInd1) = ConstFreezePoint + EnergyResLeft(LoopInd1) * PhaseChgFacSoilSnow(LoopInd1) + endif + enddo + endif + + endif ! OptGlacierTreatment==1 + + !--- update snow and soil ice and liquid content + do LoopInd1 = NumSnowLayerNeg+1, 0 ! snow + SnowLiqWater(LoopInd1) = MassWatLiqTmp(LoopInd1) + SnowIce(LoopInd1) = MassWatIceTmp(LoopInd1) + enddo + do LoopInd1 = 1, NumSoilLayer ! glacier ice + if ( OptGlacierTreatment == 1 ) then + SoilLiqWater(LoopInd1) = MassWatLiqTmp(LoopInd1) / (1000.0 * ThicknessSnowSoilLayer(LoopInd1)) + SoilLiqWater(LoopInd1) = max(0.0, min(1.0,SoilLiqWater(LoopInd1))) + elseif ( OptGlacierTreatment == 2 ) then + SoilLiqWater(LoopInd1) = 0.0 ! ice, assume all frozen forever + endif + SoilMoisture(LoopInd1) = 1.0 + enddo + + ! deallocate local arrays to avoid memory leaks + deallocate(EnergyRes ) + deallocate(GlacierPhaseChg) + deallocate(MassWatTotInit ) + deallocate(MassWatIceInit ) + deallocate(MassWatLiqInit ) + deallocate(MassWatIceTmp ) + deallocate(MassWatLiqTmp ) + deallocate(EnergyResLeft ) + + end associate + + end subroutine GlacierPhaseChange + +end module GlacierPhaseChangeMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/GlacierTemperatureMainMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/GlacierTemperatureMainMod.F90 new file mode 100644 index 000000000..809380774 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/GlacierTemperatureMainMod.F90 @@ -0,0 +1,80 @@ +module GlacierTemperatureMainMod + +!!! Main module to compute snow (if exists) and glacier ice temperature. +!!! Note that snow temperatures during melting season may exceed melting +!!! point but later in GlacierPhaseChange subroutine the snow +!!! temperatures are reset to melting point for melting snow. + + use Machine + use NoahmpVarType + use ConstantDefineMod + use GlacierTemperatureSolverMod, only : GlacierTemperatureSolver + use GlacierThermalDiffusionMod, only : GlacierThermalDiffusion + + implicit none + +contains + + subroutine GlacierTemperatureMain(noahmp) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: TSNOSOI_GLACIER +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! in & out variables + type(noahmp_type) , intent(inout) :: noahmp + +! local variable + real(kind=kind_noahmp), allocatable, dimension(:) :: MatRight ! right-hand side term of the matrix + real(kind=kind_noahmp), allocatable, dimension(:) :: MatLeft1 ! left-hand side term of the matrix + real(kind=kind_noahmp), allocatable, dimension(:) :: MatLeft2 ! left-hand side term of the matrix + real(kind=kind_noahmp), allocatable, dimension(:) :: MatLeft3 ! left-hand side term of the matrix + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of glacier/soil layers + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! in, actual number of snow layers (negative) + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, main noahmp timestep [s] + DepthSoilTempBottom => noahmp%config%domain%DepthSoilTempBottom ,& ! in, depth [m] from glacier surface for lower soil temperature boundary + SnowDepth => noahmp%water%state%SnowDepth ,& ! in, snow depth [m] + DepthSoilTempBotToSno => noahmp%energy%state%DepthSoilTempBotToSno ,& ! out, depth of lower boundary condition [m] from snow surface + RadSwPenetrateGrd => noahmp%energy%flux%RadSwPenetrateGrd & ! out, light penetrating through snow/ice [W/m2] + ) +! ---------------------------------------------------------------------- + + ! initialization + if (.not. allocated(MatRight)) allocate(MatRight(-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(MatLeft1)) allocate(MatLeft1(-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(MatLeft2)) allocate(MatLeft2(-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(MatLeft3)) allocate(MatLeft3(-NumSnowLayerMax+1:NumSoilLayer)) + MatRight(:) = 0.0 + MatLeft1(:) = 0.0 + MatLeft2(:) = 0.0 + MatLeft3(:) = 0.0 + + ! compute solar penetration through water, needs more work + RadSwPenetrateGrd(NumSnowLayerNeg+1:NumSoilLayer) = 0.0 + + ! adjust DepthSoilTempBottom from glacier ice surface to DepthSoilTempBotToSno from snow surface + DepthSoilTempBotToSno = DepthSoilTempBottom - SnowDepth + + ! compute soil temperatures + call GlacierThermalDiffusion(noahmp, MatLeft1, MatLeft2, MatLeft3, MatRight) + call GlacierTemperatureSolver(noahmp, MainTimeStep, MatLeft1, MatLeft2, MatLeft3, MatRight) + + ! deallocate local arrays to avoid memory leaks + deallocate(MatRight) + deallocate(MatLeft1) + deallocate(MatLeft2) + deallocate(MatLeft3) + + end associate + + end subroutine GlacierTemperatureMain + +end module GlacierTemperatureMainMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/GlacierTemperatureSolverMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/GlacierTemperatureSolverMod.F90 new file mode 100644 index 000000000..e94beb5f5 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/GlacierTemperatureSolverMod.F90 @@ -0,0 +1,84 @@ +module GlacierTemperatureSolverMod + +!!! Compute Glacier and snow layer temperature using tri-diagonal matrix solution +!!! Dependent on the output from GlacierThermalDiffusion module + + use Machine + use NoahmpVarType + use ConstantDefineMod + use MatrixSolverTriDiagonalMod, only : MatrixSolverTriDiagonal + + implicit none + +contains + + subroutine GlacierTemperatureSolver(noahmp, TimeStep, MatLeft1, MatLeft2, MatLeft3, MatRight) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: HSTEP_GLACIER +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! in & out variables + type(noahmp_type) , intent(inout) :: noahmp + real(kind=kind_noahmp), intent(in) :: TimeStep ! timestep (may not be the same as model timestep) + real(kind=kind_noahmp), allocatable, dimension(:), intent(inout) :: MatRight ! right-hand side term of the matrix + real(kind=kind_noahmp), allocatable, dimension(:), intent(inout) :: MatLeft1 ! left-hand side term of the matrix + real(kind=kind_noahmp), allocatable, dimension(:), intent(inout) :: MatLeft2 ! left-hand side term of the matrix + real(kind=kind_noahmp), allocatable, dimension(:), intent(inout) :: MatLeft3 ! left-hand side term of the matrix + +! local variable + integer :: LoopInd ! layer loop index + real(kind=kind_noahmp), allocatable, dimension(:) :: MatRightTmp ! temporary MatRight matrix coefficient + real(kind=kind_noahmp), allocatable, dimension(:) :: MatLeft3Tmp ! temporary MatLeft3 matrix coefficient + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of glacier/soil layers + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! in, actual number of snow layers (negative) + TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow & ! inout, snow and glacier layer temperature [K] + ) +! ---------------------------------------------------------------------- + + ! initialization + if (.not. allocated(MatRightTmp)) allocate(MatRightTmp(-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(MatLeft3Tmp)) allocate(MatLeft3Tmp(-NumSnowLayerMax+1:NumSoilLayer)) + MatRightTmp = 0.0 + MatLeft3Tmp = 0.0 + + ! update tri-diagonal matrix elements + do LoopInd = NumSnowLayerNeg+1, NumSoilLayer + MatRight(LoopInd) = MatRight(LoopInd) * TimeStep + MatLeft1(LoopInd) = MatLeft1(LoopInd) * TimeStep + MatLeft2(LoopInd) = 1.0 + MatLeft2(LoopInd) * TimeStep + MatLeft3(LoopInd) = MatLeft3(LoopInd) * TimeStep + enddo + + ! copy values for input variables before call to rosr12 + do LoopInd = NumSnowLayerNeg+1, NumSoilLayer + MatRightTmp(LoopInd) = MatRight(LoopInd) + MatLeft3Tmp(LoopInd) = MatLeft3(LoopInd) + enddo + + ! solve the tri-diagonal matrix equation + call MatrixSolverTriDiagonal(MatLeft3,MatLeft1,MatLeft2,MatLeft3Tmp,MatRightTmp,MatRight,& + NumSnowLayerNeg+1,NumSoilLayer,NumSnowLayerMax) + + ! update snow & glacier temperature + do LoopInd = NumSnowLayerNeg+1, NumSoilLayer + TemperatureSoilSnow(LoopInd) = TemperatureSoilSnow(LoopInd) + MatLeft3(LoopInd) + enddo + + ! deallocate local arrays to avoid memory leaks + deallocate(MatRightTmp) + deallocate(MatLeft3Tmp) + + end associate + + end subroutine GlacierTemperatureSolver + +end module GlacierTemperatureSolverMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/GlacierThermalDiffusionMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/GlacierThermalDiffusionMod.F90 new file mode 100644 index 000000000..0eb8e66cc --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/GlacierThermalDiffusionMod.F90 @@ -0,0 +1,141 @@ +module GlacierThermalDiffusionMod + +!!! Solve glacier ice and snow layer thermal diffusion +!!! Calculate the right hand side of the time tendency term of the glacier +!!! and snow thermal diffusion equation. Currently snow and glacier ice layers +!!! are coupled in solving the equations. Also compute/prepare the matrix +!!! coefficients for the tri-diagonal matrix of the implicit time scheme. + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine GlacierThermalDiffusion(noahmp, MatLeft1, MatLeft2, MatLeft3, MatRight) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: HRT_GLACIER +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! in & out variables + type(noahmp_type) , intent(inout) :: noahmp + real(kind=kind_noahmp), allocatable, dimension(:), intent(inout) :: MatRight ! right-hand side term of the matrix + real(kind=kind_noahmp), allocatable, dimension(:), intent(inout) :: MatLeft1 ! left-hand side term of the matrix + real(kind=kind_noahmp), allocatable, dimension(:), intent(inout) :: MatLeft2 ! left-hand side term of the matrix + real(kind=kind_noahmp), allocatable, dimension(:), intent(inout) :: MatLeft3 ! left-hand side term of the matrix + +! local variable + integer :: LoopInd ! loop index + real(kind=kind_noahmp) :: DepthSnowSoilTmp ! temporary snow/soil layer depth [m] + real(kind=kind_noahmp), allocatable, dimension(:) :: DepthSnowSoilInv ! inverse of snow/soil layer depth [1/m] + real(kind=kind_noahmp), allocatable, dimension(:) :: HeatCapacPerArea ! Heat capacity of soil/snow per area [J/m2/K] + real(kind=kind_noahmp), allocatable, dimension(:) :: TempGradDepth ! temperature gradient (derivative) with soil/snow depth [K/m] + real(kind=kind_noahmp), allocatable, dimension(:) :: EnergyExcess ! energy flux excess in soil/snow [W/m2] + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! in, actual number of snow layers (negative) + DepthSnowSoilLayer => noahmp%config%domain%DepthSnowSoilLayer ,& ! in, depth of snow/soil layer-bottom [m] + OptSoilTemperatureBottom => noahmp%config%nmlist%OptSoilTemperatureBottom ,& ! in, options for lower boundary condition of soil temperature + OptSnowSoilTempTime => noahmp%config%nmlist%OptSnowSoilTempTime ,& ! in, options for snow/soil temperature time scheme + TemperatureSoilBottom => noahmp%forcing%TemperatureSoilBottom ,& ! in, bottom boundary soil temperature [K] + DepthSoilTempBotToSno => noahmp%energy%state%DepthSoilTempBotToSno ,& ! in, depth of lower boundary condition [m] from snow surface + TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow ,& ! in, snow and soil layer temperature [K] + ThermConductSoilSnow => noahmp%energy%state%ThermConductSoilSnow ,& ! in, thermal conductivity [W/m/K] for all soil & snow + HeatCapacSoilSnow => noahmp%energy%state%HeatCapacSoilSnow ,& ! in, heat capacity [J/m3/K] for all soil & snow + HeatGroundTot => noahmp%energy%flux%HeatGroundTot ,& ! in, total ground heat flux [W/m2] (+ to soil/snow) + RadSwPenetrateGrd => noahmp%energy%flux%RadSwPenetrateGrd ,& ! in, light penetrating through soil/snow water [W/m2] + HeatFromSoilBot => noahmp%energy%flux%HeatFromSoilBot & ! out, energy influx from soil bottom [W/m2] + ) +! ---------------------------------------------------------------------- + + ! initialization + if (.not. allocated(DepthSnowSoilInv)) allocate(DepthSnowSoilInv(-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(HeatCapacPerArea)) allocate(HeatCapacPerArea(-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(TempGradDepth) ) allocate(TempGradDepth (-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(EnergyExcess) ) allocate(EnergyExcess (-NumSnowLayerMax+1:NumSoilLayer)) + MatRight(:) = 0.0 + MatLeft1(:) = 0.0 + MatLeft2(:) = 0.0 + MatLeft3(:) = 0.0 + DepthSnowSoilInv(:) = 0.0 + HeatCapacPerArea(:) = 0.0 + TempGradDepth(:) = 0.0 + EnergyExcess(:) = 0.0 + + ! compute gradient and flux of glacier/snow thermal diffusion + do LoopInd = NumSnowLayerNeg+1, NumSoilLayer + if ( LoopInd == (NumSnowLayerNeg+1) ) then + HeatCapacPerArea(LoopInd) = - DepthSnowSoilLayer(LoopInd) * HeatCapacSoilSnow(LoopInd) + DepthSnowSoilTmp = - DepthSnowSoilLayer(LoopInd+1) + DepthSnowSoilInv(LoopInd) = 2.0 / DepthSnowSoilTmp + TempGradDepth(LoopInd) = 2.0 * (TemperatureSoilSnow(LoopInd) - TemperatureSoilSnow(LoopInd+1)) / DepthSnowSoilTmp + EnergyExcess(LoopInd) = ThermConductSoilSnow(LoopInd) * TempGradDepth(LoopInd) - & + HeatGroundTot - RadSwPenetrateGrd(LoopInd) + elseif ( LoopInd < NumSoilLayer ) then + HeatCapacPerArea(LoopInd) = (DepthSnowSoilLayer(LoopInd-1) - DepthSnowSoilLayer(LoopInd)) * HeatCapacSoilSnow(LoopInd) + DepthSnowSoilTmp = DepthSnowSoilLayer(LoopInd-1) - DepthSnowSoilLayer(LoopInd+1) + DepthSnowSoilInv(LoopInd) = 2.0 / DepthSnowSoilTmp + TempGradDepth(LoopInd) = 2.0 * (TemperatureSoilSnow(LoopInd) - TemperatureSoilSnow(LoopInd+1)) / DepthSnowSoilTmp + EnergyExcess(LoopInd) = (ThermConductSoilSnow(LoopInd)*TempGradDepth(LoopInd) - & + ThermConductSoilSnow(LoopInd-1)*TempGradDepth(LoopInd-1) ) - RadSwPenetrateGrd(LoopInd) + elseif ( LoopInd == NumSoilLayer ) then + HeatCapacPerArea(LoopInd) = (DepthSnowSoilLayer(LoopInd-1) - DepthSnowSoilLayer(LoopInd)) * HeatCapacSoilSnow(LoopInd) + DepthSnowSoilTmp = DepthSnowSoilLayer(LoopInd-1) - DepthSnowSoilLayer(LoopInd) + if ( OptSoilTemperatureBottom == 1 ) then + HeatFromSoilBot = 0.0 + endif + if ( OptSoilTemperatureBottom == 2 ) then + TempGradDepth(LoopInd) = (TemperatureSoilSnow(LoopInd) - TemperatureSoilBottom) / & + (0.5 * (DepthSnowSoilLayer(LoopInd-1)+DepthSnowSoilLayer(LoopInd)) - DepthSoilTempBotToSno) + HeatFromSoilBot = -ThermConductSoilSnow(LoopInd) * TempGradDepth(LoopInd) + endif + EnergyExcess(LoopInd) = (-HeatFromSoilBot - ThermConductSoilSnow(LoopInd-1)*TempGradDepth(LoopInd-1)) - & + RadSwPenetrateGrd(LoopInd) + endif + enddo + + ! prepare the matrix coefficients for the tri-diagonal matrix + do LoopInd = NumSnowLayerNeg+1, NumSoilLayer + if ( LoopInd == (NumSnowLayerNeg+1) ) then + MatLeft1(LoopInd) = 0.0 + MatLeft3(LoopInd) = - ThermConductSoilSnow(LoopInd) * DepthSnowSoilInv(LoopInd) / HeatCapacPerArea(LoopInd) + if ( (OptSnowSoilTempTime == 1) .or. (OptSnowSoilTempTime == 3) ) then + MatLeft2(LoopInd) = - MatLeft3(LoopInd) + endif + if ( OptSnowSoilTempTime == 2 ) then + MatLeft2(LoopInd) = - MatLeft3(LoopInd) + ThermConductSoilSnow(LoopInd) / & + (0.5*DepthSnowSoilLayer(LoopInd)*DepthSnowSoilLayer(LoopInd)*HeatCapacSoilSnow(LoopInd)) + endif + elseif ( LoopInd < NumSoilLayer ) then + MatLeft1(LoopInd) = - ThermConductSoilSnow(LoopInd-1) * DepthSnowSoilInv(LoopInd-1) / HeatCapacPerArea(LoopInd) + MatLeft3(LoopInd) = - ThermConductSoilSnow(LoopInd ) * DepthSnowSoilInv(LoopInd ) / HeatCapacPerArea(LoopInd) + MatLeft2(LoopInd) = - (MatLeft1(LoopInd) + MatLeft3 (LoopInd)) + elseif ( LoopInd == NumSoilLayer ) then + MatLeft1(LoopInd) = - ThermConductSoilSnow(LoopInd-1) * DepthSnowSoilInv(LoopInd-1) / HeatCapacPerArea(LoopInd) + MatLeft3(LoopInd) = 0.0 + MatLeft2(LoopInd) = - (MatLeft1(LoopInd) + MatLeft3(LoopInd)) + endif + MatRight(LoopInd) = EnergyExcess(LoopInd) / (-HeatCapacPerArea(LoopInd)) + enddo + + ! deallocate local arrays to avoid memory leaks + deallocate(DepthSnowSoilInv) + deallocate(HeatCapacPerArea) + deallocate(TempGradDepth ) + deallocate(EnergyExcess ) + + end associate + + end subroutine GlacierThermalDiffusion + +end module GlacierThermalDiffusionMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/GroundAlbedoGlacierMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/GroundAlbedoGlacierMod.F90 new file mode 100644 index 000000000..5e876a59b --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/GroundAlbedoGlacierMod.F90 @@ -0,0 +1,51 @@ +module GroundAlbedoGlacierMod + +!!! Compute glacier ground albedo based on snow and ice albedo + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine GroundAlbedoGlacier(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: RADIATION_GLACIER +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: IndSwBnd ! solar radiation band index + +! -------------------------------------------------------------------- + associate( & + NumSwRadBand => noahmp%config%domain%NumSwRadBand ,& ! in, number of solar radiation wave bands + SnowCoverFrac => noahmp%water%state%SnowCoverFrac ,& ! in, snow cover fraction + AlbedoLandIce => noahmp%energy%param%AlbedoLandIce ,& ! in, albedo land ice: 1=vis, 2=nir + AlbedoSnowDir => noahmp%energy%state%AlbedoSnowDir ,& ! in, snow albedo for direct(1=vis, 2=nir) + AlbedoSnowDif => noahmp%energy%state%AlbedoSnowDif ,& ! in, snow albedo for diffuse(1=vis, 2=nir) + AlbedoGrdDir => noahmp%energy%state%AlbedoGrdDir ,& ! out, ground albedo (direct beam: vis, nir) + AlbedoGrdDif => noahmp%energy%state%AlbedoGrdDif & ! out, ground albedo (diffuse: vis, nir) + ) +! ---------------------------------------------------------------------- + + do IndSwBnd = 1, NumSwRadBand + + AlbedoGrdDir(IndSwBnd) = AlbedoLandIce(IndSwBnd)*(1.0-SnowCoverFrac) + AlbedoSnowDir(IndSwBnd)*SnowCoverFrac + AlbedoGrdDif(IndSwBnd) = AlbedoLandIce(IndSwBnd)*(1.0-SnowCoverFrac) + AlbedoSnowDif(IndSwBnd)*SnowCoverFrac + + enddo + + end associate + + end subroutine GroundAlbedoGlacier + +end module GroundAlbedoGlacierMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/GroundAlbedoMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/GroundAlbedoMod.F90 new file mode 100644 index 000000000..6ca4b1056 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/GroundAlbedoMod.F90 @@ -0,0 +1,73 @@ +module GroundAlbedoMod + +!!! Compute ground albedo based on soil and snow albedo + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine GroundAlbedo(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: GROUNDALB +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: IndSwBnd ! solar radiation band index + real(kind=kind_noahmp) :: AlbedoSoilAdjWet ! soil water correction factor for soil albedo + +! -------------------------------------------------------------------- + associate( & + NumSwRadBand => noahmp%config%domain%NumSwRadBand ,& ! in, number of solar radiation wave bands + SurfaceType => noahmp%config%domain%SurfaceType ,& ! in, surface type 1-soil; 2-lake + CosSolarZenithAngle => noahmp%config%domain%CosSolarZenithAngle ,& ! in, cosine solar zenith angle + SnowCoverFrac => noahmp%water%state%SnowCoverFrac ,& ! in, snow cover fraction + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! in, total soil moisture [m3/m3] + AlbedoSoilSat => noahmp%energy%param%AlbedoSoilSat ,& ! in, saturated soil albedos: 1=vis, 2=nir + AlbedoSoilDry => noahmp%energy%param%AlbedoSoilDry ,& ! in, dry soil albedos: 1=vis, 2=nir + AlbedoLakeFrz => noahmp%energy%param%AlbedoLakeFrz ,& ! in, albedo frozen lakes: 1=vis, 2=nir + TemperatureGrd => noahmp%energy%state%TemperatureGrd ,& ! in, ground temperature [K] + AlbedoSnowDir => noahmp%energy%state%AlbedoSnowDir ,& ! in, snow albedo for direct(1=vis, 2=nir) + AlbedoSnowDif => noahmp%energy%state%AlbedoSnowDif ,& ! in, snow albedo for diffuse(1=vis, 2=nir) + AlbedoSoilDir => noahmp%energy%state%AlbedoSoilDir ,& ! out, soil albedo (direct) + AlbedoSoilDif => noahmp%energy%state%AlbedoSoilDif ,& ! out, soil albedo (diffuse) + AlbedoGrdDir => noahmp%energy%state%AlbedoGrdDir ,& ! out, ground albedo (direct beam: vis, nir) + AlbedoGrdDif => noahmp%energy%state%AlbedoGrdDif & ! out, ground albedo (diffuse: vis, nir) + ) +! ---------------------------------------------------------------------- + + do IndSwBnd = 1, NumSwRadBand + + AlbedoSoilAdjWet = max(0.11-0.40*SoilMoisture(1), 0.0) + + if ( SurfaceType == 1 ) then ! soil + AlbedoSoilDir(IndSwBnd) = min(AlbedoSoilSat(IndSwBnd)+AlbedoSoilAdjWet, AlbedoSoilDry(IndSwBnd)) + AlbedoSoilDif(IndSwBnd) = AlbedoSoilDir(IndSwBnd) + elseif ( TemperatureGrd > ConstFreezePoint ) then ! unfrozen lake, wetland + AlbedoSoilDir(IndSwBnd) = 0.06 / (max(0.01, CosSolarZenithAngle)**1.7+0.15) + AlbedoSoilDif(IndSwBnd) = 0.06 + else ! frozen lake, wetland + AlbedoSoilDir(IndSwBnd) = AlbedoLakeFrz(IndSwBnd) + AlbedoSoilDif(IndSwBnd) = AlbedoSoilDir(IndSwBnd) + endif + + AlbedoGrdDir(IndSwBnd) = AlbedoSoilDir(IndSwBnd)*(1.0-SnowCoverFrac) + AlbedoSnowDir(IndSwBnd)*SnowCoverFrac + AlbedoGrdDif(IndSwBnd) = AlbedoSoilDif(IndSwBnd)*(1.0-SnowCoverFrac) + AlbedoSnowDif(IndSwBnd)*SnowCoverFrac + + enddo + + end associate + + end subroutine GroundAlbedo + +end module GroundAlbedoMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/GroundRoughnessPropertyGlacierMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/GroundRoughnessPropertyGlacierMod.F90 new file mode 100644 index 000000000..785ac62ad --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/GroundRoughnessPropertyGlacierMod.F90 @@ -0,0 +1,54 @@ +module GroundRoughnessPropertyGlacierMod + +!!! Compute glacier ground roughness length, displacement height, and surface reference height + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine GroundRoughnessPropertyGlacier(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: None (embedded in ENERGY_GLACIER subroutine) +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + +! in & out variables + type(noahmp_type), intent(inout) :: noahmp + +! -------------------------------------------------------------------- + associate( & + RefHeightAboveSfc => noahmp%config%domain%RefHeightAboveSfc ,& ! in, reference height [m] above surface zero plane + SnowDepth => noahmp%water%state%SnowDepth ,& ! in, snow depth [m] + RoughLenMomSnow => noahmp%energy%param%RoughLenMomSnow ,& ! in, snow surface roughness length [m] + RoughLenMomSfc => noahmp%energy%state%RoughLenMomSfc ,& ! out, roughness length [m], momentum, surface + RoughLenMomGrd => noahmp%energy%state%RoughLenMomGrd ,& ! out, roughness length [m], momentum, ground + ZeroPlaneDispSfc => noahmp%energy%state%ZeroPlaneDispSfc ,& ! out, surface zero plane displacement [m] + ZeroPlaneDispGrd => noahmp%energy%state%ZeroPlaneDispGrd ,& ! out, ground zero plane displacement [m] + RefHeightAboveGrd => noahmp%energy%state%RefHeightAboveGrd & ! out, reference height [m] above ground + ) +! ---------------------------------------------------------------------- + + ! ground roughness length + RoughLenMomGrd = RoughLenMomSnow + RoughLenMomSfc = RoughLenMomGrd + + ! surface roughness length and displacement height + ZeroPlaneDispGrd = SnowDepth + ZeroPlaneDispSfc = ZeroPlaneDispGrd + + ! reference height above ground + RefHeightAboveGrd = ZeroPlaneDispSfc + RefHeightAboveSfc + + end associate + + end subroutine GroundRoughnessPropertyGlacier + +end module GroundRoughnessPropertyGlacierMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/GroundRoughnessPropertyMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/GroundRoughnessPropertyMod.F90 new file mode 100644 index 000000000..939413188 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/GroundRoughnessPropertyMod.F90 @@ -0,0 +1,86 @@ +module GroundRoughnessPropertyMod + +!!! Compute ground roughness length, displacement height, and surface reference height + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine GroundRoughnessProperty(noahmp, FlagVegSfc) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: None (embedded in ENERGY subroutine) +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + +! in & out variables + type(noahmp_type), intent(inout) :: noahmp + logical , intent(in ) :: FlagVegSfc ! flag: true if vegetated surface + +! -------------------------------------------------------------------- + associate( & + SurfaceType => noahmp%config%domain%SurfaceType ,& ! in, surface type 1-soil; 2-lake + RefHeightAboveSfc => noahmp%config%domain%RefHeightAboveSfc ,& ! in, reference height [m] above surface zero plane + FlagUrban => noahmp%config%domain%FlagUrban ,& ! in, logical flag for urban grid + SnowCoverFrac => noahmp%water%state%SnowCoverFrac ,& ! in, snow cover fraction + SnowDepth => noahmp%water%state%SnowDepth ,& ! in, snow depth [m] + HeightCanopyTop => noahmp%energy%param%HeightCanopyTop ,& ! in, top of canopy [m] + RoughLenMomVeg => noahmp%energy%param%RoughLenMomVeg ,& ! in, momentum roughness length vegetated [m] + RoughLenMomSnow => noahmp%energy%param%RoughLenMomSnow ,& ! in, snow surface roughness length [m] + RoughLenMomSoil => noahmp%energy%param%RoughLenMomSoil ,& ! in, bare-soil roughness length [m] + RoughLenMomLake => noahmp%energy%param%RoughLenMomLake ,& ! in, lake surface roughness length [m] + TemperatureGrd => noahmp%energy%state%TemperatureGrd ,& ! in, ground temperature [K] + RoughLenMomSfc => noahmp%energy%state%RoughLenMomSfc ,& ! out, roughness length [m], momentum, surface + RoughLenMomGrd => noahmp%energy%state%RoughLenMomGrd ,& ! out, roughness length [m], momentum, ground + ZeroPlaneDispSfc => noahmp%energy%state%ZeroPlaneDispSfc ,& ! out, surface zero plane displacement [m] + ZeroPlaneDispGrd => noahmp%energy%state%ZeroPlaneDispGrd ,& ! out, ground zero plane displacement [m] + RefHeightAboveGrd => noahmp%energy%state%RefHeightAboveGrd & ! out, reference height [m] above ground + ) +! ---------------------------------------------------------------------- + + ! ground roughness length + if ( SurfaceType == 2 ) then ! Lake + if ( TemperatureGrd <= ConstFreezePoint ) then + RoughLenMomGrd = RoughLenMomLake * (1.0-SnowCoverFrac) + SnowCoverFrac * RoughLenMomSnow + else + RoughLenMomGrd = RoughLenMomLake + endif + else ! soil + RoughLenMomGrd = RoughLenMomSoil * (1.0-SnowCoverFrac) + SnowCoverFrac * RoughLenMomSnow + endif + + ! surface roughness length and displacement height + ZeroPlaneDispGrd = SnowDepth + if ( FlagVegSfc .eqv. .true. ) then + RoughLenMomSfc = RoughLenMomVeg + ZeroPlaneDispSfc = 0.65 * HeightCanopyTop + if ( SnowDepth > ZeroPlaneDispSfc ) ZeroPlaneDispSfc = SnowDepth + else + RoughLenMomSfc = RoughLenMomGrd + ZeroPlaneDispSfc = ZeroPlaneDispGrd + endif + + ! special case for urban + if ( FlagUrban .eqv. .true. ) then + RoughLenMomGrd = RoughLenMomVeg + ZeroPlaneDispGrd = 0.65 * HeightCanopyTop + RoughLenMomSfc = RoughLenMomGrd + ZeroPlaneDispSfc = ZeroPlaneDispGrd + endif + + ! reference height above ground + RefHeightAboveGrd = max(ZeroPlaneDispSfc, HeightCanopyTop) + RefHeightAboveSfc + if ( ZeroPlaneDispGrd >= RefHeightAboveGrd ) RefHeightAboveGrd = ZeroPlaneDispGrd + RefHeightAboveSfc + + end associate + + end subroutine GroundRoughnessProperty + +end module GroundRoughnessPropertyMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/GroundThermalPropertyGlacierMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/GroundThermalPropertyGlacierMod.F90 new file mode 100644 index 000000000..62268d971 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/GroundThermalPropertyGlacierMod.F90 @@ -0,0 +1,84 @@ +module GroundThermalPropertyGlacierMod + +!!! Compute snow and glacier ice thermal conductivity and heat capacity + + use Machine + use NoahmpVarType + use ConstantDefineMod + use SnowThermalPropertyMod, only : SnowThermalProperty + use GlacierIceThermalPropertyMod, only : GlacierIceThermalProperty + + implicit none + +contains + + subroutine GroundThermalPropertyGlacier(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: THERMOPROP_GLACIER +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: LoopInd ! loop index + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, main noahmp timestep [s] + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! in, thickness of snow/soil layers [m] + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! in, actual number of snow layers (negative) + SnowDepth => noahmp%water%state%SnowDepth ,& ! in, snow depth [m] + ThermConductSoilSnow => noahmp%energy%state%ThermConductSoilSnow ,& ! out, thermal conductivity [W/m/K] for all soil & snow + HeatCapacSoilSnow => noahmp%energy%state%HeatCapacSoilSnow ,& ! out, heat capacity [J/m3/K] for all soil & snow + PhaseChgFacSoilSnow => noahmp%energy%state%PhaseChgFacSoilSnow ,& ! out, energy factor for soil & snow phase change + HeatCapacVolSnow => noahmp%energy%state%HeatCapacVolSnow ,& ! out, snow layer volumetric specific heat [J/m3/K] + ThermConductSnow => noahmp%energy%state%ThermConductSnow ,& ! out, snow layer thermal conductivity [W/m/K] + HeatCapacGlaIce => noahmp%energy%state%HeatCapacGlaIce ,& ! out, glacier ice layer volumetric specific heat [J/m3/K] + ThermConductGlaIce => noahmp%energy%state%ThermConductGlaIce & ! out, glacier ice layer thermal conductivity [W/m/K] + ) +! ---------------------------------------------------------------------- + + ! initialize + HeatCapacSoilSnow = 0.0 + ThermConductSoilSnow = 0.0 + + ! compute snow thermal conductivity and heat capacity + call SnowThermalProperty(noahmp) + do LoopInd = NumSnowLayerNeg+1, 0 + ThermConductSoilSnow(LoopInd) = ThermConductSnow(LoopInd) + HeatCapacSoilSnow(LoopInd) = HeatCapacVolSnow(LoopInd) + enddo + + ! compute glacier ice thermal properties (using Noah glacial ice approximations) + call GlacierIceThermalProperty(noahmp) + do LoopInd = 1, NumSoilLayer + ThermConductSoilSnow(LoopInd) = ThermConductGlaIce(LoopInd) + HeatCapacSoilSnow(LoopInd) = HeatCapacGlaIce(LoopInd) + enddo + + ! combine a temporary variable used for melting/freezing of snow and glacier ice + do LoopInd = NumSnowLayerNeg+1, NumSoilLayer + PhaseChgFacSoilSnow(LoopInd) = MainTimeStep / (HeatCapacSoilSnow(LoopInd)*ThicknessSnowSoilLayer(LoopInd)) + enddo + + ! snow/glacier ice interface + if ( NumSnowLayerNeg == 0 ) then + ThermConductSoilSnow(1) = (ThermConductSoilSnow(1)*ThicknessSnowSoilLayer(1) + 0.35*SnowDepth) / & + (SnowDepth + ThicknessSnowSoilLayer(1)) + else + ThermConductSoilSnow(1) = (ThermConductSoilSnow(1)*ThicknessSnowSoilLayer(1) + & + ThermConductSoilSnow(0)*ThicknessSnowSoilLayer(0)) / & + (ThicknessSnowSoilLayer(0) + ThicknessSnowSoilLayer(1)) + endif + + end associate + + end subroutine GroundThermalPropertyGlacier + +end module GroundThermalPropertyGlacierMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/GroundThermalPropertyMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/GroundThermalPropertyMod.F90 new file mode 100644 index 000000000..a8b28ed51 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/GroundThermalPropertyMod.F90 @@ -0,0 +1,111 @@ +module GroundThermalPropertyMod + +!!! Compute snow and soil thermal conductivity and heat capacity + + use Machine + use NoahmpVarType + use ConstantDefineMod + use SnowThermalPropertyMod, only : SnowThermalProperty + use SoilThermalPropertyMod, only : SoilThermalProperty + + implicit none + +contains + + subroutine GroundThermalProperty(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: THERMOPROP +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: LoopInd ! loop index + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + SurfaceType => noahmp%config%domain%SurfaceType ,& ! in, surface type 1-soil; 2-lake + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, main noahmp timestep [s] + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! in, thickness of snow/soil layers [m] + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! in, actual number of snow layers (negative) + FlagUrban => noahmp%config%domain%FlagUrban ,& ! in, logical flag for urban grid + SnowDepth => noahmp%water%state%SnowDepth ,& ! in, snow depth [m] + TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow ,& ! in, snow and soil layer temperature [K] + ThermConductSoilSnow => noahmp%energy%state%ThermConductSoilSnow ,& ! out, thermal conductivity [W/m/K] for all soil & snow + HeatCapacSoilSnow => noahmp%energy%state%HeatCapacSoilSnow ,& ! out, heat capacity [J/m3/K] for all soil & snow + PhaseChgFacSoilSnow => noahmp%energy%state%PhaseChgFacSoilSnow ,& ! out, energy factor for soil & snow phase change + HeatCapacVolSnow => noahmp%energy%state%HeatCapacVolSnow ,& ! out, snow layer volumetric specific heat [J/m3/K] + ThermConductSnow => noahmp%energy%state%ThermConductSnow ,& ! out, snow layer thermal conductivity [W/m/K] + HeatCapacVolSoil => noahmp%energy%state%HeatCapacVolSoil ,& ! out, soil layer volumetric specific heat [J/m3/K] + ThermConductSoil => noahmp%energy%state%ThermConductSoil & ! out, soil layer thermal conductivity [W/m/K] + ) +! ---------------------------------------------------------------------- + + ! initialize + HeatCapacSoilSnow = 0.0 + ThermConductSoilSnow = 0.0 + + ! compute snow thermal conductivity and heat capacity + call SnowThermalProperty(noahmp) + do LoopInd = NumSnowLayerNeg+1, 0 + ThermConductSoilSnow(LoopInd) = ThermConductSnow(LoopInd) + HeatCapacSoilSnow(LoopInd) = HeatCapacVolSnow(LoopInd) + enddo + + ! compute soil thermal properties + call SoilThermalProperty(noahmp) + do LoopInd = 1, NumSoilLayer + ThermConductSoilSnow(LoopInd) = ThermConductSoil(LoopInd) + HeatCapacSoilSnow(LoopInd) = HeatCapacVolSoil(LoopInd) + enddo + if ( FlagUrban .eqv. .true. ) then + do LoopInd = 1, NumSoilLayer + ThermConductSoilSnow(LoopInd) = 3.24 + enddo + endif + + ! heat flux reduction effect from the overlying green canopy, adapted from + ! section 2.1.2 of Peters-Lidard et al. (1997, JGR, VOL 102(D4)). + ! not in use because of the separation of the canopy layer from the ground. + ! but this may represent the effects of leaf litter (Niu comments) + ! ThermConductSoilSnow(1) = ThermConductSoilSnow(1) * EXP (SBETA * VegFracGreen) + + ! compute lake thermal properties (no consideration of turbulent mixing for this version) + if ( SurfaceType == 2 ) then + do LoopInd = 1, NumSoilLayer + if ( TemperatureSoilSnow(LoopInd) > ConstFreezePoint) then + HeatCapacSoilSnow(LoopInd) = ConstHeatCapacWater + ThermConductSoilSnow(LoopInd) = ConstThermConductWater !+ KEDDY * ConstHeatCapacWater + else + HeatCapacSoilSnow(LoopInd) = ConstHeatCapacIce + ThermConductSoilSnow(LoopInd) = ConstThermConductIce + endif + enddo + endif + + ! combine a temporary variable used for melting/freezing of snow and frozen soil + do LoopInd = NumSnowLayerNeg+1, NumSoilLayer + PhaseChgFacSoilSnow(LoopInd) = MainTimeStep / (HeatCapacSoilSnow(LoopInd) * ThicknessSnowSoilLayer(LoopInd)) + enddo + + ! snow/soil interface + if ( NumSnowLayerNeg == 0 ) then + ThermConductSoilSnow(1) = (ThermConductSoilSnow(1)*ThicknessSnowSoilLayer(1) + 0.35*SnowDepth) / & + (SnowDepth + ThicknessSnowSoilLayer(1)) + else + ThermConductSoilSnow(1) = (ThermConductSoilSnow(1)*ThicknessSnowSoilLayer(1) + & + ThermConductSoilSnow(0)*ThicknessSnowSoilLayer(0)) / & + (ThicknessSnowSoilLayer(0) + ThicknessSnowSoilLayer(1)) + endif + + end associate + + end subroutine GroundThermalProperty + +end module GroundThermalPropertyMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/GroundWaterMmfMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/GroundWaterMmfMod.F90 new file mode 100644 index 000000000..da9ef7c9c --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/GroundWaterMmfMod.F90 @@ -0,0 +1,691 @@ +module GroundWaterMmfMod + +!!! Module to calculate lateral groundwater flow and the flux between groundwater and rivers +!!! plus the routine to update soil moisture and water table due to those two fluxes +!!! according to the Miguez-Macho & Fan groundwater scheme (Miguez-Macho et al., JGR 2007). +!!! Module written by Gonzalo Miguez-Macho , U. de Santiago de Compostela, Galicia, Spain +!!! November 2012 + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: module_sf_groundwater.F +! Original code: Miguez-Macho&Fan (Miguez-Macho et al 2007, Fan et al 2007) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! Note: this MMF scheme needs further refactoring +! ------------------------------------------------------------------------- + + use NoahmpIOVarType + use NoahmpVarType + use Machine + + implicit none + +contains + + subroutine WTABLE_mmf_noahmp (NoahmpIO ,NSOIL ,XLAND ,XICE ,XICE_THRESHOLD,& + ISICE ,ISLTYP ,SMOISEQ ,DZS ,WTDDT ,& !in + FDEPTH ,AREA ,TOPO ,ISURBAN ,IVGTYP ,& !in + RIVERCOND ,RIVERBED ,EQWTD ,PEXP ,& !in + SMOIS ,SH2OXY ,SMCWTD ,WTD , QLAT, QRF ,& !inout + DEEPRECH ,QSPRING ,QSLAT ,QRFS ,QSPRINGS ,RECH ,& !inout + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte ) + +! ---------------------------------------------------------------------- +! USE NOAHMP_TABLES, ONLY: BEXP_TABLE, DKSAT_TABLE, SMCMAX_TABLE,PSISAT_TABLE, SMCWLT_TABLE +! ---------------------------------------------------------------------- + IMPLICIT NONE +! ---------------------------------------------------------------------- +! IN only + + type(NoahmpIO_type), intent(in) :: NoahmpIO + + INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & + & ims,ime, jms,jme, kms,kme, & + & its,ite, jts,jte, kts,kte + REAL, INTENT(IN) :: WTDDT + REAL, INTENT(IN) :: XICE_THRESHOLD + INTEGER, INTENT(IN ) :: ISICE + REAL, DIMENSION( ims:ime, jms:jme ) , & + & INTENT(IN ) :: XLAND, & + XICE + INTEGER, DIMENSION( ims:ime, jms:jme ) , & + INTENT(IN ) :: ISLTYP, & + IVGTYP + INTEGER, INTENT(IN) :: nsoil + INTEGER, INTENT(IN) :: ISURBAN + REAL, DIMENSION( ims:ime , 1:nsoil, jms:jme ), & + & INTENT(IN) :: SMOISEQ + REAL, DIMENSION(1:nsoil), INTENT(IN) :: DZS + REAL, DIMENSION( ims:ime, jms:jme ) , & + & INTENT(IN) :: FDEPTH, & + AREA, & + TOPO, & + EQWTD, & + PEXP, & + RIVERBED, & + RIVERCOND + +! IN and OUT + + REAL, DIMENSION( ims:ime , 1:nsoil, jms:jme ), & + & INTENT(INOUT) :: SMOIS, & + & SH2OXY + + + REAL, DIMENSION( ims:ime, jms:jme ) , & + & INTENT(INOUT) :: WTD, & + SMCWTD, & + DEEPRECH, & + QSLAT, & + QRFS, & + QSPRINGS, & + RECH + +!OUT + + REAL, DIMENSION( ims:ime, jms:jme ) , & + & INTENT(OUT) :: QRF, & !groundwater - river water flux + QSPRING !water springing at the surface from groundwater convergence in the column + +!LOCAL + + INTEGER :: I,J,K + REAL, DIMENSION( 0:NSOIL) :: ZSOIL !depth of soil layer-bottom [m] + REAL, DIMENSION( 1:NSOIL) :: SMCEQ !equilibrium soil water content [m3/m3] + REAL, DIMENSION( 1:NSOIL) :: SMC,SH2O + REAL :: DELTAT,RCOND,TOTWATER,PSI & + ,WFLUXDEEP,WCNDDEEP,DDZ,SMCWTDMID & + ,WPLUS,WMINUS + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: QLAT + INTEGER, DIMENSION( ims:ime, jms:jme ) :: LANDMASK !-1 for water (ice or no ice) and glacial areas, 1 for land where the LSM does its soil moisture calculations. + + REAL :: BEXP,DKSAT,PSISAT,SMCMAX,SMCWLT + + DELTAT = WTDDT * 60. !timestep in seconds for this calculation + + ZSOIL(0) = 0. + ZSOIL(1) = -DZS(1) + DO K = 2, NSOIL + ZSOIL(K) = -DZS(K) + ZSOIL(K-1) + END DO + + WHERE(XLAND-1.5.LT.0..AND.XICE.LT. XICE_THRESHOLD.AND.IVGTYP.NE.ISICE) + LANDMASK=1 + ELSEWHERE + LANDMASK=-1 + ENDWHERE + +!Calculate lateral flow + + QLAT = 0. + CALL LATERALFLOW(NoahmpIO, ISLTYP,WTD,QLAT,FDEPTH,TOPO,LANDMASK,DELTAT,AREA & + ,ids,ide,jds,jde,kds,kde & + ,ims,ime,jms,jme,kms,kme & + ,its,ite,jts,jte,kts,kte ) + + +!compute flux from grounwater to rivers in the cell + + DO J=jts,jte + DO I=its,ite + IF(LANDMASK(I,J).GT.0)THEN + IF(WTD(I,J) .GT. RIVERBED(I,J) .AND. EQWTD(I,J) .GT. RIVERBED(I,J)) THEN + RCOND = RIVERCOND(I,J) * EXP(PEXP(I,J)*(WTD(I,J)-EQWTD(I,J))) + ELSE + RCOND = RIVERCOND(I,J) + ENDIF + QRF(I,J) = RCOND * (WTD(I,J)-RIVERBED(I,J)) * DELTAT/AREA(I,J) +!for now, dont allow it to go from river to groundwater + QRF(I,J) = MAX(QRF(I,J),0.) + ELSE + QRF(I,J) = 0. + ENDIF + ENDDO + ENDDO + + DO J=jts,jte + DO I=its,ite + IF(LANDMASK(I,J).GT.0)THEN + + BEXP = NoahmpIO%BEXP_TABLE (ISLTYP(I,J)) + DKSAT = NoahmpIO%DKSAT_TABLE (ISLTYP(I,J)) + PSISAT = -1.0*NoahmpIO%PSISAT_TABLE (ISLTYP(I,J)) + SMCMAX = NoahmpIO%SMCMAX_TABLE (ISLTYP(I,J)) + SMCWLT = NoahmpIO%SMCWLT_TABLE (ISLTYP(I,J)) + + IF(IVGTYP(I,J)==NoahmpIO%ISURBAN)THEN + SMCMAX = 0.45 + SMCWLT = 0.40 + ENDIF + +!for deep water table calculate recharge + IF(WTD(I,J) < ZSOIL(NSOIL)-DZS(NSOIL))THEN +!assume all liquid if the wtd is deep + DDZ = ZSOIL(NSOIL)-WTD(I,J) + SMCWTDMID = 0.5 * (SMCWTD(I,J) + SMCMAX ) + PSI = PSISAT * ( SMCMAX / SMCWTD(I,J) ) ** BEXP + WCNDDEEP = DKSAT * ( SMCWTDMID / SMCMAX ) ** (2.0*BEXP + 3.0) + WFLUXDEEP = - DELTAT * WCNDDEEP * ( (PSISAT-PSI) / DDZ - 1.) +!update deep soil moisture + SMCWTD(I,J) = SMCWTD(I,J) + (DEEPRECH(I,J) - WFLUXDEEP) / DDZ + WPLUS = MAX((SMCWTD(I,J)-SMCMAX), 0.0) * DDZ + WMINUS = MAX((1.E-4-SMCWTD(I,J)), 0.0) * DDZ + SMCWTD(I,J) = MAX( MIN(SMCWTD(I,J),SMCMAX) , 1.E-4) + WFLUXDEEP = WFLUXDEEP + WPLUS - WMINUS + DEEPRECH(I,J) = WFLUXDEEP + ENDIF + + +!Total water flux to or from groundwater in the cell + TOTWATER = QLAT(I,J) - QRF(I,J) + DEEPRECH(I,J) + + SMC(1:NSOIL) = SMOIS(I,1:NSOIL,J) + SH2O(1:NSOIL) = SH2OXY(I,1:NSOIL,J) + SMCEQ(1:NSOIL) = SMOISEQ(I,1:NSOIL,J) + +!Update the water table depth and soil moisture + CALL UPDATEWTD ( NSOIL, DZS , ZSOIL, SMCEQ, SMCMAX, SMCWLT, PSISAT, BEXP ,I , J , &!in + TOTWATER, WTD(I,J), SMC, SH2O, SMCWTD(I,J) , &!inout + QSPRING(I,J) ) !out + +!now update soil moisture + SMOIS(I,1:NSOIL,J) = SMC(1:NSOIL) + SH2OXY(I,1:NSOIL,J) = SH2O(1:NSOIL) + + ENDIF + ENDDO + ENDDO + +!accumulate fluxes for output + + DO J=jts,jte + DO I=its,ite + IF(LANDMASK(I,J).GT.0)THEN + QSLAT(I,J) = QSLAT(I,J) + QLAT(I,J)*1.E3 + QRFS(I,J) = QRFS(I,J) + QRF(I,J)*1.E3 + QSPRINGS(I,J) = QSPRINGS(I,J) + QSPRING(I,J)*1.E3 + RECH(I,J) = RECH(I,J) + DEEPRECH(I,J)*1.E3 +!zero out DEEPRECH + DEEPRECH(I,J) =0. + ENDIF + ENDDO + ENDDO + + end subroutine WTABLE_mmf_noahmp + + +! ================================================================================================== +! ---------------------------------------------------------------------- + subroutine LATERALFLOW (NoahmpIO, ISLTYP,WTD,QLAT,FDEPTH,TOPO,LANDMASK,DELTAT,AREA & + ,ids,ide,jds,jde,kds,kde & + ,ims,ime,jms,jme,kms,kme & + ,its,ite,jts,jte,kts,kte ) +! ---------------------------------------------------------------------- +! USE NOAHMP_TABLES, ONLY : DKSAT_TABLE + +#ifdef MPP_LAND + ! MPP_LAND only for HRLDAS Noah-MP/WRF-Hydro - Prasanth Valayamkunnath (06/10/2022) + use module_mpp_land, only: mpp_land_com_real, mpp_land_com_integer, global_nx, global_ny, my_id +#endif +! ---------------------------------------------------------------------- + IMPLICIT NONE +! ---------------------------------------------------------------------- +! input + + type(NoahmpIO_type), intent(in) :: NoahmpIO + + INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & + & ims,ime, jms,jme, kms,kme, & + & its,ite, jts,jte, kts,kte + REAL , INTENT(IN) :: DELTAT + INTEGER, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: ISLTYP, LANDMASK + REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: FDEPTH,WTD,TOPO,AREA + +!output + REAL, DIMENSION( ims:ime , jms:jme ), INTENT(OUT) :: QLAT + +!local + INTEGER :: I, J, itsh, iteh, jtsh, jteh, nx, ny + REAL :: Q, KLAT + +#ifdef MPP_LAND + ! halo'ed arrays + REAL, DIMENSION(ims-1:ime+1, jms-1:jme+1) :: KCELL, HEAD + integer, dimension(ims-1:ime+1, jms-1:jme+1) :: landmask_h + real, dimension(ims-1:ime+1, jms-1:jme+1) :: area_h, qlat_h +#else + REAL, DIMENSION(ims:ime, jms:jme) :: KCELL, HEAD +#endif + + REAL, DIMENSION(19) :: KLATFACTOR + DATA KLATFACTOR /2.,3.,4.,10.,10.,12.,14.,20.,24.,28.,40.,48.,2.,0.,10.,0.,20.,2.,2./ + + REAL, PARAMETER :: PI = 3.14159265 + REAL, PARAMETER :: FANGLE = 0.22754493 ! = 0.5*sqrt(0.5*tan(pi/8)) + +#ifdef MPP_LAND +! create halo'ed local copies of tile vars + landmask_h(ims:ime, jms:jme) = landmask + area_h(ims:ime, jms:jme) = area + + nx = ((ime-ims) + 1) + 2 ! include halos + ny = ((jme-jms) + 1) + 2 ! include halos + + !copy neighbor's values for landmask and area + call mpp_land_com_integer(landmask_h, nx, ny, 99) + call mpp_land_com_real(area_h, nx, ny, 99) + + itsh=max(its,1) + iteh=min(ite,global_nx) + jtsh=max(jts,1) + jteh=min(jte,global_ny) +#else + itsh=max(its-1,ids) + iteh=min(ite+1,ide-1) + jtsh=max(jts-1,jds) + jteh=min(jte+1,jde-1) +#endif + + DO J=jtsh,jteh + DO I=itsh,iteh + IF(FDEPTH(I,J).GT.0.)THEN + KLAT = NoahmpIO%DKSAT_TABLE(ISLTYP(I,J)) * KLATFACTOR(ISLTYP(I,J)) + IF(WTD(I,J) < -1.5)THEN + KCELL(I,J) = FDEPTH(I,J) * KLAT * EXP( (WTD(I,J) + 1.5) / FDEPTH(I,J) ) + ELSE + KCELL(I,J) = KLAT * ( WTD(I,J) + 1.5 + FDEPTH(I,J) ) + ENDIF + ELSE + KCELL(i,J) = 0. + ENDIF + + HEAD(I,J) = TOPO(I,J) + WTD(I,J) + ENDDO + ENDDO + +#ifdef MPP_LAND +! update neighbors with kcell/head/calculation + call mpp_land_com_real(KCELL, nx, ny, 99) + call mpp_land_com_real(HEAD, nx, ny, 99) + + itsh=max(its,2) + iteh=min(ite,global_nx-1) + jtsh=max(jts,2) + jteh=min(jte,global_ny-1) + + qlat_h = 0. +#else + itsh=max(its,ids+1) + iteh=min(ite,ide-2) + jtsh=max(jts,jds+1) + jteh=min(jte,jde-2) +#endif + + DO J=jtsh,jteh + DO I=itsh,iteh +#ifdef MPP_LAND + IF( landmask_h(I,J).GT.0 )THEN +#else + IF( LANDMASK(I,J).GT.0 )THEN +#endif + Q=0. + + Q = Q + (KCELL(I-1,J+1)+KCELL(I,J)) & + * (HEAD(I-1,J+1)-HEAD(I,J))/SQRT(2.) + + Q = Q + (KCELL(I-1,J)+KCELL(I,J)) & + * (HEAD(I-1,J)-HEAD(I,J)) + + Q = Q + (KCELL(I-1,J-1)+KCELL(I,J)) & + * (HEAD(I-1,J-1)-HEAD(I,J))/SQRT(2.) + + Q = Q + (KCELL(I,J+1)+KCELL(I,J)) & + * (HEAD(I,J+1)-HEAD(I,J)) + + Q = Q + (KCELL(I,J-1)+KCELL(I,J)) & + * (HEAD(I,J-1)-HEAD(I,J)) + + Q = Q + (KCELL(I+1,J+1)+KCELL(I,J)) & + * (HEAD(I+1,J+1)-HEAD(I,J))/SQRT(2.) + + Q = Q + (KCELL(I+1,J)+KCELL(I,J)) & + * (HEAD(I+1,J)-HEAD(I,J)) + + Q = Q + (KCELL(I+1,J-1)+KCELL(I,J)) & + * (HEAD(I+1,J-1)-HEAD(I,J))/SQRT(2.) + + ! Here, Q is in m3/s. To convert to m, divide it by area of the grid cell. +#ifdef MPP_LAND + qlat_h(I, J) = (FANGLE * Q * DELTAT / area_h(I, J)) +#else + QLAT(I,J) = FANGLE* Q * DELTAT / AREA(I,J) +#endif + ENDIF + ENDDO + ENDDO + +#ifdef MPP_LAND +! merge (sum) of all neighbor's edge Q's + call mpp_land_com_real(qlat_h, nx, ny, 1) + qlat = qlat_h(ims:ime, jms:jme) +#endif + + end subroutine LATERALFLOW + + +! ================================================================================================== +! ---------------------------------------------------------------------- + subroutine UPDATEWTD (NSOIL, DZS, ZSOIL ,SMCEQ ,& !in + SMCMAX, SMCWLT, PSISAT, BEXP ,ILOC ,JLOC ,& !in + TOTWATER, WTD ,SMC, SH2O ,SMCWTD ,& !inout + QSPRING ) !out +! ---------------------------------------------------------------------- + IMPLICIT NONE +! ---------------------------------------------------------------------- +! input + INTEGER, INTENT(IN) :: NSOIL !no. of soil layers + INTEGER, INTENT(IN) :: ILOC, JLOC + REAL, INTENT(IN) :: SMCMAX + REAL, INTENT(IN) :: SMCWLT + REAL, INTENT(IN) :: PSISAT + REAL, INTENT(IN) :: BEXP + REAL, DIMENSION( 0:NSOIL), INTENT(IN) :: ZSOIL !depth of soil layer-bottom [m] + REAL, DIMENSION( 1:NSOIL), INTENT(IN) :: SMCEQ !equilibrium soil water content [m3/m3] + REAL, DIMENSION( 1:NSOIL), INTENT(IN) :: DZS ! soil layer thickness [m] +! input-output + REAL , INTENT(INOUT) :: TOTWATER + REAL , INTENT(INOUT) :: WTD + REAL , INTENT(INOUT) :: SMCWTD + REAL, DIMENSION( 1:NSOIL), INTENT(INOUT) :: SMC + REAL, DIMENSION( 1:NSOIL), INTENT(INOUT) :: SH2O +! output + REAL , INTENT(OUT) :: QSPRING +!local + INTEGER :: K + INTEGER :: K1 + INTEGER :: IWTD + INTEGER :: KWTD + REAL :: MAXWATUP, MAXWATDW ,WTDOLD + REAL :: WGPMID + REAL :: SYIELDDW + REAL :: DZUP + REAL :: SMCEQDEEP + REAL, DIMENSION( 1:NSOIL) :: SICE +! ------------------------------------------------------------- + + + + QSPRING=0. + + SICE = SMC - SH2O + +iwtd=1 + +!case 1: totwater > 0 (water table going up): +IF(totwater.gt.0.)then + + + if(wtd.ge.zsoil(nsoil))then + + do k=nsoil-1,1,-1 + if(wtd.lt.zsoil(k))exit + enddo + iwtd=k + kwtd=iwtd+1 + +!max water that fits in the layer + maxwatup=dzs(kwtd)*(smcmax-smc(kwtd)) + + if(totwater.le.maxwatup)then + smc(kwtd) = smc(kwtd) + totwater / dzs(kwtd) + smc(kwtd) = min(smc(kwtd),smcmax) + if(smc(kwtd).gt.smceq(kwtd))wtd = min ( ( smc(kwtd)*dzs(kwtd) & + - smceq(kwtd)*zsoil(iwtd) + smcmax*zsoil(kwtd) ) / & + ( smcmax-smceq(kwtd) ) , zsoil(iwtd) ) + totwater=0. + else !water enough to saturate the layer + smc(kwtd) = smcmax + totwater=totwater-maxwatup + k1=iwtd + do k=k1,0,-1 + wtd = zsoil(k) + iwtd=k-1 + if(k.eq.0)exit + maxwatup=dzs(k)*(smcmax-smc(k)) + if(totwater.le.maxwatup)then + smc(k) = smc(k) + totwater / dzs(k) + smc(k) = min(smc(k),smcmax) + if(smc(k).gt.smceq(k))wtd = min ( ( smc(k)*dzs(k) & + - smceq(k)*zsoil(iwtd) + smcmax*zsoil(k) ) / & + ( smcmax-smceq(k) ) , zsoil(iwtd) ) + totwater=0. + exit + else + smc(k) = smcmax + totwater=totwater-maxwatup + endif + + enddo + + endif + + elseif(wtd.ge.zsoil(nsoil)-dzs(nsoil))then ! wtd below bottom of soil model + + !gmmequilibrium soil moisture content + smceqdeep = smcmax * ( psisat / & + (psisat - dzs(nsoil)) ) ** (1./bexp) +! smceqdeep = max(smceqdeep,smcwlt) + smceqdeep = max(smceqdeep,1.E-4) + + maxwatup=(smcmax-smcwtd)*dzs(nsoil) + + if(totwater.le.maxwatup)then + smcwtd = smcwtd + totwater / dzs(nsoil) + smcwtd = min(smcwtd,smcmax) + if(smcwtd.gt.smceqdeep)wtd = min( ( smcwtd*dzs(nsoil) & + - smceqdeep*zsoil(nsoil) + smcmax*(zsoil(nsoil)-dzs(nsoil)) ) / & + ( smcmax-smceqdeep ) , zsoil(nsoil) ) + totwater=0. + else + smcwtd=smcmax + totwater=totwater-maxwatup + do k=nsoil,0,-1 + wtd=zsoil(k) + iwtd=k-1 + if(k.eq.0)exit + maxwatup=dzs(k)*(smcmax-smc(k)) + if(totwater.le.maxwatup)then + smc(k) = min(smc(k) + totwater / dzs(k),smcmax) + if(smc(k).gt.smceq(k))wtd = min ( ( smc(k)*dzs(k) & + - smceq(k)*zsoil(iwtd) + smcmax*zsoil(k) ) / & + ( smcmax-smceq(k) ) , zsoil(iwtd) ) + totwater=0. + exit + else + smc(k) = smcmax + totwater=totwater-maxwatup + endif + enddo + endif + +!deep water table + else + + maxwatup=(smcmax-smcwtd)*(zsoil(nsoil)-dzs(nsoil)-wtd) + if(totwater.le.maxwatup)then + wtd = wtd + totwater/(smcmax-smcwtd) + totwater=0. + else + totwater=totwater-maxwatup + wtd=zsoil(nsoil)-dzs(nsoil) + maxwatup=(smcmax-smcwtd)*dzs(nsoil) + if(totwater.le.maxwatup)then + + !gmmequilibrium soil moisture content + smceqdeep = smcmax * ( psisat / & + (psisat - dzs(nsoil)) ) ** (1./bexp) +! smceqdeep = max(smceqdeep,smcwlt) + smceqdeep = max(smceqdeep,1.E-4) + + smcwtd = smcwtd + totwater / dzs(nsoil) + smcwtd = min(smcwtd,smcmax) + wtd = ( smcwtd*dzs(nsoil) & + - smceqdeep*zsoil(nsoil) + smcmax*(zsoil(nsoil)-dzs(nsoil)) ) / & + ( smcmax-smceqdeep ) + totwater=0. + else + smcwtd=smcmax + totwater=totwater-maxwatup + do k=nsoil,0,-1 + wtd=zsoil(k) + iwtd=k-1 + if(k.eq.0)exit + maxwatup=dzs(k)*(smcmax-smc(k)) + + if(totwater.le.maxwatup)then + smc(k) = smc(k) + totwater / dzs(k) + smc(k) = min(smc(k),smcmax) + if(smc(k).gt.smceq(k))wtd = ( smc(k)*dzs(k) & + - smceq(k)*zsoil(iwtd) + smcmax*zsoil(k) ) / & + ( smcmax-smceq(k) ) + totwater=0. + exit + else + smc(k) = smcmax + totwater=totwater-maxwatup + endif + enddo + endif + endif + endif + +!water springing at the surface + qspring=totwater + +!case 2: totwater < 0 (water table going down): +ELSEIF(totwater.lt.0.)then + + + if(wtd.ge.zsoil(nsoil))then !wtd in the resolved layers + + do k=nsoil-1,1,-1 + if(wtd.lt.zsoil(k))exit + enddo + iwtd=k + + k1=iwtd+1 + do kwtd=k1,nsoil + +!max water that the layer can yield + maxwatdw=dzs(kwtd)*(smc(kwtd)-max(smceq(kwtd),sice(kwtd))) + + if(-totwater.le.maxwatdw)then + smc(kwtd) = smc(kwtd) + totwater / dzs(kwtd) + if(smc(kwtd).gt.smceq(kwtd))then + wtd = ( smc(kwtd)*dzs(kwtd) & + - smceq(kwtd)*zsoil(iwtd) + smcmax*zsoil(kwtd) ) / & + ( smcmax-smceq(kwtd) ) + else + wtd=zsoil(kwtd) + iwtd=iwtd+1 + endif + totwater=0. + exit + else + wtd = zsoil(kwtd) + iwtd=iwtd+1 + if(maxwatdw.ge.0.)then + smc(kwtd) = smc(kwtd) + maxwatdw / dzs(kwtd) + totwater = totwater + maxwatdw + endif + endif + + enddo + + if(iwtd.eq.nsoil.and.totwater.lt.0.)then + !gmmequilibrium soil moisture content + smceqdeep = smcmax * ( psisat / & + (psisat - dzs(nsoil)) ) ** (1./bexp) +! smceqdeep = max(smceqdeep,smcwlt) + smceqdeep = max(smceqdeep,1.E-4) + + maxwatdw=dzs(nsoil)*(smcwtd-smceqdeep) + + if(-totwater.le.maxwatdw)then + + smcwtd = smcwtd + totwater / dzs(nsoil) + wtd = max( ( smcwtd*dzs(nsoil) & + - smceqdeep*zsoil(nsoil) + smcmax*(zsoil(nsoil)-dzs(nsoil)) ) / & + ( smcmax-smceqdeep ) , zsoil(nsoil)-dzs(nsoil) ) + + else + + wtd=zsoil(nsoil)-dzs(nsoil) + smcwtd = smcwtd + totwater / dzs(nsoil) +!and now even further down + dzup=(smceqdeep-smcwtd)*dzs(nsoil)/(smcmax-smceqdeep) + wtd=wtd-dzup + smcwtd=smceqdeep + + endif + + endif + + + + elseif(wtd.ge.zsoil(nsoil)-dzs(nsoil))then + +!if wtd was already below the bottom of the resolved soil crust + !gmmequilibrium soil moisture content + smceqdeep = smcmax * ( psisat / & + (psisat - dzs(nsoil)) ) ** (1./bexp) +! smceqdeep = max(smceqdeep,smcwlt) + smceqdeep = max(smceqdeep,1.E-4) + + maxwatdw=dzs(nsoil)*(smcwtd-smceqdeep) + + if(-totwater.le.maxwatdw)then + + smcwtd = smcwtd + totwater / dzs(nsoil) + wtd = max( ( smcwtd*dzs(nsoil) & + - smceqdeep*zsoil(nsoil) + smcmax*(zsoil(nsoil)-dzs(nsoil)) ) / & + ( smcmax-smceqdeep ) , zsoil(nsoil)-dzs(nsoil) ) + + else + + wtd=zsoil(nsoil)-dzs(nsoil) + smcwtd = smcwtd + totwater / dzs(nsoil) +!and now even further down + dzup=(smceqdeep-smcwtd)*dzs(nsoil)/(smcmax-smceqdeep) + wtd=wtd-dzup + smcwtd=smceqdeep + + endif + + else +!gmmequilibrium soil moisture content + wgpmid = smcmax * ( psisat / & + (psisat - (zsoil(nsoil)-wtd)) ) ** (1./bexp) +! wgpmid=max(wgpmid,smcwlt) + wgpmid=max(wgpmid,1.E-4) + syielddw=smcmax-wgpmid + wtdold=wtd + wtd = wtdold + totwater/syielddw +!update wtdwgp + smcwtd = (smcwtd*(zsoil(nsoil)-wtdold)+wgpmid*(wtdold-wtd) ) / (zsoil(nsoil)-wtd) + + endif + + qspring=0. + +ENDIF + + SH2O = SMC - SICE + + + end subroutine UPDATEWTD + +! ---------------------------------------------------------------------- + +END MODULE GroundWaterMmfMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/GroundWaterTopModelMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/GroundWaterTopModelMod.F90 new file mode 100644 index 000000000..5e67f648b --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/GroundWaterTopModelMod.F90 @@ -0,0 +1,216 @@ +module GroundWaterTopModelMod + +!!! Compute groundwater flow and subsurface runoff based on TOPMODEL (Niu et al., 2007) + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine GroundWaterTopModel(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: GROUNDWATER +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: LoopInd ! loop index + integer :: IndUnsatSoil ! layer index of the first unsaturated layer + real(kind=8) :: SatDegUnsatSoil ! degree of saturation of IndUnsatSoil layer + real(kind=kind_noahmp) :: SoilMatPotFrz ! soil matric potential (frozen effects) [mm] + real(kind=kind_noahmp) :: AquiferWatConduct ! aquifer hydraulic conductivity [mm/s] + real(kind=kind_noahmp) :: WaterHeadTbl ! water head at water table [mm] + real(kind=kind_noahmp) :: WaterHead ! water head at layer above water table [mm] + real(kind=kind_noahmp) :: WaterFillPore ! water used to fill air pore [mm] + real(kind=kind_noahmp) :: WatConductAcc ! sum of SoilWatConductTmp*ThicknessSoil + real(kind=kind_noahmp) :: SoilMoistureMin ! minimum soil moisture [m3/m3] + real(kind=kind_noahmp) :: WaterExcessSat ! excessive water above saturation [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: ThicknessSoil ! layer thickness [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: DepthSoilMid ! node depth [m] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilLiqTmp ! liquid water mass [kg/m2 or mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilEffPorosity ! soil effective porosity + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilWatConductTmp ! hydraulic conductivity [mm/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilMoisture ! total soil water content [m3/m3] + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + SoilTimeStep => noahmp%config%domain%SoilTimeStep ,& ! in, noahmp soil timestep [s] + DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth of soil layer-bottom [m] + SoilImpervFracMax => noahmp%water%state%SoilImpervFracMax ,& ! in, maximum soil imperviousness fraction + SoilIce => noahmp%water%state%SoilIce ,& ! in, soil ice content [m3/m3] + SoilWatConductivity => noahmp%water%state%SoilWatConductivity ,& ! in, soil hydraulic conductivity [m/s] + SoilMoistureSat => noahmp%water%param%SoilMoistureSat ,& ! in, saturated value of soil moisture [m3/m3] + GridTopoIndex => noahmp%water%param%GridTopoIndex ,& ! in, gridcell mean topgraphic index (global mean) + SoilMatPotentialSat => noahmp%water%param%SoilMatPotentialSat ,& ! in, saturated soil matric potential + SoilExpCoeffB => noahmp%water%param%SoilExpCoeffB ,& ! in, soil B parameter + SpecYieldGw => noahmp%water%param%SpecYieldGw ,& ! in, specific yield [-], default:0.2 + MicroPoreContent => noahmp%water%param%MicroPoreContent ,& ! in, microprore content (0.0-1.0), default:0.2 + SoilWatConductivitySat => noahmp%water%param%SoilWatConductivitySat ,& ! in, saturated soil hydraulic conductivity [m/s] + SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! inout, soil water content [m3/m3] + WaterTableDepth => noahmp%water%state%WaterTableDepth ,& ! inout, water table depth [m] + WaterStorageAquifer => noahmp%water%state%WaterStorageAquifer ,& ! inout, water storage in aquifer [mm] + WaterStorageSoilAqf => noahmp%water%state%WaterStorageSoilAqf ,& ! inout, water storage in aquifer + saturated soil [mm] + RunoffDecayFac => noahmp%water%param%RunoffDecayFac ,& ! inout, runoff decay factor (1/m) + BaseflowCoeff => noahmp%water%param%BaseflowCoeff ,& ! inout, baseflow coefficient [mm/s] + RechargeGw => noahmp%water%flux%RechargeGw ,& ! out, groundwater recharge rate [mm/s] + DischargeGw => noahmp%water%flux%DischargeGw & ! out, groundwater discharge rate [mm/s] + ) +! ---------------------------------------------------------------------- + + ! initialization + if (.not. allocated(DepthSoilMid) ) allocate(DepthSoilMid (1:NumSoilLayer)) + if (.not. allocated(ThicknessSoil) ) allocate(ThicknessSoil (1:NumSoilLayer)) + if (.not. allocated(SoilLiqTmp) ) allocate(SoilLiqTmp (1:NumSoilLayer)) + if (.not. allocated(SoilEffPorosity) ) allocate(SoilEffPorosity (1:NumSoilLayer)) + if (.not. allocated(SoilWatConductTmp)) allocate(SoilWatConductTmp(1:NumSoilLayer)) + if (.not. allocated(SoilMoisture) ) allocate(SoilMoisture (1:NumSoilLayer)) + DepthSoilMid = 0.0 + ThicknessSoil = 0.0 + SoilLiqTmp = 0.0 + SoilEffPorosity = 0.0 + SoilWatConductTmp = 0.0 + SoilMoisture = 0.0 + DischargeGw = 0.0 + RechargeGw = 0.0 + + ! Derive layer-bottom depth in [mm]; KWM:Derive layer thickness in mm + ThicknessSoil(1) = -DepthSoilLayer(1) * 1.0e3 + do LoopInd = 2, NumSoilLayer + ThicknessSoil(LoopInd) = 1.0e3 * (DepthSoilLayer(LoopInd-1) - DepthSoilLayer(LoopInd)) + enddo + + ! Derive node (middle) depth in [m]; KWM: Positive number, depth below ground surface in m + DepthSoilMid(1) = -DepthSoilLayer(1) / 2.0 + do LoopInd = 2, NumSoilLayer + DepthSoilMid(LoopInd) = -DepthSoilLayer(LoopInd-1) + & + 0.5 * (DepthSoilLayer(LoopInd-1) - DepthSoilLayer(LoopInd)) + enddo + + ! Convert volumetric soil moisture to mass + do LoopInd = 1, NumSoilLayer + SoilMoisture(LoopInd) = SoilLiqWater(LoopInd) + SoilIce(LoopInd) + SoilLiqTmp(LoopInd) = SoilLiqWater(LoopInd) * ThicknessSoil(LoopInd) + SoilEffPorosity(LoopInd) = max(0.01, SoilMoistureSat(LoopInd)-SoilIce(LoopInd)) + SoilWatConductTmp(LoopInd) = 1.0e3 * SoilWatConductivity(LoopInd) + enddo + + ! The layer index of the first unsaturated layer (the layer right above the water table) + IndUnsatSoil = NumSoilLayer + do LoopInd = 2, NumSoilLayer + if ( WaterTableDepth <= -DepthSoilLayer(LoopInd) ) then + IndUnsatSoil = LoopInd - 1 + exit + endif + enddo + + ! Groundwater discharge [mm/s] + !RunoffDecayFac = 6.0 + !BaseflowCoeff = 5.0 + !DischargeGw = (1.0 - SoilImpervFracMax) * BaseflowCoeff * & + ! exp(-GridTopoIndex) * exp(-RunoffDecayFac * (WaterTableDepth-2.0)) + ! Update from GY Niu 2022 + RunoffDecayFac = SoilExpCoeffB(IndUnsatSoil) / 3.0 + BaseflowCoeff = SoilWatConductTmp(IndUnsatSoil) * 1.0e3 * exp(3.0) ! [mm/s] + DischargeGw = (1.0 - SoilImpervFracMax) * BaseflowCoeff * exp(-GridTopoIndex) * & + exp(-RunoffDecayFac * WaterTableDepth) + + ! Matric potential at the layer above the water table + SatDegUnsatSoil = min(1.0, SoilMoisture(IndUnsatSoil)/SoilMoistureSat(IndUnsatSoil)) + SatDegUnsatSoil = max(SatDegUnsatSoil, real(0.01,kind=8)) + SoilMatPotFrz = -SoilMatPotentialSat(IndUnsatSoil) * 1000.0 * & + SatDegUnsatSoil**(-SoilExpCoeffB(IndUnsatSoil)) ! m -> mm + SoilMatPotFrz = max(-120000.0, MicroPoreContent*SoilMatPotFrz) + + ! Recharge rate qin to groundwater + !AquiferWatConduct = SoilWatConductTmp(IndUnsatSoil) + AquiferWatConduct = 2.0 * (SoilWatConductTmp(IndUnsatSoil) * SoilWatConductivitySat(IndUnsatSoil)*1.0e3) / & + (SoilWatConductTmp(IndUnsatSoil) + SoilWatConductivitySat(IndUnsatSoil)*1.0e3) ! harmonic average, GY Niu's update 2022 + WaterHeadTbl = -WaterTableDepth * 1.0e3 !(mm) + WaterHead = SoilMatPotFrz - DepthSoilMid(IndUnsatSoil) * 1.0e3 !(mm) + RechargeGw = -AquiferWatConduct * (WaterHeadTbl - WaterHead) / & + ((WaterTableDepth-DepthSoilMid(IndUnsatSoil)) * 1.0e3) + RechargeGw = max(-10.0/SoilTimeStep, min(10.0/SoilTimeStep, RechargeGw)) + + ! Water storage in the aquifer + saturated soil + WaterStorageSoilAqf = WaterStorageSoilAqf + (RechargeGw - DischargeGw) * SoilTimeStep !(mm) + if ( IndUnsatSoil == NumSoilLayer ) then + WaterStorageAquifer = WaterStorageAquifer + (RechargeGw - DischargeGw) * SoilTimeStep !(mm) + WaterStorageSoilAqf = WaterStorageAquifer + WaterTableDepth = (-DepthSoilLayer(NumSoilLayer) + 25.0) - & + WaterStorageAquifer / 1000.0 / SpecYieldGw !(m) + SoilLiqTmp(NumSoilLayer) = SoilLiqTmp(NumSoilLayer) - RechargeGw * SoilTimeStep ! [mm] + SoilLiqTmp(NumSoilLayer) = SoilLiqTmp(NumSoilLayer) + max(0.0, (WaterStorageAquifer-5000.0)) + WaterStorageAquifer = min(WaterStorageAquifer, 5000.0) + else + if ( IndUnsatSoil == NumSoilLayer-1 ) then + WaterTableDepth = -DepthSoilLayer(NumSoilLayer) - (WaterStorageSoilAqf - SpecYieldGw*1000.0*25.0) / & + (SoilEffPorosity(NumSoilLayer)) / 1000.0 + else + WaterFillPore = 0.0 ! water used to fill soil air pores + do LoopInd = IndUnsatSoil+2, NumSoilLayer + WaterFillPore = WaterFillPore + SoilEffPorosity(LoopInd) * ThicknessSoil(LoopInd) + enddo + WaterTableDepth = -DepthSoilLayer(IndUnsatSoil+1) - (WaterStorageSoilAqf - SpecYieldGw*1000.0*25.0 - & + WaterFillPore) / (SoilEffPorosity(IndUnsatSoil+1)) / 1000.0 + endif + WatConductAcc = 0.0 + do LoopInd = 1, NumSoilLayer + WatConductAcc = WatConductAcc + SoilWatConductTmp(LoopInd) * ThicknessSoil(LoopInd) + enddo + do LoopInd = 1, NumSoilLayer ! Removing subsurface runoff + SoilLiqTmp(LoopInd) = SoilLiqTmp(LoopInd) - DischargeGw * SoilTimeStep * & + SoilWatConductTmp(LoopInd) * ThicknessSoil(LoopInd) / WatConductAcc + enddo + endif + WaterTableDepth = max(1.5, WaterTableDepth) + + ! Limit SoilLiqTmp to be greater than or equal to SoilMoistureMin + ! Get water needed to bring SoilLiqTmp equal SoilMoistureMin from lower layer. + SoilMoistureMin = 0.01 + do LoopInd = 1, NumSoilLayer-1 + if ( SoilLiqTmp(LoopInd) < 0.0 ) then + WaterExcessSat = SoilMoistureMin - SoilLiqTmp(LoopInd) + else + WaterExcessSat = 0.0 + endif + SoilLiqTmp(LoopInd ) = SoilLiqTmp(LoopInd ) + WaterExcessSat + SoilLiqTmp(LoopInd+1) = SoilLiqTmp(LoopInd+1) - WaterExcessSat + enddo + LoopInd = NumSoilLayer + if ( SoilLiqTmp(LoopInd) < SoilMoistureMin ) then + WaterExcessSat = SoilMoistureMin - SoilLiqTmp(LoopInd) + else + WaterExcessSat = 0.0 + endif + SoilLiqTmp(LoopInd) = SoilLiqTmp(LoopInd) + WaterExcessSat + WaterStorageAquifer = WaterStorageAquifer - WaterExcessSat + WaterStorageSoilAqf = WaterStorageSoilAqf - WaterExcessSat + + ! update soil moisture + do LoopInd = 1, NumSoilLayer + SoilLiqWater(LoopInd) = SoilLiqTmp(LoopInd) / ThicknessSoil(LoopInd) + enddo + + ! deallocate local arrays to avoid memory leaks + deallocate(DepthSoilMid ) + deallocate(ThicknessSoil ) + deallocate(SoilLiqTmp ) + deallocate(SoilEffPorosity ) + deallocate(SoilWatConductTmp) + deallocate(SoilMoisture ) + + end associate + + end subroutine GroundWaterTopModel + +end module GroundWaterTopModelMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/HumiditySaturationMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/HumiditySaturationMod.F90 new file mode 100644 index 000000000..8a912d199 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/HumiditySaturationMod.F90 @@ -0,0 +1,63 @@ +module HumiditySaturationMod + +!!! Compute saturated surface specific humidity and changing rate to temperature + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine HumiditySaturation(TemperatureAir, PressureAir, MixingRatioSat, MixingRatioSatTempD) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: CALHUM +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + real(kind=kind_noahmp), intent(in) :: TemperatureAir ! air temperature (K) + real(kind=kind_noahmp), intent(in) :: PressureAir ! air pressure (pa) + real(kind=kind_noahmp), intent(out) :: MixingRatioSat ! saturated mixing ratio (g/g) + real(kind=kind_noahmp), intent(out) :: MixingRatioSatTempD ! d(MixingRatioSat)/d(T) + +! local variable + real(kind=kind_noahmp), parameter :: Const1 = 17.67 ! constant 1 + real(kind=kind_noahmp), parameter :: TemperatureFrz = 273.15 ! freezing temperature 0degC [K] + real(kind=kind_noahmp), parameter :: Const2 = 29.65 ! constant 2 + real(kind=kind_noahmp), parameter :: ConstLatHeatVap = 2.501e6 ! latent heat of vaporization [J/kg] + real(kind=kind_noahmp), parameter :: Const3 = Const1*(TemperatureFrz-Const2) ! constant 3 + real(kind=kind_noahmp), parameter :: VapPresSatFrz = 0.611 ! vapor pressure at 0 degC [Pa] + real(kind=kind_noahmp), parameter :: GasConstWatVap = 461.0 ! specific gas constant for water vapor [J/kg/K] + real(kind=kind_noahmp), parameter :: RatioGasConst = 0.622 ! ratio of gas constant of dry air to water vapor + real(kind=kind_noahmp) :: VapPresSatTemp ! saturated vapor pressure at air temperature [Pa] + real(kind=kind_noahmp) :: PressureAirKpa ! air pressure in KPa unit + +! ---------------------------------------------------------------------- + + ! calculated saturated vapor pressure at air temperature + VapPresSatTemp = VapPresSatFrz * exp(ConstLatHeatVap / GasConstWatVap * & + (1.0/TemperatureFrz - 1.0/TemperatureAir)) + + ! convert PressureAir from Pa to KPa + PressureAirKpa = PressureAir * 1.0e-3 + + ! calculate saturated mixing ratio + MixingRatioSat = RatioGasConst * VapPresSatTemp / (PressureAirKpa - VapPresSatTemp) + + ! convert from g/g to g/kg + MixingRatioSat = MixingRatioSat * 1.0e3 + + ! MixingRatioSatTempD is calculated assuming MixingRatioSat is a specific humidity + MixingRatioSatTempD = (MixingRatioSat / (1+MixingRatioSat)) * Const3 / (TemperatureAir-Const2)**2 + + ! MixingRatioSat needs to be in g/g when returned for surface flux calculation + MixingRatioSat = MixingRatioSat / 1.0e3 + + end subroutine HumiditySaturation + +end module HumiditySaturationMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/IrrigationFloodMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/IrrigationFloodMod.F90 new file mode 100644 index 000000000..9ef7b7ad6 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/IrrigationFloodMod.F90 @@ -0,0 +1,70 @@ +module IrrigationFloodMod + +!!! Estimate irrigation water depth (m) based on surface flooding irrigation method +!!! Reference: chapter 4 of NRCS, Part 623 National Engineering Handbook +!!! Irrigation water is applied on the surface based on present soil moisture and +!!! infiltration rate of the soil. Flooding or overland flow is based on infiltration excess + + use Machine + use NoahmpVarType + use ConstantDefineMod + use IrrigationInfilPhilipMod, only : IrrigationInfilPhilip + + implicit none + +contains + + subroutine IrrigationFlood(noahmp) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: FLOOD_IRRIGATION +! Original code: P. Valayamkunnath (NCAR) (08/06/2020) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + real(kind=kind_noahmp) :: InfilRateSfc ! surface infiltration rate [m/s] + +! -------------------------------------------------------------------- + associate( & + SoilTimeStep => noahmp%config%domain%SoilTimeStep ,& ! in, noahmp soil time step [s] + NumSoilTimeStep => noahmp%config%domain%NumSoilTimeStep ,& ! in, number of time step for calculating soil processes + IrriFloodRateFac => noahmp%water%param%IrriFloodRateFac ,& ! in, flood application rate factor + IrrigationFracFlood => noahmp%water%state%IrrigationFracFlood ,& ! in, fraction of grid under flood irrigation (0 to 1) + IrrigationAmtFlood => noahmp%water%state%IrrigationAmtFlood ,& ! inout, flood irrigation water amount [m] + SoilSfcInflowAcc => noahmp%water%flux%SoilSfcInflowAcc ,& ! inout, accumulated water flux into soil during soil timestep [m/s * dt_soil/dt_main] + IrrigationRateFlood => noahmp%water%flux%IrrigationRateFlood & ! inout, flood irrigation water rate [m/timestep] + ) +! ---------------------------------------------------------------------- + + ! initialize local variables + InfilRateSfc = 0.0 + + ! estimate infiltration rate based on Philips Eq. + call IrrigationInfilPhilip(noahmp, SoilTimeStep, InfilRateSfc) + + ! irrigation rate of flood irrigation. It should be + ! greater than infiltration rate to get infiltration + ! excess runoff at the time of application + IrrigationRateFlood = InfilRateSfc * SoilTimeStep * IrriFloodRateFac ! Limit irrigation rate to fac*infiltration rate + IrrigationRateFlood = IrrigationRateFlood * IrrigationFracFlood + + if ( IrrigationRateFlood >= IrrigationAmtFlood ) then + IrrigationRateFlood = IrrigationAmtFlood + IrrigationAmtFlood = 0.0 + else + IrrigationAmtFlood = IrrigationAmtFlood - IrrigationRateFlood + endif + + ! update water flux going to surface soil + SoilSfcInflowAcc = SoilSfcInflowAcc + (IrrigationRateFlood / SoilTimeStep * NumSoilTimeStep) ! [m/s * dt_soil/dt_main] + + end associate + + end subroutine IrrigationFlood + +end module IrrigationFloodMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/IrrigationInfilPhilipMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/IrrigationInfilPhilipMod.F90 new file mode 100644 index 000000000..49ef88846 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/IrrigationInfilPhilipMod.F90 @@ -0,0 +1,86 @@ +module IrrigationInfilPhilipMod + +!!! Estimate infiltration rate based on Philip's two parameter equation +!!! Reference: Eq.2 in Valiantzas (2010): New linearized two-parameter infiltration equation for direct +!!! determination of conductivity and sorptivity, J. Hydrology. + + use Machine + use NoahmpVarType + use ConstantDefineMod + use SoilHydraulicPropertyMod, only : SoilDiffusivityConductivityOpt2 + + implicit none + +contains + + subroutine IrrigationInfilPhilip(noahmp, TimeStep, InfilRateSfc) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: IRR_PHILIP_INFIL +! Original code: P. Valayamkunnath (NCAR) (08/06/2020) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! IN & OUT variables + type(noahmp_type) , intent(inout) :: noahmp + real(kind=kind_noahmp), intent(in) :: TimeStep ! time step [s] + real(kind=kind_noahmp), intent(out) :: InfilRateSfc ! surface infiltration rate [m/s] + +! local variables + integer :: LoopInd ! loop indices + integer :: IndSoilLayer ! soil layer index + real(kind=kind_noahmp) :: SoilSorptivity ! sorptivity [m s^-1/2] + real(kind=kind_noahmp) :: SoilWatConductInit ! intial hydraulic conductivity [m/s] + real(kind=kind_noahmp) :: SoilWatConductivity ! soil water conductivity [m/s] + real(kind=kind_noahmp) :: SoilWatDiffusivity ! soil water diffusivity [m2/s] + real(kind=kind_noahmp) :: SoilIceMaxTmp ! maximum soil ice content [m3/m3] + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! in, total soil moisture [m3/m3] + SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! in, soil water content [m3/m3] + SoilIce => noahmp%water%state%SoilIce ,& ! in, soil ice content [m3/m3] + SoilMoistureSat => noahmp%water%param%SoilMoistureSat ,& ! in, saturated value of soil moisture [m3/m3] + SoilWatDiffusivitySat => noahmp%water%param%SoilWatDiffusivitySat ,& ! in, saturated soil hydraulic diffusivity [m2/s] + SoilWatConductivitySat => noahmp%water%param%SoilWatConductivitySat & ! in, saturated soil hydraulic conductivity [m/s] + ) +! ---------------------------------------------------------------------- + + ! initialize out-only and local variables + SoilWatConductivity = 0.0 + SoilWatDiffusivity = 0.0 + SoilIceMaxTmp = 0.0 + SoilSorptivity = 0.0 + SoilWatConductInit = 0.0 + + ! maximum ice fraction + do LoopInd = 1, NumSoilLayer + if ( SoilIce(LoopInd) > SoilIceMaxTmp ) SoilIceMaxTmp = SoilIce(LoopInd) + enddo + + ! estimate initial soil hydraulic conductivty and diffusivity (Ki, D(theta) in the equation) + IndSoilLayer = 1 + call SoilDiffusivityConductivityOpt2(noahmp, SoilWatDiffusivity, SoilWatConductivity, & + SoilLiqWater(IndSoilLayer), SoilIceMaxTmp, IndSoilLayer) + + ! sorptivity based on Eq. 10b from Kutilek, Miroslav, and Jana Valentova (1986) + ! sorptivity approximations. Transport in Porous Media 1.1, 57-62. + SoilSorptivity = sqrt(2.0 * max(0.0, (SoilMoistureSat(IndSoilLayer) - SoilMoisture(IndSoilLayer))) * & + (SoilWatDiffusivitySat(IndSoilLayer) - SoilWatDiffusivity)) + + ! parameter A in Eq. 9 of Valiantzas (2010) is given by + SoilWatConductInit = min(SoilWatConductivity, (2.0/3.0) * SoilWatConductivitySat(IndSoilLayer)) + SoilWatConductInit = max(SoilWatConductInit , (1.0/3.0) * SoilWatConductivitySat(IndSoilLayer)) + + ! maximun infiltration rate, m/s + InfilRateSfc = 0.5 * SoilSorptivity * (TimeStep**(-0.5)) + SoilWatConductInit ! m/s + InfilRateSfc = max(0.0, InfilRateSfc) + + end associate + + end subroutine IrrigationInfilPhilip + +end module IrrigationInfilPhilipMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/IrrigationMicroMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/IrrigationMicroMod.F90 new file mode 100644 index 000000000..d115e8b35 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/IrrigationMicroMod.F90 @@ -0,0 +1,73 @@ +module IrrigationMicroMod + +!!! Estimate irrigation water depth (m) based on Micro irrigation method +!!! Reference: chapter 7 of NRCS, Part 623 National Engineering Handbook +!!! Irrigation water is applied under the canopy, within first layer +!!! (at ~5 cm depth) considering current soil moisture + + use Machine + use NoahmpVarType + use ConstantDefineMod + use IrrigationInfilPhilipMod, only : IrrigationInfilPhilip + + implicit none + +contains + + subroutine IrrigationMicro(noahmp) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: MICRO_IRRIGATION +! Original code: P. Valayamkunnath (NCAR) (08/06/2020) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + real(kind=kind_noahmp) :: InfilRateSfc ! surface infiltration rate [m/s] + real(kind=kind_noahmp) :: IrriRateTmp ! temporary micro irrigation rate [m/timestep] + +! -------------------------------------------------------------------- + associate( & + SoilTimeStep => noahmp%config%domain%SoilTimeStep ,& ! in, noahmp soil time step [s] + DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth [m] of layer-bottom from soil surface + IrrigationFracMicro => noahmp%water%state%IrrigationFracMicro ,& ! in, fraction of grid under micro irrigation (0 to 1) + IrriMicroRate => noahmp%water%param%IrriMicroRate ,& ! in, micro irrigation rate [mm/hr] + SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! inout, soil water content [m3/m3] + IrrigationAmtMicro => noahmp%water%state%IrrigationAmtMicro ,& ! inout, micro irrigation water amount [m] + IrrigationRateMicro => noahmp%water%flux%IrrigationRateMicro & ! inout, micro irrigation water rate [m/timestep] + ) +! ---------------------------------------------------------------------- + + ! initialize local variables + InfilRateSfc = 0.0 + IrriRateTmp = 0.0 + + ! estimate infiltration rate based on Philips Eq. + call IrrigationInfilPhilip(noahmp, SoilTimeStep, InfilRateSfc) + + ! irrigation rate of micro irrigation + IrriRateTmp = IrriMicroRate * (1.0/1000.0) * SoilTimeStep/ 3600.0 ! NRCS rate/time step - calibratable + IrrigationRateMicro = min(0.5*InfilRateSfc*SoilTimeStep, IrrigationAmtMicro, IrriRateTmp) ! Limit irrigation rate to minimum of 0.5*infiltration rate + ! and to the NRCS recommended rate, (m) + IrrigationRateMicro = IrrigationRateMicro * IrrigationFracMicro + + if ( IrrigationRateMicro >= IrrigationAmtMicro ) then + IrrigationRateMicro = IrrigationAmtMicro + IrrigationAmtMicro = 0.0 + else + IrrigationAmtMicro = IrrigationAmtMicro - IrrigationRateMicro + endif + + ! update soil moisture + ! we implement drip in first layer of the Noah-MP. Change layer 1 moisture wrt to irrigation rate + SoilLiqWater(1) = SoilLiqWater(1) + (IrrigationRateMicro / (-1.0*DepthSoilLayer(1))) + + end associate + + end subroutine IrrigationMicro + +end module IrrigationMicroMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/IrrigationPrepareMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/IrrigationPrepareMod.F90 new file mode 100644 index 000000000..108bbe68d --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/IrrigationPrepareMod.F90 @@ -0,0 +1,99 @@ +module IrrigationPrepareMod + +!!! Prepare dynamic irrigation variables and trigger irrigation based on conditions + + use Machine + use NoahmpVarType + use ConstantDefineMod + use IrrigationTriggerMod, only : IrrigationTrigger + + implicit none + +contains + + subroutine IrrigationPrepare(noahmp) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: None (embedded in NOAHMP_SFLX +! Original code: P. Valayamkunnath (NCAR) (08/06/2020) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + +! ---------------------------------------------------------------------- + associate( & + LandUseDataName => noahmp%config%domain%LandUseDataName ,& ! in, landuse data name (USGS or MODIS_IGBP) + VegType => noahmp%config%domain%VegType ,& ! in, vegetation type + FlagSoilProcess => noahmp%config%domain%FlagSoilProcess ,& ! in, flag to calculate soil processes + OptIrrigationMethod => noahmp%config%nmlist%OptIrrigationMethod ,& ! in, irrigation method option + IrriFracThreshold => noahmp%water%param%IrriFracThreshold ,& ! in, irrigation fraction threshold + IrriStopPrecipThr => noahmp%water%param%IrriStopPrecipThr ,& ! in, maximum precipitation to stop irrigation trigger + IrrigationFracGrid => noahmp%water%state%IrrigationFracGrid ,& ! in, total input irrigation fraction of a grid + IrrigationAmtSprinkler => noahmp%water%state%IrrigationAmtSprinkler ,& ! inout, irrigation water amount [m] to be applied, Sprinkler + IrrigationAmtFlood => noahmp%water%state%IrrigationAmtFlood ,& ! inout, flood irrigation water amount [m] + IrrigationAmtMicro => noahmp%water%state%IrrigationAmtMicro ,& ! inout, micro irrigation water amount [m] + RainfallRefHeight => noahmp%water%flux%RainfallRefHeight ,& ! inout, rainfall [mm/s] at reference height + FlagCropland => noahmp%config%domain%FlagCropland ,& ! out, flag to identify croplands + IrrigationFracSprinkler => noahmp%water%state%IrrigationFracSprinkler ,& ! out, sprinkler irrigation fraction (0 to 1) + IrrigationFracMicro => noahmp%water%state%IrrigationFracMicro ,& ! out, fraction of grid under micro irrigation (0 to 1) + IrrigationFracFlood => noahmp%water%state%IrrigationFracFlood & ! out, fraction of grid under flood irrigation (0 to 1) + ) +! ---------------------------------------------------------------------- + + ! initialize + FlagCropland = .false. + + ! determine cropland + if ( trim(LandUseDataName) == "USGS" ) then + if ( (VegType >= 3) .and. (VegType <= 6) ) FlagCropland = .true. + elseif ( trim(LandUseDataName) == "MODIFIED_IGBP_MODIS_NOAH") then + if ( (VegType == 12) .or. (VegType == 14) ) FlagCropland = .true. + endif + + ! if OptIrrigationMethod = 0 and if methods are unknown for certain area, then use sprinkler irrigation method + if ( (OptIrrigationMethod == 0) .and. (IrrigationFracSprinkler == 0.0) .and. (IrrigationFracMicro == 0.0) & + .and. (IrrigationFracFlood == 0.0) .and. (IrrigationFracGrid >= IrriFracThreshold) ) then + IrrigationFracSprinkler = 1.0 + endif + + ! choose method based on user namelist choice + if ( OptIrrigationMethod == 1 ) then + IrrigationFracSprinkler = 1.0 + IrrigationFracMicro = 0.0 + IrrigationFracFlood = 0.0 + elseif ( OptIrrigationMethod == 2 ) then + IrrigationFracSprinkler = 0.0 + IrrigationFracMicro = 1.0 + IrrigationFracFlood = 0.0 + elseif ( OptIrrigationMethod == 3 ) then + IrrigationFracSprinkler = 0.0 + IrrigationFracMicro = 0.0 + IrrigationFracFlood = 1.0 + endif + + ! trigger irrigation only at soil water timestep to be consistent for solving soil water + if ( FlagSoilProcess .eqv. .true. ) then + if ( (FlagCropland .eqv. .true.) .and. (IrrigationFracGrid >= IrriFracThreshold) .and. & + (RainfallRefHeight < (IrriStopPrecipThr/3600.0)) .and. & + ((IrrigationAmtSprinkler+IrrigationAmtMicro+IrrigationAmtFlood) == 0.0) ) then + call IrrigationTrigger(noahmp) + endif + + ! set irrigation off if larger than IrriStopPrecipThr mm/h for this time step and irr triggered last time step + if ( (RainfallRefHeight >= (IrriStopPrecipThr/3600.0)) .or. (IrrigationFracGrid < IrriFracThreshold) ) then + IrrigationAmtSprinkler = 0.0 + IrrigationAmtMicro = 0.0 + IrrigationAmtFlood = 0.0 + endif + endif + + end associate + + end subroutine IrrigationPrepare + +end module IrrigationPrepareMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/IrrigationSprinklerMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/IrrigationSprinklerMod.F90 new file mode 100644 index 000000000..b5dc0eae9 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/IrrigationSprinklerMod.F90 @@ -0,0 +1,109 @@ +module IrrigationSprinklerMod + +!!! Estimate irrigation water depth (m) based on sprinkler method +!!! Reference: chapter 11 of NRCS, Part 623 National Engineering Handbook. +!!! Irrigation water will be applied over the canopy, affecting present soil moisture, +!!! infiltration rate of the soil, and evaporative loss, which should be executed before canopy process. + + use Machine + use CheckNanMod + use NoahmpVarType + use ConstantDefineMod + use IrrigationInfilPhilipMod, only : IrrigationInfilPhilip + + implicit none + +contains + + subroutine IrrigationSprinkler(noahmp) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: SPRINKLER_IRRIGATION +! Original code: P. Valayamkunnath (NCAR) (08/06/2020) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + logical :: FlagNan ! NaN value flag: if NaN, return true + real(kind=kind_noahmp) :: InfilRateSfc ! surface infiltration rate [m/s] + real(kind=kind_noahmp) :: IrriRateTmp ! temporary irrigation rate [m/timestep] + real(kind=kind_noahmp) :: WindSpdTot ! total wind speed [m/s] + real(kind=kind_noahmp) :: IrriLossTmp ! temporary irrigation water loss [%] + real(kind=kind_noahmp) :: PressureVaporSat ! satuarated vapor pressure [Pa] + +! -------------------------------------------------------------------- + associate( & + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, noahmp main time step [s] + TemperatureAirRefHeight => noahmp%forcing%TemperatureAirRefHeight ,& ! in, air temperature [K] at reference height + WindEastwardRefHeight => noahmp%forcing%WindEastwardRefHeight ,& ! in, wind speed [m/s] in eastward direction at reference height + WindNorthwardRefHeight => noahmp%forcing%WindNorthwardRefHeight ,& ! in, wind speed [m/s] in northward direction at reference height + PressureVaporRefHeight => noahmp%energy%state%PressureVaporRefHeight ,& ! in, vapor pressure air [Pa] + IrriSprinklerRate => noahmp%water%param%IrriSprinklerRate ,& ! in, sprinkler irrigation rate [mm/h] + IrrigationFracSprinkler => noahmp%water%state%IrrigationFracSprinkler ,& ! in, sprinkler irrigation fraction (0 to 1) + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! in, total soil moisture [m3/m3] + SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! in, soil water content [m3/m3] + HeatLatentIrriEvap => noahmp%energy%flux%HeatLatentIrriEvap ,& ! inout, latent heating due to sprinkler evaporation [W/m2] + IrrigationAmtSprinkler => noahmp%water%state%IrrigationAmtSprinkler ,& ! inout, irrigation water amount [m] to be applied, Sprinkler + EvapIrriSprinkler => noahmp%water%flux%EvapIrriSprinkler ,& ! inout, evaporation of irrigation water, sprinkler [mm/s] + RainfallRefHeight => noahmp%water%flux%RainfallRefHeight ,& ! inout, rainfall [mm/s] at reference height + IrrigationRateSprinkler => noahmp%water%flux%IrrigationRateSprinkler ,& ! inout, rate of irrigation by sprinkler [m/timestep] + IrriEvapLossSprinkler => noahmp%water%flux%IrriEvapLossSprinkler ,& ! inout, loss of irrigation water to evaporation,sprinkler [m/timestep] + SoilIce => noahmp%water%state%SoilIce & ! out, soil ice content [m3/m3] + ) +! ---------------------------------------------------------------------- + + ! initialize + SoilIce(:) = max(0.0, SoilMoisture(:)-SoilLiqWater(:)) + + ! estimate infiltration rate based on Philips Eq. + call IrrigationInfilPhilip(noahmp, MainTimeStep, InfilRateSfc) + + ! irrigation rate of sprinkler + IrriRateTmp = IrriSprinklerRate * (1.0/1000.0) * MainTimeStep / 3600.0 ! NRCS rate/time step - calibratable + IrrigationRateSprinkler = min(InfilRateSfc*MainTimeStep, IrrigationAmtSprinkler, IrriRateTmp) ! Limit irrigation rate to minimum of infiltration rate + ! and to the NRCS recommended rate + ! evaporative loss from droplets: Based on Bavi et al., (2009). Evaporation + ! losses from sprinkler irrigation systems under various operating + ! conditions. Journal of Applied Sciences, 9(3), 597-600. + WindSpdTot = sqrt((WindEastwardRefHeight**2.0) + (WindNorthwardRefHeight**2.0)) + PressureVaporSat = 610.8 * exp((17.27*(TemperatureAirRefHeight-273.15)) / (237.3+(TemperatureAirRefHeight-273.15))) + + if ( TemperatureAirRefHeight > 273.15 ) then ! Equation (3) + IrriLossTmp = 4.375 * (exp(0.106*WindSpdTot)) * (((PressureVaporSat-PressureVaporRefHeight)*0.01)**(-0.092)) * & + ((TemperatureAirRefHeight-273.15)**(-0.102)) + else ! Equation (4) + IrriLossTmp = 4.337 * (exp(0.077*WindSpdTot)) * (((PressureVaporSat-PressureVaporRefHeight)*0.01)**(-0.098)) + endif + ! Old PGI Fortran compiler does not support ISNAN function + call CheckRealNaN(IrriLossTmp, FlagNan) + if ( FlagNan .eqv. .true. ) IrriLossTmp = 4.0 ! In case if IrriLossTmp is NaN + if ( (IrriLossTmp > 100.0) .or. (IrriLossTmp < 0.0) ) IrriLossTmp = 4.0 ! In case if IrriLossTmp is out of range + + ! Sprinkler water [m] for sprinkler fraction + IrrigationRateSprinkler = IrrigationRateSprinkler * IrrigationFracSprinkler + if ( IrrigationRateSprinkler >= IrrigationAmtSprinkler ) then + IrrigationRateSprinkler = IrrigationAmtSprinkler + IrrigationAmtSprinkler = 0.0 + else + IrrigationAmtSprinkler = IrrigationAmtSprinkler - IrrigationRateSprinkler + endif + + IrriEvapLossSprinkler = IrrigationRateSprinkler * IrriLossTmp * (1.0/100.0) + IrrigationRateSprinkler = IrrigationRateSprinkler - IrriEvapLossSprinkler + + ! include sprinkler water to total rain for canopy process later + RainfallRefHeight = RainfallRefHeight + (IrrigationRateSprinkler * 1000.0 / MainTimeStep) + + ! cooling and humidification due to sprinkler evaporation, per m^2 calculation + HeatLatentIrriEvap = IrriEvapLossSprinkler * 1000.0 * ConstLatHeatEvap / MainTimeStep ! heat used for evaporation [W/m2] + EvapIrriSprinkler = IrriEvapLossSprinkler * 1000.0 / MainTimeStep ! sprinkler evaporation [mm/s] + + end associate + + end subroutine IrrigationSprinkler + +end module IrrigationSprinklerMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/IrrigationTriggerMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/IrrigationTriggerMod.F90 new file mode 100644 index 000000000..b0b96b709 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/IrrigationTriggerMod.F90 @@ -0,0 +1,144 @@ +module IrrigationTriggerMod + +!!! Trigger irrigation if soil moisture less than the management allowable deficit (MAD) +!!! and estimate irrigation water depth [m] using current rootzone soil moisture and field +!!! capacity. There are two options here to trigger the irrigation scheme based on MAD +!!! OptIrrigation = 1 -> if irrigated fraction > threshold fraction +!!! OptIrrigation = 2 -> if irrigated fraction > threshold fraction and within crop season +!!! OptIrrigation = 3 -> if irrigated fraction > threshold fraction and LeafAreaIndex > threshold LeafAreaIndex + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine IrrigationTrigger(noahmp) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: TRIGGER_IRRIGATION +! Original code: P. Valayamkunnath (NCAR) (08/06/2020) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + logical :: FlagIrri ! flag for irrigation activation + integer :: LoopInd ! loop index + real(kind=kind_noahmp) :: SoilMoistAvail ! available soil moisture [m] at timestep + real(kind=kind_noahmp) :: SoilMoistAvailMax ! maximum available moisture [m] + real(kind=kind_noahmp) :: IrrigationWater ! irrigation water amount [m] + +! -------------------------------------------------------------------- + associate( & + DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth [m] of layer-bottom from soil surface + DayJulianInYear => noahmp%config%domain%DayJulianInYear ,& ! in, Julian day of the year + OptIrrigation => noahmp%config%nmlist%OptIrrigation ,& ! in, irrigation option + OptIrrigationMethod => noahmp%config%nmlist%OptIrrigationMethod ,& ! in, irrigation method option + DatePlanting => noahmp%biochem%param%DatePlanting ,& ! in, Planting day (day of year) + DateHarvest => noahmp%biochem%param%DateHarvest ,& ! in, Harvest date (day of year) + SoilMoistureWilt => noahmp%water%param%SoilMoistureWilt ,& ! in, wilting point soil moisture [m3/m3] + SoilMoistureFieldCap => noahmp%water%param%SoilMoistureFieldCap ,& ! in, reference soil moisture (field capacity) (m3/m3) + NumSoilLayerRoot => noahmp%water%param%NumSoilLayerRoot ,& ! in, number of soil layers with root present + IrriStopDayBfHarvest => noahmp%water%param%IrriStopDayBfHarvest ,& ! in, number of days before harvest date to stop irrigation + IrriTriggerLaiMin => noahmp%water%param%IrriTriggerLaiMin ,& ! in, minimum lai to trigger irrigation + SoilWatDeficitAllow => noahmp%water%param%SoilWatDeficitAllow ,& ! in, management allowable deficit (0-1) + IrriFloodLossFrac => noahmp%water%param%IrriFloodLossFrac ,& ! in, factor of flood irrigation loss + VegFrac => noahmp%energy%state%VegFrac ,& ! in, greeness vegetation fraction + LeafAreaIndex => noahmp%energy%state%LeafAreaIndex ,& ! in, leaf area index [m2/m2] + IrrigationFracGrid => noahmp%water%state%IrrigationFracGrid ,& ! in, irrigated area fraction of a grid + SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! in, soil water content [m3/m3] + IrrigationFracMicro => noahmp%water%state%IrrigationFracMicro ,& ! in, fraction of grid under micro irrigation (0 to 1) + IrrigationFracFlood => noahmp%water%state%IrrigationFracFlood ,& ! in, fraction of grid under flood irrigation (0 to 1) + IrrigationFracSprinkler => noahmp%water%state%IrrigationFracSprinkler ,& ! in, sprinkler irrigation fraction (0 to 1) + IrrigationAmtMicro => noahmp%water%state%IrrigationAmtMicro ,& ! inout, irrigation water amount [m] to be applied, Micro + IrrigationAmtFlood => noahmp%water%state%IrrigationAmtFlood ,& ! inout, irrigation water amount [m] to be applied, Flood + IrrigationAmtSprinkler => noahmp%water%state%IrrigationAmtSprinkler ,& ! inout, irrigation water amount [m] to be applied, Sprinkler + IrrigationCntSprinkler => noahmp%water%state%IrrigationCntSprinkler ,& ! inout, irrigation event number, Sprinkler + IrrigationCntMicro => noahmp%water%state%IrrigationCntMicro ,& ! inout, irrigation event number, Micro + IrrigationCntFlood => noahmp%water%state%IrrigationCntFlood & ! inout, irrigation event number, Flood + ) +! ---------------------------------------------------------------------- + + FlagIrri = .true. + + ! check if irrigation is can be activated or not + if ( OptIrrigation == 2 ) then ! activate irrigation if within crop season + if ( (DayJulianInYear < DatePlanting) .or. (DayJulianInYear > (DateHarvest-IrriStopDayBfHarvest)) ) & + FlagIrri = .false. + elseif ( OptIrrigation == 3) then ! activate if LeafAreaIndex > threshold LeafAreaIndex + if ( LeafAreaIndex < IrriTriggerLaiMin) FlagIrri = .false. + elseif ( (OptIrrigation > 3) .or. (OptIrrigation < 1) ) then + FlagIrri = .false. + endif + + if ( FlagIrri .eqv. .true. ) then + ! estimate available water and field capacity for the root zone + SoilMoistAvail = 0.0 + SoilMoistAvailMax = 0.0 + SoilMoistAvail = (SoilLiqWater(1) - SoilMoistureWilt(1)) * (-1.0) * DepthSoilLayer(1) ! current soil water (m) + SoilMoistAvailMax = (SoilMoistureFieldCap(1) - SoilMoistureWilt(1)) * (-1.0) * DepthSoilLayer(1) ! available water (m) + do LoopInd = 2, NumSoilLayerRoot + SoilMoistAvail = SoilMoistAvail + (SoilLiqWater(LoopInd) - SoilMoistureWilt(LoopInd)) * & + (DepthSoilLayer(LoopInd-1) - DepthSoilLayer(LoopInd)) + SoilMoistAvailMax = SoilMoistAvailMax + (SoilMoistureFieldCap(LoopInd) - SoilMoistureWilt(LoopInd)) * & + (DepthSoilLayer(LoopInd-1) - DepthSoilLayer(LoopInd)) + enddo + + ! check if root zone soil moisture < SoilWatDeficitAllow (calibratable) + if ( (SoilMoistAvail/SoilMoistAvailMax) <= SoilWatDeficitAllow ) then + ! amount of water need to be added to bring soil moisture back to + ! field capacity, i.e., irrigation water amount (m) + IrrigationWater = (SoilMoistAvailMax - SoilMoistAvail) * IrrigationFracGrid * VegFrac + + ! sprinkler irrigation amount (m) based on 2D IrrigationFracSprinkler + if ( (IrrigationAmtSprinkler == 0.0) .and. (IrrigationFracSprinkler > 0.0) .and. (OptIrrigationMethod == 0) ) then + IrrigationAmtSprinkler = IrrigationFracSprinkler * IrrigationWater + IrrigationCntSprinkler = IrrigationCntSprinkler + 1 + ! sprinkler irrigation amount (m) based on namelist choice + elseif ( (IrrigationAmtSprinkler == 0.0) .and. (OptIrrigationMethod == 1) ) then + IrrigationAmtSprinkler = IrrigationWater + IrrigationCntSprinkler = IrrigationCntSprinkler + 1 + endif + + ! micro irrigation amount (m) based on 2D IrrigationFracMicro + if ( (IrrigationAmtMicro == 0.0) .and. (IrrigationFracMicro > 0.0) .and. (OptIrrigationMethod == 0) ) then + IrrigationAmtMicro = IrrigationFracMicro * IrrigationWater + IrrigationCntMicro = IrrigationCntMicro + 1 + ! micro irrigation amount (m) based on namelist choice + elseif ( (IrrigationAmtMicro == 0.0) .and. (OptIrrigationMethod == 2) ) then + IrrigationAmtMicro = IrrigationWater + IrrigationCntMicro = IrrigationCntMicro + 1 + endif + + ! flood irrigation amount (m): Assumed to saturate top two layers and + ! third layer to FC. As water moves from one end of the field to + ! another, surface layers will be saturated. + ! flood irrigation amount (m) based on 2D IrrigationFracFlood + if ( (IrrigationAmtFlood == 0.0) .and. (IrrigationFracFlood > 0.0) .and. (OptIrrigationMethod == 0) ) then + IrrigationAmtFlood = IrrigationFracFlood * IrrigationWater * (1.0/(1.0 - IrriFloodLossFrac)) + IrrigationCntFlood = IrrigationCntFlood + 1 + !flood irrigation amount (m) based on namelist choice + elseif ( (IrrigationAmtFlood == 0.0) .and. (OptIrrigationMethod == 3) ) then + IrrigationAmtFlood = IrrigationWater * (1.0/(1.0 - IrriFloodLossFrac)) + IrrigationCntFlood = IrrigationCntFlood + 1 + endif + else + IrrigationWater = 0.0 + IrrigationAmtSprinkler = 0.0 + IrrigationAmtMicro = 0.0 + IrrigationAmtFlood = 0.0 + endif + + endif + + end associate + + end subroutine IrrigationTrigger + +end module IrrigationTriggerMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/Makefile b/src/core_atmosphere/physics/physics_noahmp/src/Makefile new file mode 100644 index 000000000..675bdf9df --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/Makefile @@ -0,0 +1,351 @@ +.SUFFIXES: .F90 .o + +.PHONY: src src_lib + +# +# The Noah-MP code fails to build with the GNU compilers with -std=f2008, +# so remove that flag here if it is present in FFLAGS +# +FFLAGS_NONSTD = $(shell printf "%s" "$(FFLAGS)" | sed -e 's/-std=f2008//g' ) + +all: dummy src + +dummy: + echo "****** compiling physics_noahmp/utility ******" + +OBJS = ConstantDefineMod.o \ + ConfigVarType.o \ + ForcingVarType.o \ + EnergyVarType.o \ + WaterVarType.o \ + BiochemVarType.o \ + NoahmpVarType.o \ + ConfigVarInitMod.o \ + ForcingVarInitMod.o \ + EnergyVarInitMod.o \ + WaterVarInitMod.o \ + BiochemVarInitMod.o \ + CanopyHydrologyMod.o \ + GroundWaterTopModelMod.o \ + IrrigationFloodMod.o \ + IrrigationInfilPhilipMod.o \ + IrrigationMicroMod.o \ + MatrixSolverTriDiagonalMod.o \ + RunoffSubSurfaceDrainageMod.o \ + RunoffSubSurfaceEquiWaterTableMod.o \ + RunoffSubSurfaceGroundWaterMod.o \ + RunoffSubSurfaceShallowMmfMod.o \ + RunoffSurfaceBatsMod.o \ + RunoffSurfaceDynamicVicMod.o \ + RunoffSurfaceExcessDynamicVicMod.o \ + RunoffSurfaceFreeDrainMod.o \ + RunoffSurfaceTopModelEquiMod.o \ + RunoffSurfaceTopModelGrdMod.o \ + RunoffSurfaceTopModelMmfMod.o \ + RunoffSurfaceVicMod.o \ + RunoffSurfaceXinAnJiangMod.o \ + ShallowWaterTableMmfMod.o \ + SnowfallBelowCanopyMod.o \ + SnowLayerCombineMod.o \ + SnowLayerDivideMod.o \ + SnowLayerWaterComboMod.o \ + SnowpackCompactionMod.o \ + SnowpackHydrologyMod.o \ + SnowWaterMainMod.o \ + SoilHydraulicPropertyMod.o \ + SoilMoistureSolverMod.o \ + SoilWaterDiffusionRichardsMod.o \ + SoilWaterInfilGreenAmptMod.o \ + SoilWaterInfilPhilipMod.o \ + SoilWaterInfilSmithParlangeMod.o \ + SoilWaterMainMod.o \ + TileDrainageEquiDepthMod.o \ + TileDrainageHooghoudtMod.o \ + TileDrainageSimpleMod.o \ + WaterMainMod.o \ + WaterTableDepthSearchMod.o \ + WaterTableEquilibriumMod.o \ + IrrigationTriggerMod.o \ + IrrigationSprinklerMod.o \ + CanopyWaterInterceptMod.o \ + PrecipitationHeatAdvectMod.o \ + SnowThermalPropertyMod.o \ + SoilThermalPropertyMod.o \ + GroundThermalPropertyMod.o \ + EnergyMainMod.o \ + NoahmpMainMod.o \ + SnowAgingBatsMod.o \ + SnowAlbedoBatsMod.o \ + SnowAlbedoClassMod.o \ + GroundAlbedoMod.o \ + CanopyRadiationTwoStreamMod.o \ + SurfaceAlbedoMod.o \ + SurfaceRadiationMod.o \ + HumiditySaturationMod.o \ + ResistanceAboveCanopyChen97Mod.o \ + ResistanceAboveCanopyMostMod.o \ + ResistanceCanopyStomataBallBerryMod.o \ + ResistanceCanopyStomataJarvisMod.o \ + ResistanceLeafToGroundMod.o \ + VaporPressureSaturationMod.o \ + SurfaceEnergyFluxVegetatedMod.o \ + ResistanceBareGroundChen97Mod.o \ + ResistanceBareGroundMostMod.o \ + SurfaceEnergyFluxBareGroundMod.o \ + SoilSnowTemperatureMainMod.o \ + SoilSnowTemperatureSolverMod.o \ + SoilSnowThermalDiffusionMod.o \ + SoilSnowWaterPhaseChangeMod.o \ + SoilWaterSupercoolKoren99Mod.o \ + SoilWaterSupercoolNiu06Mod.o \ + SnowCoverGroundNiu07Mod.o \ + GroundRoughnessPropertyMod.o \ + SurfaceEmissivityMod.o \ + PsychrometricVariableMod.o \ + ResistanceGroundEvaporationMod.o \ + SoilWaterTranspirationMod.o \ + AtmosForcingMod.o \ + PhenologyMainMod.o \ + BiochemCropMainMod.o \ + BiochemNatureVegMainMod.o \ + CarbonFluxCropMod.o \ + CarbonFluxNatureVegMod.o \ + CropGrowDegreeDayMod.o \ + CropPhotosynthesisMod.o \ + IrrigationPrepareMod.o \ + BalanceErrorCheckMod.o \ + GeneralInitMod.o \ + BalanceErrorCheckGlacierMod.o \ + EnergyMainGlacierMod.o \ + GeneralInitGlacierMod.o \ + GlacierIceThermalPropertyMod.o \ + GlacierPhaseChangeMod.o \ + GlacierTemperatureMainMod.o \ + GlacierTemperatureSolverMod.o \ + GlacierThermalDiffusionMod.o \ + GroundAlbedoGlacierMod.o \ + GroundRoughnessPropertyGlacierMod.o \ + GroundThermalPropertyGlacierMod.o \ + NoahmpMainGlacierMod.o \ + PrecipitationHeatAdvectGlacierMod.o \ + PsychrometricVariableGlacierMod.o \ + ResistanceGroundEvaporationGlacierMod.o \ + SnowCoverGlacierMod.o \ + SnowWaterMainGlacierMod.o \ + SnowpackHydrologyGlacierMod.o \ + SurfaceAlbedoGlacierMod.o \ + SurfaceEmissivityGlacierMod.o \ + SurfaceEnergyFluxGlacierMod.o \ + SurfaceRadiationGlacierMod.o \ + WaterMainGlacierMod.o + +src: $(OBJS) + +src_lib: + ar -ru ./../../libphys.a $(OBJS) + +# DEPENDENCIES: + +ConstantDefineMod.o: ../utility/Machine.o +ConfigVarType.o: ../utility/Machine.o +ForcingVarType.o: ../utility/Machine.o +EnergyVarType.o: ../utility/Machine.o +WaterVarType.o: ../utility/Machine.o +BiochemVarType.o: ../utility/Machine.o +NoahmpVarType.o: ConfigVarType.o ForcingVarType.o EnergyVarType.o \ + WaterVarType.o BiochemVarType.o +ConfigVarInitMod.o: ../utility/Machine.o NoahmpVarType.o +ForcingVarInitMod.o: ../utility/Machine.o NoahmpVarType.o +EnergyVarInitMod.o: ../utility/Machine.o NoahmpVarType.o +WaterVarInitMod.o: ../utility/Machine.o NoahmpVarType.o +BiochemVarInitMod.o: ../utility/Machine.o NoahmpVarType.o +CanopyHydrologyMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +GroundWaterTopModelMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +IrrigationFloodMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + IrrigationInfilPhilipMod.o +IrrigationInfilPhilipMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + SoilHydraulicPropertyMod.o +IrrigationMicroMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + IrrigationInfilPhilipMod.o +MatrixSolverTriDiagonalMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +RunoffSubSurfaceDrainageMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +RunoffSubSurfaceEquiWaterTableMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + WaterTableEquilibriumMod.o +RunoffSubSurfaceGroundWaterMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + GroundWaterTopModelMod.o +RunoffSubSurfaceShallowMmfMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + ShallowWaterTableMmfMod.o +RunoffSurfaceBatsMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +RunoffSurfaceDynamicVicMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + SoilWaterInfilPhilipMod.o RunoffSurfaceExcessDynamicVicMod.o \ + SoilWaterInfilSmithParlangeMod.o SoilWaterInfilGreenAmptMod.o +RunoffSurfaceExcessDynamicVicMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +RunoffSurfaceFreeDrainMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + SoilHydraulicPropertyMod.o +RunoffSurfaceTopModelEquiMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +RunoffSurfaceTopModelGrdMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +RunoffSurfaceTopModelMmfMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +RunoffSurfaceVicMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +RunoffSurfaceXinAnJiangMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +ShallowWaterTableMmfMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +SnowfallBelowCanopyMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +SnowLayerCombineMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + SnowLayerWaterComboMod.o +SnowLayerDivideMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + SnowLayerWaterComboMod.o +SnowLayerWaterComboMod.o: ../utility/Machine.o ConstantDefineMod.o +SnowpackCompactionMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +SnowpackHydrologyMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + SnowLayerCombineMod.o +SnowWaterMainMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + SnowfallBelowCanopyMod.o SnowpackCompactionMod.o SnowLayerDivideMod.o \ + SnowLayerCombineMod.o SnowpackHydrologyMod.o +SoilHydraulicPropertyMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +SoilMoistureSolverMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + MatrixSolverTriDiagonalMod.o +SoilWaterDiffusionRichardsMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + SoilHydraulicPropertyMod.o +SoilWaterInfilGreenAmptMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + SoilHydraulicPropertyMod.o +SoilWaterInfilPhilipMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + SoilHydraulicPropertyMod.o +SoilWaterInfilSmithParlangeMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + SoilHydraulicPropertyMod.o +SoilWaterMainMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + RunoffSurfaceTopModelGrdMod.o RunoffSurfaceTopModelEquiMod.o \ + RunoffSurfaceFreeDrainMod.o RunoffSurfaceBatsMod.o \ + RunoffSurfaceTopModelMmfMod.o RunoffSurfaceVicMod.o \ + RunoffSurfaceXinAnJiangMod.o RunoffSurfaceDynamicVicMod.o \ + RunoffSubSurfaceEquiWaterTableMod.o RunoffSubSurfaceGroundWaterMod.o \ + RunoffSubSurfaceDrainageMod.o RunoffSubSurfaceShallowMmfMod.o \ + SoilWaterDiffusionRichardsMod.o SoilMoistureSolverMod.o \ + TileDrainageSimpleMod.o TileDrainageHooghoudtMod.o +TileDrainageEquiDepthMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +TileDrainageHooghoudtMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + TileDrainageEquiDepthMod.o WaterTableDepthSearchMod.o \ + WaterTableEquilibriumMod.o +TileDrainageSimpleMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +WaterMainMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + CanopyHydrologyMod.o SnowWaterMainMod.o IrrigationFloodMod.o \ + IrrigationMicroMod.o SoilWaterMainMod.o +WaterTableDepthSearchMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +WaterTableEquilibriumMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +IrrigationTriggerMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +IrrigationSprinklerMod.o: ../utility/Machine.o ../utility/CheckNanMod.o \ + NoahmpVarType.o ConstantDefineMod.o IrrigationInfilPhilipMod.o +CanopyWaterInterceptMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +PrecipitationHeatAdvectMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +SnowThermalPropertyMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +SoilThermalPropertyMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +GroundThermalPropertyMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + SnowThermalPropertyMod.o SoilThermalPropertyMod.o +CanopyRadiationTwoStreamMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +GroundAlbedoMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +SnowAgingBatsMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +SnowAlbedoBatsMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +SnowAlbedoClassMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +SurfaceAlbedoMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + SnowAgingBatsMod.o SnowAlbedoBatsMod.o SnowAlbedoClassMod.o \ + GroundAlbedoMod.o CanopyRadiationTwoStreamMod.o +SurfaceRadiationMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +EnergyMainMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + GroundThermalPropertyMod.o SurfaceEnergyFluxVegetatedMod.o \ + SurfaceEnergyFluxBareGroundMod.o SoilSnowTemperatureMainMod.o \ + SoilSnowWaterPhaseChangeMod.o SnowCoverGroundNiu07Mod.o SurfaceEmissivityMod.o \ + GroundRoughnessPropertyMod.o PsychrometricVariableMod.o ResistanceGroundEvaporationMod.o \ + SoilWaterTranspirationMod.o SurfaceAlbedoMod.o SurfaceRadiationMod.o +NoahmpMainMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + IrrigationPrepareMod.o IrrigationSprinklerMod.o CanopyWaterInterceptMod.o \ + PrecipitationHeatAdvectMod.o EnergyMainMod.o WaterMainMod.o AtmosForcingMod.o \ + BiochemCropMainMod.o BiochemNatureVegMainMod.o PhenologyMainMod.o BalanceErrorCheckMod.o \ + GeneralInitMod.o +HumiditySaturationMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +ResistanceAboveCanopyChen97Mod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +ResistanceAboveCanopyMostMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +ResistanceCanopyStomataBallBerryMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +ResistanceCanopyStomataJarvisMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + HumiditySaturationMod.o +ResistanceLeafToGroundMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +VaporPressureSaturationMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +SurfaceEnergyFluxVegetatedMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + VaporPressureSaturationMod.o ResistanceAboveCanopyMostMod.o \ + ResistanceAboveCanopyChen97Mod.o ResistanceLeafToGroundMod.o \ + ResistanceCanopyStomataBallBerryMod.o ResistanceCanopyStomataJarvisMod.o +ResistanceBareGroundChen97Mod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +ResistanceBareGroundMostMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +SurfaceEnergyFluxBareGroundMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + VaporPressureSaturationMod.o ResistanceBareGroundMostMod.o \ + ResistanceBareGroundChen97Mod.o +SoilSnowTemperatureSolverMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + MatrixSolverTriDiagonalMod.o +SoilSnowThermalDiffusionMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +SoilSnowTemperatureMainMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + SoilSnowTemperatureSolverMod.o SoilSnowThermalDiffusionMod.o +SoilWaterSupercoolKoren99Mod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +SoilWaterSupercoolNiu06Mod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +SoilSnowWaterPhaseChangeMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + SoilWaterSupercoolKoren99Mod.o SoilWaterSupercoolNiu06Mod.o +GroundRoughnessPropertyMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +PsychrometricVariableMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +ResistanceGroundEvaporationMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +SnowCoverGroundNiu07Mod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +SoilWaterTranspirationMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +SurfaceEmissivityMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +AtmosForcingMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +PhenologyMainMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +CropPhotosynthesisMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +CropGrowDegreeDayMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +CarbonFluxNatureVegMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +CarbonFluxCropMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +BiochemNatureVegMainMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o CarbonFluxNatureVegMod.o +BiochemCropMainMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o CarbonFluxCropMod.o \ + CropGrowDegreeDayMod.o CropPhotosynthesisMod.o +IrrigationPrepareMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o IrrigationTriggerMod.o +BalanceErrorCheckMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +GeneralInitMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +GroundWaterMmfMod.o: ../utility/Machine.o NoahmpVarType.o ../drivers/hrldas/NoahmpIOVarType.o +BalanceErrorCheckGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +EnergyMainGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o SnowCoverGlacierMod.o \ + GroundRoughnessPropertyGlacierMod.o GroundThermalPropertyGlacierMod.o \ + SurfaceAlbedoGlacierMod.o SurfaceRadiationGlacierMod.o SurfaceEmissivityGlacierMod.o \ + ResistanceGroundEvaporationGlacierMod.o PsychrometricVariableGlacierMod.o \ + SurfaceEnergyFluxGlacierMod.o GlacierTemperatureMainMod.o GlacierPhaseChangeMod.o +GeneralInitGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +GlacierIceThermalPropertyMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +GlacierPhaseChangeMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +GlacierTemperatureMainMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + GlacierTemperatureSolverMod.o GlacierThermalDiffusionMod.o +GlacierTemperatureSolverMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o MatrixSolverTriDiagonalMod.o +GlacierThermalDiffusionMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +GroundAlbedoGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +GroundRoughnessPropertyGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +GroundThermalPropertyGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + SnowThermalPropertyMod.o GlacierIceThermalPropertyMod.o +NoahmpMainGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o AtmosForcingMod.o \ + GeneralInitGlacierMod.o PrecipitationHeatAdvectGlacierMod.o EnergyMainGlacierMod.o \ + WaterMainGlacierMod.o BalanceErrorCheckGlacierMod.o +PrecipitationHeatAdvectGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +PsychrometricVariableGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +ResistanceGroundEvaporationGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +SnowCoverGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +SnowWaterMainGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o SnowfallBelowCanopyMod.o \ + SnowpackCompactionMod.o SnowLayerCombineMod.o SnowLayerDivideMod.o \ + SnowpackHydrologyGlacierMod.o +SnowpackHydrologyGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o SnowLayerCombineMod.o +SurfaceAlbedoGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o SnowAgingBatsMod.o \ + SnowAlbedoBatsMod.o SnowAlbedoClassMod.o GroundAlbedoGlacierMod.o +SurfaceEmissivityGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +SurfaceEnergyFluxGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o \ + VaporPressureSaturationMod.o ResistanceBareGroundMostMod.o +SurfaceRadiationGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o +WaterMainGlacierMod.o: ../utility/Machine.o NoahmpVarType.o ConstantDefineMod.o SnowWaterMainGlacierMod.o + +clean: + $(RM) *.f90 *.o *.mod + @# Certain systems with intel compilers generate *.i files + @# This removes them during the clean process + $(RM) *.i + +.F90.o: + $(FC) $(CPPFLAGS) $(COREDEF) $(FFLAGS_NONSTD) -c $*.F90 $(CPPINCLUDES) $(FCINCLUDES) -I../utility -I../../../../framework + diff --git a/src/core_atmosphere/physics/physics_noahmp/src/MatrixSolverTriDiagonalMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/MatrixSolverTriDiagonalMod.F90 new file mode 100644 index 000000000..b67a1faf4 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/MatrixSolverTriDiagonalMod.F90 @@ -0,0 +1,73 @@ +module MatrixSolverTriDiagonalMod + +!!! Solve tri-diagonal matrix problem + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine MatrixSolverTriDiagonal(P, A, B, C, D, Delta, IndTopLayer, NumSoilLayer, NumSnowLayerMax) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: ROSR12 +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- +! 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) # +! ### ### ### ### ### ### +! ---------------------------------------------------------------------- + + implicit none + +! in & out variables + integer , intent(in) :: IndTopLayer ! top layer index: soil layer starts from IndTopLayer = 1 + integer , intent(in) :: NumSoilLayer ! number of soil layers + integer , intent(in) :: NumSnowLayerMax ! maximum number of snow layers + real(kind=kind_noahmp), dimension(-NumSnowLayerMax+1:NumSoilLayer), intent(in) :: A, B, D ! Tri-diagonal matrix elements + real(kind=kind_noahmp), dimension(-NumSnowLayerMax+1:NumSoilLayer), intent(inout) :: C,P,Delta ! Tri-diagonal matrix elements + +! local variables + integer :: K, KK ! loop indices +! ---------------------------------------------------------------------- + + ! INITIALIZE EQN COEF C FOR THE LOWEST SOIL LAYER + C (NumSoilLayer) = 0.0 + P (IndTopLayer) = - C (IndTopLayer) / B (IndTopLayer) + + ! SOLVE THE COEFS FOR THE 1ST SOIL LAYER + Delta (IndTopLayer) = D (IndTopLayer) / B (IndTopLayer) + + ! SOLVE THE COEFS FOR SOIL LAYERS 2 THRU NumSoilLayer + do K = IndTopLayer+1, NumSoilLayer + 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))) + enddo + + ! SET P TO Delta FOR LOWEST SOIL LAYER + P (NumSoilLayer) = Delta (NumSoilLayer) + + ! ADJUST P FOR SOIL LAYERS 2 THRU NumSoilLayer + do K = IndTopLayer+1, NumSoilLayer + KK = NumSoilLayer - K + (IndTopLayer-1) + 1 + P (KK) = P (KK) * P (KK +1) + Delta (KK) + enddo + + end subroutine MatrixSolverTriDiagonal + +end module MatrixSolverTriDiagonalMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/NoahmpMainGlacierMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/NoahmpMainGlacierMod.F90 new file mode 100644 index 000000000..4fb104c67 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/NoahmpMainGlacierMod.F90 @@ -0,0 +1,77 @@ +module NoahmpMainGlacierMod + +!!! Main NoahMP glacier module including all glacier processes +!!! atmos forcing -> precip heat advect -> main energy -> main water -> balance check + + use Machine + use NoahmpVarType + use ConstantDefineMod + use AtmosForcingMod, only : ProcessAtmosForcing + use GeneralInitGlacierMod, only : GeneralInitGlacier + use PrecipitationHeatAdvectGlacierMod, only : PrecipitationHeatAdvectGlacier + use EnergyMainGlacierMod, only : EnergyMainGlacier + use WaterMainGlacierMod, only : WaterMainGlacier + use BalanceErrorCheckGlacierMod, only : BalanceWaterInitGlacier, & + BalanceWaterCheckGlacier, BalanceEnergyCheckGlacier + + implicit none + +contains + + subroutine NoahmpMainGlacier(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: NOAHMP_SFLX +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + + !--------------------------------------------------------------------- + ! Atmospheric forcing processing + !--------------------------------------------------------------------- + + call ProcessAtmosForcing(noahmp) + + !--------------------------------------------------------------------- + ! General initialization to prepare key variables + !--------------------------------------------------------------------- + + call GeneralInitGlacier(noahmp) + + !--------------------------------------------------------------------- + ! Prepare for water balance check + !--------------------------------------------------------------------- + + call BalanceWaterInitGlacier(noahmp) + + !--------------------------------------------------------------------- + ! Energy processes + !--------------------------------------------------------------------- + + call PrecipitationHeatAdvectGlacier(noahmp) + call EnergyMainGlacier(noahmp) + + !--------------------------------------------------------------------- + ! Water processes + !--------------------------------------------------------------------- + + call WaterMainGlacier(noahmp) + + !--------------------------------------------------------------------- + ! Error check for energy and water balance + !--------------------------------------------------------------------- + + call BalanceWaterCheckGlacier(noahmp) + call BalanceEnergyCheckGlacier(noahmp) + + !--------------------------------------------------------------------- + ! End of all NoahMP glacier processes + !--------------------------------------------------------------------- + + end subroutine NoahmpMainGlacier + +end module NoahmpMainGlacierMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/NoahmpMainMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/NoahmpMainMod.F90 new file mode 100644 index 000000000..c18beb2b7 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/NoahmpMainMod.F90 @@ -0,0 +1,131 @@ +module NoahmpMainMod + +!!! Main NoahMP module including all column model processes +!!! atmos forcing -> canopy intercept -> precip heat advect -> main energy -> main water -> main biogeochemistry -> balance check + + use Machine + use NoahmpVarType + use ConstantDefineMod + use AtmosForcingMod, only : ProcessAtmosForcing + use GeneralInitMod, only : GeneralInit + use PhenologyMainMod, only : PhenologyMain + use IrrigationPrepareMod, only : IrrigationPrepare + use IrrigationSprinklerMod, only : IrrigationSprinkler + use CanopyWaterInterceptMod, only : CanopyWaterIntercept + use PrecipitationHeatAdvectMod, only : PrecipitationHeatAdvect + use EnergyMainMod, only : EnergyMain + use WaterMainMod, only : WaterMain + use BiochemNatureVegMainMod, only : BiochemNatureVegMain + use BiochemCropMainMod, only : BiochemCropMain + use BalanceErrorCheckMod, only : BalanceWaterInit, BalanceWaterCheck, BalanceEnergyCheck + + implicit none + +contains + + subroutine NoahmpMain(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: NOAHMP_SFLX +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! -------------------------------------------------------------------- + associate( & + FlagDynamicVeg => noahmp%config%domain%FlagDynamicVeg ,& ! in, flag to activate dynamic vegetation model + FlagDynamicCrop => noahmp%config%domain%FlagDynamicCrop ,& ! in, flag to activate dynamic crop model + OptCropModel => noahmp%config%nmlist%OptCropModel ,& ! in, option for crop model + IrrigationAmtSprinkler => noahmp%water%state%IrrigationAmtSprinkler ,& ! inout, irrigation water amount [m] for sprinkler + FlagCropland => noahmp%config%domain%FlagCropland & ! out, flag to identify croplands + ) +! ---------------------------------------------------------------------- + + !--------------------------------------------------------------------- + ! Atmospheric forcing processing + !--------------------------------------------------------------------- + + call ProcessAtmosForcing(noahmp) + + !--------------------------------------------------------------------- + ! General initialization to prepare key variables + !--------------------------------------------------------------------- + + call GeneralInit(noahmp) + + !--------------------------------------------------------------------- + ! Prepare for water balance check + !--------------------------------------------------------------------- + + call BalanceWaterInit(noahmp) + + !--------------------------------------------------------------------- + ! Phenology + !--------------------------------------------------------------------- + + call PhenologyMain(noahmp) + + !--------------------------------------------------------------------- + ! Irrigation prepare including trigger + !--------------------------------------------------------------------- + + call IrrigationPrepare(noahmp) + + !--------------------------------------------------------------------- + ! Sprinkler irrigation + !--------------------------------------------------------------------- + + ! call sprinkler irrigation before canopy process to have canopy interception + if ( (FlagCropland .eqv. .true.) .and. (IrrigationAmtSprinkler > 0.0) ) & + call IrrigationSprinkler(noahmp) + + !--------------------------------------------------------------------- + ! Canopy water interception and precip heat advection + !--------------------------------------------------------------------- + + call CanopyWaterIntercept(noahmp) + call PrecipitationHeatAdvect(noahmp) + + !--------------------------------------------------------------------- + ! Energy processes + !--------------------------------------------------------------------- + + call EnergyMain(noahmp) + + !--------------------------------------------------------------------- + ! Water processes + !--------------------------------------------------------------------- + + call WaterMain(noahmp) + + !--------------------------------------------------------------------- + ! Biochem processes (crop and carbon) + !--------------------------------------------------------------------- + + ! for generic vegetation + if ( FlagDynamicVeg .eqv. .true. ) call BiochemNatureVegMain(noahmp) + + ! for explicit crop treatment + if ( (OptCropModel == 1) .and. (FlagDynamicCrop .eqv. .true.) ) & + call BiochemCropMain(noahmp) + + !--------------------------------------------------------------------- + ! Error check for energy and water balance + !--------------------------------------------------------------------- + + call BalanceWaterCheck(noahmp) + call BalanceEnergyCheck(noahmp) + + !--------------------------------------------------------------------- + ! End of all NoahMP column processes + !--------------------------------------------------------------------- + + end associate + + end subroutine NoahmpMain + +end module NoahmpMainMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/NoahmpVarType.F90 b/src/core_atmosphere/physics/physics_noahmp/src/NoahmpVarType.F90 new file mode 100644 index 000000000..e53501117 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/NoahmpVarType.F90 @@ -0,0 +1,31 @@ +module NoahmpVarType + +!!! Define column (1-D) Noah-MP model variable data types + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use ForcingVarType + use ConfigVarType + use EnergyVarType + use WaterVarType + use BiochemVarType + + implicit none + save + private + + type, public :: noahmp_type + + ! define specific variable types for Noah-MP + type(forcing_type) :: forcing + type(config_type) :: config + type(energy_type) :: energy + type(water_type) :: water + type(biochem_type) :: biochem + + end type noahmp_type + +end module NoahmpVarType diff --git a/src/core_atmosphere/physics/physics_noahmp/src/PhenologyMainMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/PhenologyMainMod.F90 new file mode 100644 index 000000000..e23193500 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/PhenologyMainMod.F90 @@ -0,0 +1,169 @@ +module PhenologyMainMod + +!!! Main Phenology module to estimate vegetation phenology +!!! considering vegeation canopy being buries by snow and evolution in time + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine PhenologyMain (noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: PHENOLOGY +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variables + integer :: IntpMonth1,IntpMonth2 ! interpolation months + real(kind=kind_noahmp) :: ThicknessCanBury ! thickness of canopy buried by snow [m] + real(kind=kind_noahmp) :: SnowDepthVegBury ! critical snow depth at which short vege is fully covered by snow + real(kind=kind_noahmp) :: DayCurrent ! current day of year (0<=DayCurrent noahmp%config%nmlist%OptDynamicVeg ,& ! in, dynamic vegetation option + OptCropModel => noahmp%config%nmlist%OptCropModel ,& ! in, crop model option + VegType => noahmp%config%domain%VegType ,& ! in, vegetation type + CropType => noahmp%config%domain%CropType ,& ! in, crop type + IndexIcePoint => noahmp%config%domain%IndexIcePoint ,& ! in, land ice flag + IndexBarrenPoint => noahmp%config%domain%IndexBarrenPoint ,& ! in, bare soil flag + IndexWaterPoint => noahmp%config%domain%IndexWaterPoint ,& ! in, water point flag + FlagUrban => noahmp%config%domain%FlagUrban ,& ! in, urban point flag + FlagDynamicVeg => noahmp%config%domain%FlagDynamicVeg ,& ! in, flag to activate dynamic vegetation model + FlagDynamicCrop => noahmp%config%domain%FlagDynamicCrop ,& ! in, flag to activate dynamic crop model + Latitude => noahmp%config%domain%Latitude ,& ! in, latitude [deg] + NumDayInYear => noahmp%config%domain%NumDayInYear ,& ! in, Number of days in the particular year + DayJulianInYear => noahmp%config%domain%DayJulianInYear ,& ! in, Julian day of year + HeightCanopyTop => noahmp%energy%param%HeightCanopyTop ,& ! in, top of canopy [m] + HeightCanopyBot => noahmp%energy%param%HeightCanopyBot ,& ! in, bottom of canopy [m] + LeafAreaIndexMon => noahmp%energy%param%LeafAreaIndexMon ,& ! in, monthly leaf area index, one-sided + StemAreaIndexMon => noahmp%energy%param%StemAreaIndexMon ,& ! in, monthly stem area index, one-sided + VegFracAnnMax => noahmp%energy%param%VegFracAnnMax ,& ! in, annual maximum vegetation fraction + VegFracGreen => noahmp%energy%param%VegFracGreen ,& ! in, green vegetation fraction + TemperatureMinPhotosyn => noahmp%biochem%param%TemperatureMinPhotosyn ,& ! in, minimum temperature for photosynthesis [K] + PlantGrowStage => noahmp%biochem%state%PlantGrowStage ,& ! in, plant growing stage + SnowDepth => noahmp%water%state%SnowDepth ,& ! in, snow depth [m] + TemperatureCanopy => noahmp%energy%state%TemperatureCanopy ,& ! in, vegetation temperature [K] + LeafAreaIndex => noahmp%energy%state%LeafAreaIndex ,& ! inout, LeafAreaIndex, unadjusted for burying by snow + StemAreaIndex => noahmp%energy%state%StemAreaIndex ,& ! inout, StemAreaIndex, unadjusted for burying by snow + LeafAreaIndEff => noahmp%energy%state%LeafAreaIndEff ,& ! out, leaf area index, after burying by snow + StemAreaIndEff => noahmp%energy%state%StemAreaIndEff ,& ! out, stem area index, after burying by snow + VegFrac => noahmp%energy%state%VegFrac ,& ! out, green vegetation fraction + CanopyFracSnowBury => noahmp%energy%state%CanopyFracSnowBury ,& ! out, fraction of canopy buried by snow + IndexGrowSeason => noahmp%biochem%state%IndexGrowSeason & ! out, growing season index (0=off, 1=on) + ) +!---------------------------------------------------------------------- + + ! compute LeafAreaIndex based on dynamic vegetation option + if ( CropType == 0 ) then + + ! no dynamic vegetation, use table LeafAreaIndex + if ( (OptDynamicVeg == 1) .or. (OptDynamicVeg == 3) .or. (OptDynamicVeg == 4) ) then + if ( Latitude >= 0.0 ) then + ! Northern Hemisphere + DayCurrent = DayJulianInYear + else + ! Southern Hemisphere. DayCurrent is shifted by 1/2 year. + DayCurrent = mod(DayJulianInYear+(0.5*NumDayInYear), real(NumDayInYear)) + endif + ! interpolate from monthly data to target time point + MonthCurrent = 12.0 * DayCurrent / real(NumDayInYear) + IntpMonth1 = MonthCurrent + 0.5 + IntpMonth2 = IntpMonth1 + 1 + IntpWgt1 = (IntpMonth1 + 0.5) - MonthCurrent + IntpWgt2 = 1.0 - IntpWgt1 + if ( IntpMonth1 < 1 ) IntpMonth1 = 12 + if ( IntpMonth2 > 12 ) IntpMonth2 = 1 + LeafAreaIndex = IntpWgt1 * LeafAreaIndexMon(IntpMonth1) + IntpWgt2 * LeafAreaIndexMon(IntpMonth2) + StemAreaIndex = IntpWgt1 * StemAreaIndexMon(IntpMonth1) + IntpWgt2 * StemAreaIndexMon(IntpMonth2) + endif + + ! no dynamic vegetation, use input LeafAreaIndex time series + if ( (OptDynamicVeg == 7) .or. (OptDynamicVeg == 8) .or. (OptDynamicVeg == 9) ) then + StemAreaIndex = max(0.05, 0.1*LeafAreaIndex) ! set StemAreaIndex to 10% LeafAreaIndex, but not below 0.05 MB: v3.8 + if ( LeafAreaIndex < 0.05 ) StemAreaIndex = 0.0 ! if LeafAreaIndex below minimum, make sure StemAreaIndex = 0 + endif + if ( StemAreaIndex < 0.05 ) StemAreaIndex = 0.0 ! MB: StemAreaIndex CHECK, change to 0.05 v3.6 + if ( (LeafAreaIndex < 0.05) .or. (StemAreaIndex == 0.0) ) LeafAreaIndex = 0.0 ! MB: LeafAreaIndex CHECK + + ! for non-vegetation point + if ( (VegType == IndexWaterPoint) .or. (VegType == IndexBarrenPoint) .or. & + (VegType == IndexIcePoint ) .or. (FlagUrban .eqv. .true.) ) then + LeafAreaIndex = 0.0 + StemAreaIndex = 0.0 + endif + + endif ! CropType == 0 + + ! vegetation fraction buried by snow + ThicknessCanBury = min(max(SnowDepth-HeightCanopyBot,0.0), (HeightCanopyTop-HeightCanopyBot)) + CanopyFracSnowBury = ThicknessCanBury / max(1.0e-06, (HeightCanopyTop-HeightCanopyBot)) ! snow buried fraction + if ( (HeightCanopyTop > 0.0) .and. (HeightCanopyTop <= 1.0) ) then ! MB: change to 1.0 & 0.2 to reflect changes to HeightCanopyTop in MPTABLE + SnowDepthVegBury = HeightCanopyTop * exp(-SnowDepth / 0.2) + CanopyFracSnowBury = min(SnowDepth, SnowDepthVegBury) / SnowDepthVegBury + endif + + ! adjust LeafAreaIndex and StemAreaIndex bused on snow bury + LeafAreaIndEff = LeafAreaIndex * (1.0 - CanopyFracSnowBury) + StemAreaIndEff = StemAreaIndex * (1.0 - CanopyFracSnowBury) + if ( (StemAreaIndEff < 0.05) .and. (CropType == 0) ) StemAreaIndEff = 0.0 ! MB: StemAreaIndEff CHECK, change to 0.05 v3.6 + if ( ((LeafAreaIndEff < 0.05) .or. (StemAreaIndEff == 0.0)) .and. (CropType == 0) ) & + LeafAreaIndEff = 0.0 ! MB: LeafAreaIndex CHECK + + ! set growing season flag + if ( ((TemperatureCanopy > TemperatureMinPhotosyn) .and. (CropType == 0)) .or. & + ((PlantGrowStage > 2) .and. (PlantGrowStage < 7) .and. (CropType > 0))) then + IndexGrowSeason = 1.0 + else + IndexGrowSeason = 0.0 + endif + + ! compute vegetation fraction + ! input green vegetation fraction should be consistent with LeafAreaIndex + if ( (OptDynamicVeg == 1) .or. (OptDynamicVeg == 6) .or. (OptDynamicVeg == 7) ) then ! use VegFrac = VegFracGreen from input + VegFrac = VegFracGreen + elseif ( (OptDynamicVeg == 2) .or. (OptDynamicVeg == 3) .or. (OptDynamicVeg == 8) ) then ! computed VegFrac from LeafAreaIndex & StemAreaIndex + VegFrac = 1.0 - exp(-0.52 * (LeafAreaIndex + StemAreaIndex)) + elseif ( (OptDynamicVeg == 4) .or. (OptDynamicVeg == 5) .or. (OptDynamicVeg == 9) ) then ! use yearly maximum vegetation fraction + VegFrac = VegFracAnnMax + else ! outside existing vegetation options + write(*,*) "Un-recognized dynamic vegetation option (OptDynamicVeg)... " + stop "Error: Namelist parameter OptDynamicVeg unknown" + endif + ! use maximum vegetation fraction for crop run + if ( (OptCropModel > 0) .and. (CropType > 0) ) then + VegFrac = VegFracAnnMax + endif + + ! adjust unreasonable vegetation fraction + if ( VegFrac <= 0.05 ) VegFrac = 0.05 + if ( (FlagUrban .eqv. .true.) .or. (VegType == IndexBarrenPoint) ) VegFrac = 0.0 + if ( (LeafAreaIndEff+StemAreaIndEff) == 0.0 ) VegFrac = 0.0 + + ! determine if activate dynamic vegetation or crop run + FlagDynamicCrop = .false. + FlagDynamicVeg = .false. + if ( (OptDynamicVeg == 2) .or. (OptDynamicVeg == 5) .or. (OptDynamicVeg == 6) ) & + FlagDynamicVeg = .true. + if ( (OptCropModel > 0) .and. (CropType > 0) ) then + FlagDynamicCrop = .true. + FlagDynamicVeg = .false. + endif + + end associate + + end subroutine PhenologyMain + +end module PhenologyMainMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/PrecipitationHeatAdvectGlacierMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/PrecipitationHeatAdvectGlacierMod.F90 new file mode 100644 index 000000000..cf0611e74 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/PrecipitationHeatAdvectGlacierMod.F90 @@ -0,0 +1,64 @@ +module PrecipitationHeatAdvectGlacierMod + +!!! Estimate heat flux advected from precipitation to glacier ground + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine PrecipitationHeatAdvectGlacier(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: none (adapted from PRECIP_HEAT) +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + real(kind=kind_noahmp) :: HeatPrcpAirToGrd ! precipitation advected heat - air to ground [W/m2] + +! -------------------------------------------------------------------- + associate( & + TemperatureAirRefHeight => noahmp%forcing%TemperatureAirRefHeight ,& ! in, air temperature [K] at reference height + TemperatureGrd => noahmp%energy%state%TemperatureGrd ,& ! in, ground temperature [K] + RainfallRefHeight => noahmp%water%flux%RainfallRefHeight ,& ! in, total liquid rainfall [mm/s] before interception + SnowfallRefHeight => noahmp%water%flux%SnowfallRefHeight ,& ! in, total snowfall [mm/s] before interception + SnowfallGround => noahmp%water%flux%SnowfallGround ,& ! out, snowfall at ground surface [mm/s] + RainfallGround => noahmp%water%flux%RainfallGround ,& ! out, rainfall at ground surface [mm/s] + HeatPrecipAdvBareGrd => noahmp%energy%flux%HeatPrecipAdvBareGrd & ! out, precipitation advected heat - bare ground net [W/m2] + ) +! ---------------------------------------------------------------------- + + ! initialization + HeatPrcpAirToGrd = 0.0 + HeatPrecipAdvBareGrd = 0.0 + RainfallGround = RainfallRefHeight + SnowfallGround = SnowfallRefHeight + + ! Heat advection for liquid rainfall + HeatPrcpAirToGrd = RainfallGround * (ConstHeatCapacWater/1000.0) * (TemperatureAirRefHeight - TemperatureGrd) + + ! Heat advection for snowfall + HeatPrcpAirToGrd = HeatPrcpAirToGrd + & + SnowfallGround * (ConstHeatCapacIce/1000.0) * (TemperatureAirRefHeight - TemperatureGrd) + + ! net heat advection + HeatPrecipAdvBareGrd = HeatPrcpAirToGrd + + ! Put some artificial limits here for stability + HeatPrecipAdvBareGrd = max(HeatPrecipAdvBareGrd, -20.0) + HeatPrecipAdvBareGrd = min(HeatPrecipAdvBareGrd, 20.0) + + end associate + + end subroutine PrecipitationHeatAdvectGlacier + +end module PrecipitationHeatAdvectGlacierMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/PrecipitationHeatAdvectMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/PrecipitationHeatAdvectMod.F90 new file mode 100644 index 000000000..e10f9cac1 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/PrecipitationHeatAdvectMod.F90 @@ -0,0 +1,99 @@ +module PrecipitationHeatAdvectMod + +!!! Estimate heat flux advected from precipitation to vegetation and ground + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine PrecipitationHeatAdvect(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: PRECIP_HEAT +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! The water and heat portions of PRECIP_HEAT are separated in refactored code +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + real(kind=kind_noahmp) :: HeatPrcpAirToCan ! precipitation advected heat - air to canopy [W/m2] + real(kind=kind_noahmp) :: HeatPrcpCanToGrd ! precipitation advected heat - canopy to ground [W/m2] + real(kind=kind_noahmp) :: HeatPrcpAirToGrd ! precipitation advected heat - air to ground [W/m2] + +! -------------------------------------------------------------------- + associate( & + TemperatureAirRefHeight => noahmp%forcing%TemperatureAirRefHeight ,& ! in, air temperature [K] at reference height + TemperatureCanopy => noahmp%energy%state%TemperatureCanopy ,& ! in, vegetation temperature [K] + TemperatureGrd => noahmp%energy%state%TemperatureGrd ,& ! in, ground temperature [K] + VegFrac => noahmp%energy%state%VegFrac ,& ! in, greeness vegetation fraction + RainfallRefHeight => noahmp%water%flux%RainfallRefHeight ,& ! in, total liquid rainfall [mm/s] before interception + SnowfallRefHeight => noahmp%water%flux%SnowfallRefHeight ,& ! in, total snowfall [mm/s] before interception + DripCanopyRain => noahmp%water%flux%DripCanopyRain ,& ! in, drip rate for intercepted rain [mm/s] + ThroughfallRain => noahmp%water%flux%ThroughfallRain ,& ! in, throughfall for rain [mm/s] + DripCanopySnow => noahmp%water%flux%DripCanopySnow ,& ! in, drip (unloading) rate for intercepted snow [mm/s] + ThroughfallSnow => noahmp%water%flux%ThroughfallSnow ,& ! in, throughfall of snowfall [mm/s] + HeatPrecipAdvCanopy => noahmp%energy%flux%HeatPrecipAdvCanopy ,& ! out, precipitation advected heat - vegetation net [W/m2] + HeatPrecipAdvVegGrd => noahmp%energy%flux%HeatPrecipAdvVegGrd ,& ! out, precipitation advected heat - under canopy net [W/m2] + HeatPrecipAdvBareGrd => noahmp%energy%flux%HeatPrecipAdvBareGrd & ! out, precipitation advected heat - bare ground net [W/m2] + ) +! ---------------------------------------------------------------------- + + ! initialization + HeatPrcpAirToCan = 0.0 + HeatPrcpCanToGrd = 0.0 + HeatPrcpAirToGrd = 0.0 + HeatPrecipAdvCanopy = 0.0 + HeatPrecipAdvVegGrd = 0.0 + HeatPrecipAdvBareGrd = 0.0 + + ! Heat advection for liquid rainfall + HeatPrcpAirToCan = VegFrac * RainfallRefHeight * (ConstHeatCapacWater/1000.0) * (TemperatureAirRefHeight-TemperatureCanopy) + HeatPrcpCanToGrd = DripCanopyRain * (ConstHeatCapacWater/1000.0) * (TemperatureCanopy-TemperatureGrd) + HeatPrcpAirToGrd = ThroughfallRain * (ConstHeatCapacWater/1000.0) * (TemperatureAirRefHeight-TemperatureGrd) + + ! Heat advection for snowfall + HeatPrcpAirToCan = HeatPrcpAirToCan + & + VegFrac * SnowfallRefHeight * (ConstHeatCapacIce/1000.0) * (TemperatureAirRefHeight-TemperatureCanopy) + HeatPrcpCanToGrd = HeatPrcpCanToGrd + & + DripCanopySnow * (ConstHeatCapacIce/1000.0) * (TemperatureCanopy-TemperatureGrd) + HeatPrcpAirToGrd = HeatPrcpAirToGrd + & + ThroughfallSnow * (ConstHeatCapacIce/1000.0) * (TemperatureAirRefHeight-TemperatureGrd) + + ! net heat advection + HeatPrecipAdvCanopy = HeatPrcpAirToCan - HeatPrcpCanToGrd + HeatPrecipAdvVegGrd = HeatPrcpCanToGrd + HeatPrecipAdvBareGrd = HeatPrcpAirToGrd + + ! adjust for VegFrac + if ( (VegFrac > 0.0) .and. (VegFrac < 1.0) ) then + HeatPrecipAdvVegGrd = HeatPrecipAdvVegGrd / VegFrac ! these will be multiplied by fraction later + HeatPrecipAdvBareGrd = HeatPrecipAdvBareGrd / (1.0-VegFrac) + elseif ( VegFrac <= 0.0 ) then + HeatPrecipAdvBareGrd = HeatPrecipAdvVegGrd + HeatPrecipAdvBareGrd ! for case of canopy getting buried + HeatPrecipAdvVegGrd = 0.0 + HeatPrecipAdvCanopy = 0.0 + elseif ( VegFrac >= 1.0 ) then + HeatPrecipAdvBareGrd = 0.0 + endif + + ! Put some artificial limits here for stability + HeatPrecipAdvCanopy = max(HeatPrecipAdvCanopy , -20.0) + HeatPrecipAdvCanopy = min(HeatPrecipAdvCanopy , 20.0) + HeatPrecipAdvVegGrd = max(HeatPrecipAdvVegGrd , -20.0) + HeatPrecipAdvVegGrd = min(HeatPrecipAdvVegGrd , 20.0) + HeatPrecipAdvBareGrd = max(HeatPrecipAdvBareGrd, -20.0) + HeatPrecipAdvBareGrd = min(HeatPrecipAdvBareGrd, 20.0) + + end associate + + end subroutine PrecipitationHeatAdvect + +end module PrecipitationHeatAdvectMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/PsychrometricVariableGlacierMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/PsychrometricVariableGlacierMod.F90 new file mode 100644 index 000000000..9d645bab4 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/PsychrometricVariableGlacierMod.F90 @@ -0,0 +1,40 @@ +module PsychrometricVariableGlacierMod + +!!! Compute psychrometric variables for glacier ground + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine PsychrometricVariableGlacier(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: None (embedded in ENERGY_GLACIER subroutine) +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! -------------------------------------------------------------------- + associate( & + PressureAirRefHeight => noahmp%forcing%PressureAirRefHeight ,& ! in, air pressure [Pa] at reference height + LatHeatVapGrd => noahmp%energy%state%LatHeatVapGrd ,& ! out, latent heat of vaporization/subli [J/kg], ground + PsychConstGrd => noahmp%energy%state%PsychConstGrd & ! out, psychrometric constant [Pa/K], ground + ) +! ---------------------------------------------------------------------- + + LatHeatVapGrd = ConstLatHeatSublim + PsychConstGrd = ConstHeatCapacAir * PressureAirRefHeight / (0.622 * LatHeatVapGrd) + + end associate + + end subroutine PsychrometricVariableGlacier + +end module PsychrometricVariableGlacierMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/PsychrometricVariableMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/PsychrometricVariableMod.F90 new file mode 100644 index 000000000..66ac20ae9 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/PsychrometricVariableMod.F90 @@ -0,0 +1,63 @@ +module PsychrometricVariableMod + +!!! Compute psychrometric variables for canopy and ground + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine PsychrometricVariable(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: None (embedded in ENERGY subroutine) +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! -------------------------------------------------------------------- + associate( & + PressureAirRefHeight => noahmp%forcing%PressureAirRefHeight ,& ! in, air pressure [Pa] at reference height + TemperatureCanopy => noahmp%energy%state%TemperatureCanopy ,& ! in, vegetation temperature [K] + TemperatureGrd => noahmp%energy%state%TemperatureGrd ,& ! in, ground temperature [K] + LatHeatVapCanopy => noahmp%energy%state%LatHeatVapCanopy ,& ! out, latent heat of vaporization/subli [J/kg], canopy + LatHeatVapGrd => noahmp%energy%state%LatHeatVapGrd ,& ! out, latent heat of vaporization/subli [J/kg], ground + FlagFrozenCanopy => noahmp%energy%state%FlagFrozenCanopy ,& ! out, used to define latent heat pathway + FlagFrozenGround => noahmp%energy%state%FlagFrozenGround ,& ! out, frozen ground (logical) to define latent heat pathway + PsychConstCanopy => noahmp%energy%state%PsychConstCanopy ,& ! out, psychrometric constant [Pa/K], canopy + PsychConstGrd => noahmp%energy%state%PsychConstGrd & ! out, psychrometric constant [Pa/K], ground + ) +! ---------------------------------------------------------------------- + + ! for canopy ! Barlage: add distinction between ground and vegetation in v3.6 + if ( TemperatureCanopy > ConstFreezePoint ) then + LatHeatVapCanopy = ConstLatHeatEvap + FlagFrozenCanopy = .false. + else + LatHeatVapCanopy = ConstLatHeatSublim + FlagFrozenCanopy = .true. + endif + PsychConstCanopy = ConstHeatCapacAir * PressureAirRefHeight / (0.622*LatHeatVapCanopy) + + ! for ground + if ( TemperatureGrd > ConstFreezePoint ) then + LatHeatVapGrd = ConstLatHeatEvap + FlagFrozenGround = .false. + else + LatHeatVapGrd = ConstLatHeatSublim + FlagFrozenGround = .true. + endif + PsychConstGrd = ConstHeatCapacAir * PressureAirRefHeight / (0.622*LatHeatVapGrd) + + end associate + + end subroutine PsychrometricVariable + +end module PsychrometricVariableMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/ResistanceAboveCanopyChen97Mod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/ResistanceAboveCanopyChen97Mod.F90 new file mode 100644 index 000000000..1020acb2a --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/ResistanceAboveCanopyChen97Mod.F90 @@ -0,0 +1,209 @@ +module ResistanceAboveCanopyChen97Mod + +!!! Compute surface resistance and exchange coefficient for momentum and heat +!!! based on Chen et al. (1997, BLM) +!!! This scheme can handle both over open water and over solid surface + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine ResistanceAboveCanopyChen97(noahmp, IterationInd) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: SFCDIF2 for vegetated portion +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + integer , intent(in ) :: IterationInd ! iteration index + type(noahmp_type) , intent(inout) :: noahmp + +! local variables + integer :: ILECH, ITR + real(kind=kind_noahmp) :: ZZ, PSLMU, PSLMS, PSLHU, PSLHS + real(kind=kind_noahmp) :: XX, PSPMU, YY, PSPMS, PSPHU, PSPHS + real(kind=kind_noahmp) :: ZILFC, ZU, ZT, RDZ, CXCH, DTHV, DU2 + real(kind=kind_noahmp) :: BTGH, ZSLU, ZSLT, RLOGU, RLOGT, RLMA + real(kind=kind_noahmp) :: ZETALT, ZETALU, ZETAU, ZETAT, XLU4 + real(kind=kind_noahmp) :: XLT4, XU4, XT4, XLU, XLT, XU, XT + real(kind=kind_noahmp) :: PSMZ, SIMM, PSHZ, SIMH, USTARK, RLMN +! local parameters + integer , parameter :: ITRMX = 5 + real(kind=kind_noahmp), parameter :: WWST = 1.2 + real(kind=kind_noahmp), parameter :: WWST2 = WWST * WWST + real(kind=kind_noahmp), parameter :: VKRM = 0.40 + real(kind=kind_noahmp), parameter :: EXCM = 0.001 + real(kind=kind_noahmp), parameter :: BETA = 1.0 / 270.0 + real(kind=kind_noahmp), parameter :: BTG = BETA * ConstGravityAcc + real(kind=kind_noahmp), parameter :: ELFC = VKRM * BTG + real(kind=kind_noahmp), parameter :: WOLD = 0.15 + real(kind=kind_noahmp), parameter :: WNEW = 1.0 - WOLD + real(kind=kind_noahmp), parameter :: PIHF = 3.14159265 / 2.0 + real(kind=kind_noahmp), parameter :: EPSU2 = 1.0e-4 + real(kind=kind_noahmp), parameter :: EPSUST = 0.07 + real(kind=kind_noahmp), parameter :: EPSIT = 1.0e-4 + real(kind=kind_noahmp), parameter :: EPSA = 1.0e-8 + real(kind=kind_noahmp), parameter :: ZTMIN = -5.0 + real(kind=kind_noahmp), parameter :: ZTMAX = 1.0 + real(kind=kind_noahmp), parameter :: HPBL = 1000.0 + real(kind=kind_noahmp), parameter :: SQVISC = 258.2 + real(kind=kind_noahmp), parameter :: RIC = 0.183 + real(kind=kind_noahmp), parameter :: RRIC = 1.0 / RIC + real(kind=kind_noahmp), parameter :: FHNEU = 0.8 + real(kind=kind_noahmp), parameter :: RFC = 0.191 + real(kind=kind_noahmp), parameter :: RFAC = RIC / ( FHNEU * RFC * RFC ) +! local statement functions + ! LECH'S surface functions + PSLMU(ZZ) = -0.96 * log(1.0 - 4.5 * ZZ) + PSLMS(ZZ) = ZZ * RRIC - 2.076 * (1.0 - 1.0/(ZZ + 1.0)) + PSLHU(ZZ) = -0.96 * log(1.0 - 4.5 * ZZ) + PSLHS(ZZ) = ZZ * RFAC - 2.076 * (1.0 - 1.0/(ZZ + 1.0)) + ! PAULSON'S surface functions + PSPMU(XX) = -2.0*log( (XX+1.0)*0.5 ) - log( (XX*XX+1.0)*0.5 ) + 2.0*atan(XX) - PIHF + PSPMS(YY) = 5.0 * YY + PSPHU(XX) = -2.0 * log( (XX*XX + 1.0)*0.5 ) + PSPHS(YY) = 5.0 * YY + +! -------------------------------------------------------------------- + associate( & + ZilitinkevichCoeff => noahmp%energy%param%ZilitinkevichCoeff ,& ! in, Calculate roughness length of heat + RefHeightAboveGrd => noahmp%energy%state%RefHeightAboveGrd ,& ! in, reference height [m] above ground + TemperaturePotRefHeight => noahmp%energy%state%TemperaturePotRefHeight ,& ! in, potential temp at reference height [K] + WindSpdRefHeight => noahmp%energy%state%WindSpdRefHeight ,& ! in, wind speed [m/s] at reference height + RoughLenMomSfc => noahmp%energy%state%RoughLenMomSfc ,& ! in, roughness length [m], momentum, surface + TemperatureCanopyAir => noahmp%energy%state%TemperatureCanopyAir ,& ! in, canopy air temperature [K] + ExchCoeffMomAbvCan => noahmp%energy%state%ExchCoeffMomAbvCan ,& ! inout, exchange coeff [m/s] for momentum, above ZeroPlaneDisp, vegetated + ExchCoeffShAbvCan => noahmp%energy%state%ExchCoeffShAbvCan ,& ! inout, exchange coeff [m/s] for heat, above ZeroPlaneDisp, vegetated + MoStabParaAbvCan => noahmp%energy%state%MoStabParaAbvCan ,& ! inout, Monin-Obukhov stability (z/L), above ZeroPlaneDisp, vegetated + FrictionVelVertVeg => noahmp%energy%state%FrictionVelVertVeg ,& ! inout, friction velocity [m/s] in vertical direction, vegetated + FrictionVelVeg => noahmp%energy%state%FrictionVelVeg ,& ! inout, friction velocity [m/s], vegetated + ResistanceMomAbvCan => noahmp%energy%state%ResistanceMomAbvCan ,& ! out, aerodynamic resistance for momentum [s/m], above canopy + ResistanceShAbvCan => noahmp%energy%state%ResistanceShAbvCan ,& ! out, aerodynamic resistance for sensible heat [s/m], above canopy + ResistanceLhAbvCan => noahmp%energy%state%ResistanceLhAbvCan & ! out, aerodynamic resistance for water vapor [s/m], above canopy + ) +! ---------------------------------------------------------------------- + + ! ZTFC: RATIO OF ZOH/ZOM LESS OR EQUAL THAN 1 + ! C......ZTFC=0.1 + ! ZilitinkevichCoeff: CONSTANT C IN Zilitinkevich, S. S.1995,:NOTE ABOUT ZT + ILECH = 0 + ZILFC = -ZilitinkevichCoeff * VKRM * SQVISC + ZU = RoughLenMomSfc + RDZ = 1.0 / RefHeightAboveGrd + CXCH = EXCM * RDZ + DTHV = TemperaturePotRefHeight - TemperatureCanopyAir + + ! BELJARS correction of friction velocity u* + DU2 = max(WindSpdRefHeight*WindSpdRefHeight, EPSU2) + BTGH = BTG * HPBL + if ( IterationInd == 1 ) then + if ( (BTGH*ExchCoeffShAbvCan*DTHV) /= 0.0 ) then + FrictionVelVertVeg = WWST2 * abs(BTGH*ExchCoeffShAbvCan*DTHV)**(2.0/3.0) + else + FrictionVelVertVeg = 0.0 + endif + FrictionVelVeg = max(sqrt(ExchCoeffMomAbvCan*sqrt(DU2+FrictionVelVertVeg)), EPSUST) + MoStabParaAbvCan = ELFC * ExchCoeffShAbvCan * DTHV / FrictionVelVeg**3 + endif + + ! ZILITINKEVITCH approach for ZT + ZT = max(1.0e-6, exp(ZILFC*sqrt(FrictionVelVeg*RoughLenMomSfc))*RoughLenMomSfc) + ZSLU = RefHeightAboveGrd + ZU + ZSLT = RefHeightAboveGrd + ZT + RLOGU = log(ZSLU/ZU) + RLOGT = log(ZSLT/ZT) + + ! Monin-Obukhov length scale + ZETALT = max(ZSLT*MoStabParaAbvCan, ZTMIN) + MoStabParaAbvCan = ZETALT / ZSLT + ZETALU = ZSLU * MoStabParaAbvCan + ZETAU = ZU * MoStabParaAbvCan + ZETAT = ZT * MoStabParaAbvCan + if ( ILECH == 0 ) then + if ( MoStabParaAbvCan < 0.0 ) then + XLU4 = 1.0 - 16.0 * ZETALU + XLT4 = 1.0 - 16.0 * ZETALT + XU4 = 1.0 - 16.0 * ZETAU + XT4 = 1.0 - 16.0 * ZETAT + XLU = sqrt(sqrt(XLU4)) + XLT = sqrt(sqrt(XLT4)) + XU = sqrt(sqrt(XU4)) + XT = sqrt(sqrt(XT4)) + PSMZ = PSPMU(XU) + SIMM = PSPMU(XLU) - PSMZ + RLOGU + PSHZ = PSPHU(XT) + SIMH = PSPHU(XLT) - PSHZ + RLOGT + else + ZETALU = min(ZETALU, ZTMAX) + ZETALT = min(ZETALT, ZTMAX) + ZETAU = min(ZETAU, ZTMAX/(ZSLU/ZU)) ! Barlage: add limit on ZETAU/ZETAT + ZETAT = min(ZETAT, ZTMAX/(ZSLT/ZT)) ! Barlage: prevent SIMM/SIMH < 0 + PSMZ = PSPMS(ZETAU) + SIMM = PSPMS(ZETALU) - PSMZ + RLOGU + PSHZ = PSPHS(ZETAT) + SIMH = PSPHS(ZETALT) - PSHZ + RLOGT + endif + else ! LECH's functions + if ( MoStabParaAbvCan < 0.0 ) then + PSMZ = PSLMU(ZETAU) + SIMM = PSLMU(ZETALU) - PSMZ + RLOGU + PSHZ = PSLHU(ZETAT) + SIMH = PSLHU(ZETALT) - PSHZ + RLOGT + else + ZETALU = min(ZETALU, ZTMAX) + ZETALT = min(ZETALT, ZTMAX) + PSMZ = PSLMS(ZETAU) + SIMM = PSLMS(ZETALU) - PSMZ + RLOGU + PSHZ = PSLHS(ZETAT) + SIMH = PSLHS(ZETALT) - PSHZ + RLOGT + endif + endif + + ! BELJARS correction of friction velocity u* + FrictionVelVeg = max(sqrt(ExchCoeffMomAbvCan*sqrt(DU2+FrictionVelVertVeg)), EPSUST) + + ! ZILITINKEVITCH fix for ZT + ZT = max(1.0e-6, exp(ZILFC*sqrt(FrictionVelVeg*RoughLenMomSfc))*RoughLenMomSfc) + ZSLT = RefHeightAboveGrd + ZT + RLOGT = log(ZSLT/ZT) + USTARK = FrictionVelVeg * VKRM + + ! avoid tangent linear problems near zero + if ( SIMM < 1.0e-6 ) SIMM = 1.0e-6 ! Limit stability function + ExchCoeffMomAbvCan = max(USTARK/SIMM, CXCH) + if ( SIMH < 1.0e-6 ) SIMH = 1.0e-6 ! Limit stability function + ExchCoeffShAbvCan = max(USTARK/SIMH, CXCH) + + ! update vertical friction velocity w* + if ( (BTGH*ExchCoeffShAbvCan*DTHV) /= 0.0 ) then + FrictionVelVertVeg = WWST2 * abs(BTGH*ExchCoeffShAbvCan*DTHV)**(2.0/3.0) + else + FrictionVelVertVeg = 0.0 + endif + + ! update M-O stability parameter + RLMN = ELFC * ExchCoeffShAbvCan * DTHV / FrictionVelVeg**3 + RLMA = MoStabParaAbvCan * WOLD + RLMN * WNEW + MoStabParaAbvCan = RLMA + + ! Undo the multiplication by windspeed that applies to exchange coeff + ExchCoeffShAbvCan = ExchCoeffShAbvCan / WindSpdRefHeight + ExchCoeffMomAbvCan = ExchCoeffMomAbvCan / WindSpdRefHeight + + ! compute aerodynamic resistance + ResistanceMomAbvCan = max(1.0, 1.0/(ExchCoeffMomAbvCan*WindSpdRefHeight)) + ResistanceShAbvCan = max(1.0, 1.0/(ExchCoeffShAbvCan*WindSpdRefHeight)) + ResistanceLhAbvCan = ResistanceShAbvCan + + end associate + + end subroutine ResistanceAboveCanopyChen97 + +end module ResistanceAboveCanopyChen97Mod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/ResistanceAboveCanopyMostMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/ResistanceAboveCanopyMostMod.F90 new file mode 100644 index 000000000..f257c3974 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/ResistanceAboveCanopyMostMod.F90 @@ -0,0 +1,176 @@ +module ResistanceAboveCanopyMostMod + +!!! Compute surface resistance and drag coefficient for momentum and heat +!!! based on Monin-Obukhov (M-O) Similarity Theory (MOST) + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine ResistanceAboveCanopyMOST(noahmp, IterationInd, HeatSensibleTmp, MoStabParaSgn) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: SFCDIF1 for vegetated portion +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + integer , intent(in ) :: IterationInd ! iteration index + integer , intent(inout) :: MoStabParaSgn ! number of times moz changes sign + real(kind=kind_noahmp), intent(in ) :: HeatSensibleTmp ! temporary sensible heat flux (w/m2) in each iteration + type(noahmp_type) , intent(inout) :: noahmp + +! local variable + real(kind=kind_noahmp) :: MPE ! prevents overflow for division by zero + real(kind=kind_noahmp) :: TMPCM ! temporary calculation for ExchCoeffMomAbvCan + real(kind=kind_noahmp) :: TMPCH ! temporary calculation for CH + real(kind=kind_noahmp) :: FMNEW ! stability correction factor, momentum, for current moz + real(kind=kind_noahmp) :: FHNEW ! stability correction factor, sen heat, for current moz + real(kind=kind_noahmp) :: MOZOLD ! Monin-Obukhov stability parameter from prior iteration + real(kind=kind_noahmp) :: TMP1,TMP2,TMP3,TMP4,TMP5 ! temporary calculation + real(kind=kind_noahmp) :: TVIR ! temporary virtual temperature [K] + real(kind=kind_noahmp) :: TMPCM2 ! temporary calculation for CM2 + real(kind=kind_noahmp) :: TMPCH2 ! temporary calculation for CH2 + real(kind=kind_noahmp) :: FM2NEW ! stability correction factor, momentum, for current moz + real(kind=kind_noahmp) :: FH2NEW ! stability correction factor, sen heat, for current moz + real(kind=kind_noahmp) :: TMP12,TMP22,TMP32 ! temporary calculation + real(kind=kind_noahmp) :: CMFM, CHFH, CM2FM2, CH2FH2 ! temporary calculation + +! -------------------------------------------------------------------- + associate( & + TemperatureAirRefHeight => noahmp%forcing%TemperatureAirRefHeight ,& ! in, air temperature [K] at reference height + SpecHumidityRefHeight => noahmp%forcing%SpecHumidityRefHeight ,& ! in, specific humidity [kg/kg] at reference height + RefHeightAboveGrd => noahmp%energy%state%RefHeightAboveGrd ,& ! in, reference height [m] above ground + DensityAirRefHeight => noahmp%energy%state%DensityAirRefHeight ,& ! in, density air [kg/m3] + WindSpdRefHeight => noahmp%energy%state%WindSpdRefHeight ,& ! in, wind speed [m/s] at reference height + ZeroPlaneDispSfc => noahmp%energy%state%ZeroPlaneDispSfc ,& ! in, zero plane displacement [m] + RoughLenShCanopy => noahmp%energy%state%RoughLenShCanopy ,& ! in, roughness length [m], sensible heat, vegetated + RoughLenMomSfc => noahmp%energy%state%RoughLenMomSfc ,& ! in, roughness length [m], momentum, surface + MoStabCorrMomAbvCan => noahmp%energy%state%MoStabCorrMomAbvCan ,& ! inout, M-O momentum stability correction, above ZeroPlaneDispSfc, vegetated + MoStabCorrShAbvCan => noahmp%energy%state%MoStabCorrShAbvCan ,& ! inout, M-O sen heat stability correction, above ZeroPlaneDispSfc, vegetated + MoStabCorrMomVeg2m => noahmp%energy%state%MoStabCorrMomVeg2m ,& ! inout, M-O momentum stability correction, 2m, vegetated + MoStabCorrShVeg2m => noahmp%energy%state%MoStabCorrShVeg2m ,& ! inout, M-O sen heat stability correction, 2m, vegetated + MoStabParaAbvCan => noahmp%energy%state%MoStabParaAbvCan ,& ! inout, Monin-Obukhov stability (z/L), above ZeroPlaneDispSfc, vegetated + FrictionVelVeg => noahmp%energy%state%FrictionVelVeg ,& ! inout, friction velocity [m/s], vegetated + MoStabParaVeg2m => noahmp%energy%state%MoStabParaVeg2m ,& ! out, Monin-Obukhov stability (z/L), 2m, vegetated + MoLengthAbvCan => noahmp%energy%state%MoLengthAbvCan ,& ! out, Monin-Obukhov length [m], above ZeroPlaneDispSfc, vegetated + ExchCoeffMomAbvCan => noahmp%energy%state%ExchCoeffMomAbvCan ,& ! out, drag coefficient for momentum, above ZeroPlaneDispSfc, vegetated + ExchCoeffShAbvCan => noahmp%energy%state%ExchCoeffShAbvCan ,& ! out, exchange coefficient for heat, above ZeroPlaneDispSfc, vegetated + ExchCoeffSh2mVegMo => noahmp%energy%state%ExchCoeffSh2mVegMo ,& ! out, exchange coefficient for heat, 2m, vegetated + ResistanceMomAbvCan => noahmp%energy%state%ResistanceMomAbvCan ,& ! out, aerodynamic resistance for momentum [s/m], above canopy + ResistanceShAbvCan => noahmp%energy%state%ResistanceShAbvCan ,& ! out, aerodynamic resistance for sensible heat [s/m], above canopy + ResistanceLhAbvCan => noahmp%energy%state%ResistanceLhAbvCan & ! out, aerodynamic resistance for water vapor [s/m], above canopy + ) +! ---------------------------------------------------------------------- + + ! initialization + MPE = 1.0e-6 + MOZOLD = MoStabParaAbvCan ! M-O stability parameter for next iteration + if ( RefHeightAboveGrd <= ZeroPlaneDispSfc ) then + write(*,*) "WARNING: critical problem: RefHeightAboveGrd <= ZeroPlaneDispSfc; model stops" + stop "Error in ResistanceAboveCanopyMostMod.F90" + endif + + ! temporary drag coefficients + TMPCM = log((RefHeightAboveGrd - ZeroPlaneDispSfc) / RoughLenMomSfc) + TMPCH = log((RefHeightAboveGrd - ZeroPlaneDispSfc) / RoughLenShCanopy) + TMPCM2 = log((2.0 + RoughLenMomSfc) / RoughLenMomSfc) + TMPCH2 = log((2.0 + RoughLenShCanopy) / RoughLenShCanopy) + + ! compute M-O stability parameter + if ( IterationInd == 1 ) then + FrictionVelVeg = 0.0 + MoStabParaAbvCan = 0.0 + MoLengthAbvCan = 0.0 + MoStabParaVeg2m = 0.0 + else + TVIR = (1.0 + 0.61*SpecHumidityRefHeight) * TemperatureAirRefHeight + TMP1 = ConstVonKarman * (ConstGravityAcc/TVIR) * HeatSensibleTmp / (DensityAirRefHeight*ConstHeatCapacAir) + if ( abs(TMP1) <= MPE ) TMP1 = MPE + MoLengthAbvCan = -1.0 * FrictionVelVeg**3 / TMP1 + MoStabParaAbvCan = min((RefHeightAboveGrd - ZeroPlaneDispSfc) / MoLengthAbvCan, 1.0) + MoStabParaVeg2m = min((2.0 + RoughLenShCanopy) / MoLengthAbvCan, 1.0) + endif + + ! accumulate number of times moz changes sign. + if ( MOZOLD*MoStabParaAbvCan < 0.0 ) MoStabParaSgn = MoStabParaSgn + 1 + if ( MoStabParaSgn >= 2 ) then + MoStabParaAbvCan = 0.0 + MoStabCorrMomAbvCan = 0.0 + MoStabCorrShAbvCan = 0.0 + MoStabParaVeg2m = 0.0 + MoStabCorrMomVeg2m = 0.0 + MoStabCorrShVeg2m = 0.0 + endif + + ! evaluate stability-dependent variables using moz from prior iteration + if ( MoStabParaAbvCan < 0.0 ) then + TMP1 = (1.0 - 16.0 * MoStabParaAbvCan)**0.25 + TMP2 = log((1.0 + TMP1*TMP1) / 2.0) + TMP3 = log((1.0 + TMP1) / 2.0) + FMNEW = 2.0 * TMP3 + TMP2 - 2.0 * atan(TMP1) + 1.5707963 + FHNEW = 2 * TMP2 + ! 2-meter quantities + TMP12 = (1.0 - 16.0 * MoStabParaVeg2m)**0.25 + TMP22 = log((1.0 + TMP12*TMP12) / 2.0) + TMP32 = log((1.0 + TMP12) / 2.0) + FM2NEW = 2.0 * TMP32 + TMP22 - 2.0 * atan(TMP12) + 1.5707963 + FH2NEW = 2 * TMP22 + else + FMNEW = -5.0 * MoStabParaAbvCan + FHNEW = FMNEW + FM2NEW = -5.0 * MoStabParaVeg2m + FH2NEW = FM2NEW + endif + + ! except for first iteration, weight stability factors for previous + ! iteration to help avoid flip-flops from one iteration to the next + if ( IterationInd == 1 ) then + MoStabCorrMomAbvCan = FMNEW + MoStabCorrShAbvCan = FHNEW + MoStabCorrMomVeg2m = FM2NEW + MoStabCorrShVeg2m = FH2NEW + else + MoStabCorrMomAbvCan = 0.5 * (MoStabCorrMomAbvCan + FMNEW) + MoStabCorrShAbvCan = 0.5 * (MoStabCorrShAbvCan + FHNEW) + MoStabCorrMomVeg2m = 0.5 * (MoStabCorrMomVeg2m + FM2NEW) + MoStabCorrShVeg2m = 0.5 * (MoStabCorrShVeg2m + FH2NEW) + endif + + ! exchange coefficients + MoStabCorrShAbvCan = min(MoStabCorrShAbvCan , 0.9*TMPCH) + MoStabCorrMomAbvCan = min(MoStabCorrMomAbvCan, 0.9*TMPCM) + MoStabCorrShVeg2m = min(MoStabCorrShVeg2m , 0.9*TMPCH2) + MoStabCorrMomVeg2m = min(MoStabCorrMomVeg2m , 0.9*TMPCM2) + CMFM = TMPCM - MoStabCorrMomAbvCan + CHFH = TMPCH - MoStabCorrShAbvCan + CM2FM2 = TMPCM2 - MoStabCorrMomVeg2m + CH2FH2 = TMPCH2 - MoStabCorrShVeg2m + if ( abs(CMFM) <= MPE ) CMFM = MPE + if ( abs(CHFH) <= MPE ) CHFH = MPE + if ( abs(CM2FM2) <= MPE ) CM2FM2 = MPE + if ( abs(CH2FH2) <= MPE ) CH2FH2 = MPE + ExchCoeffMomAbvCan = ConstVonKarman * ConstVonKarman / (CMFM * CMFM) + ExchCoeffShAbvCan = ConstVonKarman * ConstVonKarman / (CMFM * CHFH) + !ExchCoeffSh2mVegMo = ConstVonKarman * ConstVonKarman / (CM2FM2 * CH2FH2) + + ! friction velocity + FrictionVelVeg = WindSpdRefHeight * sqrt(ExchCoeffMomAbvCan) + ExchCoeffSh2mVegMo = ConstVonKarman * FrictionVelVeg / CH2FH2 + + ! aerodynamic resistance + ResistanceMomAbvCan = max(1.0, 1.0/(ExchCoeffMomAbvCan*WindSpdRefHeight)) + ResistanceShAbvCan = max(1.0, 1.0/(ExchCoeffShAbvCan*WindSpdRefHeight)) + ResistanceLhAbvCan = ResistanceShAbvCan + + end associate + + end subroutine ResistanceAboveCanopyMOST + +end module ResistanceAboveCanopyMostMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/ResistanceBareGroundChen97Mod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/ResistanceBareGroundChen97Mod.F90 new file mode 100644 index 000000000..f3510ce0e --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/ResistanceBareGroundChen97Mod.F90 @@ -0,0 +1,215 @@ +module ResistanceBareGroundChen97Mod + +!!! Compute bare ground resistance and exchange coefficient for momentum and heat +!!! based on Chen et al. (1997, BLM) +!!! This scheme can handle both over open water and over solid surface + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine ResistanceBareGroundChen97(noahmp, IndIter) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: SFCDIF2 for bare ground portion +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + +! in & out variables + integer , intent(in ) :: IndIter ! iteration index + type(noahmp_type) , intent(inout) :: noahmp + +! local variables + integer :: ILECH, ITR + real(kind=kind_noahmp) :: ZZ, PSLMU, PSLMS, PSLHU, PSLHS + real(kind=kind_noahmp) :: XX, PSPMU, YY, PSPMS, PSPHU, PSPHS + real(kind=kind_noahmp) :: ZILFC, ZU, ZT, RDZ, CXCH, DTHV, DU2 + real(kind=kind_noahmp) :: BTGH, ZSLU, ZSLT, RLOGU, RLOGT, RLMA + real(kind=kind_noahmp) :: ZETALT, ZETALU, ZETAU, ZETAT, XLU4 + real(kind=kind_noahmp) :: XLT4, XU4, XT4, XLU, XLT, XU, XT + real(kind=kind_noahmp) :: PSMZ, SIMM, PSHZ, SIMH, USTARK, RLMN +! local parameters + integer , parameter :: ITRMX = 5 + real(kind=kind_noahmp), parameter :: WWST = 1.2 + real(kind=kind_noahmp), parameter :: WWST2 = WWST * WWST + real(kind=kind_noahmp), parameter :: VKRM = 0.40 + real(kind=kind_noahmp), parameter :: EXCM = 0.001 + real(kind=kind_noahmp), parameter :: BETA = 1.0 / 270.0 + real(kind=kind_noahmp), parameter :: BTG = BETA * ConstGravityAcc + real(kind=kind_noahmp), parameter :: ELFC = VKRM * BTG + real(kind=kind_noahmp), parameter :: WOLD = 0.15 + real(kind=kind_noahmp), parameter :: WNEW = 1.0 - WOLD + real(kind=kind_noahmp), parameter :: PIHF = 3.14159265 / 2.0 + real(kind=kind_noahmp), parameter :: EPSU2 = 1.0e-4 + real(kind=kind_noahmp), parameter :: EPSUST = 0.07 + real(kind=kind_noahmp), parameter :: EPSIT = 1.0e-4 + real(kind=kind_noahmp), parameter :: EPSA = 1.0e-8 + real(kind=kind_noahmp), parameter :: ZTMIN = -5.0 + real(kind=kind_noahmp), parameter :: ZTMAX = 1.0 + real(kind=kind_noahmp), parameter :: HPBL = 1000.0 + real(kind=kind_noahmp), parameter :: SQVISC = 258.2 + real(kind=kind_noahmp), parameter :: RIC = 0.183 + real(kind=kind_noahmp), parameter :: RRIC = 1.0 / RIC + real(kind=kind_noahmp), parameter :: FHNEU = 0.8 + real(kind=kind_noahmp), parameter :: RFC = 0.191 + real(kind=kind_noahmp), parameter :: RFAC = RIC / ( FHNEU * RFC * RFC ) +! local statement functions + ! LECH'S surface functions + PSLMU(ZZ) = -0.96 * log(1.0 - 4.5 * ZZ) + PSLMS(ZZ) = ZZ * RRIC - 2.076 * (1.0 - 1.0/(ZZ + 1.0)) + PSLHU(ZZ) = -0.96 * log(1.0 - 4.5 * ZZ) + PSLHS(ZZ) = ZZ * RFAC - 2.076 * (1.0 - 1.0/(ZZ + 1.0)) + ! PAULSON'S surface functions + PSPMU(XX) = -2.0*log( (XX+1.0)*0.5 ) - log( (XX*XX+1.0)*0.5 ) + 2.0*atan(XX) - PIHF + PSPMS(YY) = 5.0 * YY + PSPHU(XX) = -2.0 * log( (XX*XX + 1.0)*0.5 ) + PSPHS(YY) = 5.0 * YY + +! -------------------------------------------------------------------- + associate( & + SnowDepth => noahmp%water%state%SnowDepth ,& ! in, snow depth [m] + ZilitinkevichCoeff => noahmp%energy%param%ZilitinkevichCoeff ,& ! in, Calculate roughness length of heat + RefHeightAboveGrd => noahmp%energy%state%RefHeightAboveGrd ,& ! in, reference height [m] above ground + TemperaturePotRefHeight => noahmp%energy%state%TemperaturePotRefHeight ,& ! in, potential temp at reference height [K] + WindSpdRefHeight => noahmp%energy%state%WindSpdRefHeight ,& ! in, wind speed [m/s] at reference height + RoughLenMomGrd => noahmp%energy%state%RoughLenMomGrd ,& ! in, roughness length [m], momentum, ground + TemperatureGrdBare => noahmp%energy%state%TemperatureGrdBare ,& ! in, bare ground temperature [K] + ExchCoeffMomBare => noahmp%energy%state%ExchCoeffMomBare ,& ! inout, exchange coeff [m/s] momentum, above ZeroPlaneDisp, bare ground + ExchCoeffShBare => noahmp%energy%state%ExchCoeffShBare ,& ! inout, exchange coeff [m/s] for heat, above ZeroPlaneDisp, bare ground + MoStabParaBare => noahmp%energy%state%MoStabParaBare ,& ! inout, Monin-Obukhov stability (z/L), above ZeroPlaneDisp, bare ground + FrictionVelVertBare => noahmp%energy%state%FrictionVelVertBare ,& ! inout, friction velocity [m/s] in vertical direction, bare ground + FrictionVelBare => noahmp%energy%state%FrictionVelBare ,& ! inout, friction velocity [m/s], bare ground + ResistanceMomBareGrd => noahmp%energy%state%ResistanceMomBareGrd ,& ! out, aerodynamic resistance for momentum [s/m], bare ground + ResistanceShBareGrd => noahmp%energy%state%ResistanceShBareGrd ,& ! out, aerodynamic resistance for sensible heat [s/m], bare ground + ResistanceLhBareGrd => noahmp%energy%state%ResistanceLhBareGrd & ! out, aerodynamic resistance for water vapor [s/m], bare ground + ) +! ---------------------------------------------------------------------- + + ! ZTFC: RATIO OF ZOH/ZOM LESS OR EQUAL THAN 1 + ! C......ZTFC=0.1 + ! ZilitinkevichCoeff: CONSTANT C IN Zilitinkevich, S. S.1995,:NOTE ABOUT ZT + ILECH = 0 + ZILFC = -ZilitinkevichCoeff * VKRM * SQVISC + ZU = RoughLenMomGrd + RDZ = 1.0 / RefHeightAboveGrd + CXCH = EXCM * RDZ + DTHV = TemperaturePotRefHeight - TemperatureGrdBare + + ! BELJARS correction of friction velocity u* + DU2 = max(WindSpdRefHeight*WindSpdRefHeight, EPSU2) + BTGH = BTG * HPBL + if ( IndIter == 1 ) then + if ( (BTGH*ExchCoeffShBare*DTHV) /= 0.0 ) then + FrictionVelVertBare = WWST2 * abs(BTGH*ExchCoeffShBare*DTHV)**(2.0/3.0) + else + FrictionVelVertBare = 0.0 + endif + FrictionVelBare = max(sqrt(ExchCoeffMomBare*sqrt(DU2+FrictionVelVertBare)), EPSUST) + MoStabParaBare = ELFC * ExchCoeffShBare * DTHV / FrictionVelBare**3 + endif + + ! ZILITINKEVITCH approach for ZT + ZT = max(1.0e-6, exp(ZILFC*sqrt(FrictionVelBare*RoughLenMomGrd))*RoughLenMomGrd) + ZSLU = RefHeightAboveGrd + ZU + ZSLT = RefHeightAboveGrd + ZT + RLOGU = log(ZSLU / ZU) + RLOGT = log(ZSLT / ZT) + + ! Monin-Obukhov length scale + ZETALT = max(ZSLT*MoStabParaBare, ZTMIN) + MoStabParaBare = ZETALT / ZSLT + ZETALU = ZSLU * MoStabParaBare + ZETAU = ZU * MoStabParaBare + ZETAT = ZT * MoStabParaBare + if ( ILECH == 0 ) then + if ( MoStabParaBare < 0.0 ) then + XLU4 = 1.0 - 16.0 * ZETALU + XLT4 = 1.0 - 16.0 * ZETALT + XU4 = 1.0 - 16.0 * ZETAU + XT4 = 1.0 - 16.0 * ZETAT + XLU = sqrt(sqrt(XLU4)) + XLT = sqrt(sqrt(XLT4)) + XU = sqrt(sqrt(XU4)) + XT = sqrt(sqrt(XT4)) + PSMZ = PSPMU(XU) + SIMM = PSPMU(XLU) - PSMZ + RLOGU + PSHZ = PSPHU(XT) + SIMH = PSPHU(XLT) - PSHZ + RLOGT + else + ZETALU = min(ZETALU, ZTMAX) + ZETALT = min(ZETALT, ZTMAX) + ZETAU = min(ZETAU, ZTMAX/(ZSLU/ZU)) ! Barlage: add limit on ZETAU/ZETAT + ZETAT = min(ZETAT, ZTMAX/(ZSLT/ZT)) ! Barlage: prevent SIMM/SIMH < 0 + PSMZ = PSPMS(ZETAU) + SIMM = PSPMS(ZETALU) - PSMZ + RLOGU + PSHZ = PSPHS(ZETAT) + SIMH = PSPHS(ZETALT) - PSHZ + RLOGT + endif + else ! LECH's functions + if ( MoStabParaBare < 0.0 ) then + PSMZ = PSLMU(ZETAU) + SIMM = PSLMU(ZETALU) - PSMZ + RLOGU + PSHZ = PSLHU(ZETAT) + SIMH = PSLHU(ZETALT) - PSHZ + RLOGT + else + ZETALU = min(ZETALU, ZTMAX) + ZETALT = min(ZETALT, ZTMAX) + PSMZ = PSLMS(ZETAU) + SIMM = PSLMS(ZETALU) - PSMZ + RLOGU + PSHZ = PSLHS(ZETAT) + SIMH = PSLHS(ZETALT) - PSHZ + RLOGT + endif + endif + + ! BELJARS correction of friction velocity u* + FrictionVelBare = max(sqrt(ExchCoeffMomBare*sqrt(DU2+FrictionVelVertBare)), EPSUST) + + ! ZILITINKEVITCH fix for ZT + ZT = max(1.0e-6, exp(ZILFC*sqrt(FrictionVelBare*RoughLenMomGrd))*RoughLenMomGrd) + ZSLT = RefHeightAboveGrd + ZT + RLOGT = log(ZSLT/ZT) + USTARK = FrictionVelBare * VKRM + + ! avoid tangent linear problems near zero + if ( SIMM < 1.0e-6 ) SIMM = 1.0e-6 ! Limit stability function + ExchCoeffMomBare = max(USTARK/SIMM, CXCH) + if ( SIMH < 1.0e-6 ) SIMH = 1.0e-6 ! Limit stability function + ExchCoeffShBare = max(USTARK/SIMH, CXCH) + + ! update vertical friction velocity w* + if ( BTGH*ExchCoeffShBare*DTHV /= 0.0 ) then + FrictionVelVertBare = WWST2 * abs(BTGH*ExchCoeffShBare*DTHV)**(2.0/3.0) + else + FrictionVelVertBare = 0.0 + endif + + ! update M-O stability parameter + RLMN = ELFC * ExchCoeffShBare * DTHV / FrictionVelBare**3 + RLMA = MoStabParaBare * WOLD + RLMN * WNEW + MoStabParaBare = RLMA + + ! Undo the multiplication by windspeed that applies to exchange coeff + ExchCoeffShBare = ExchCoeffShBare / WindSpdRefHeight + ExchCoeffMomBare = ExchCoeffMomBare / WindSpdRefHeight + if ( SnowDepth > 0.0 ) then + ExchCoeffMomBare = min(0.01, ExchCoeffMomBare) ! exch coeff is too large, causing + ExchCoeffShBare = min(0.01, ExchCoeffShBare) ! computational instability + endif + + ! compute aerodynamic resistance + ResistanceMomBareGrd = max(1.0, 1.0/(ExchCoeffMomBare*WindSpdRefHeight)) + ResistanceShBareGrd = max(1.0, 1.0/(ExchCoeffShBare*WindSpdRefHeight)) + ResistanceLhBareGrd = ResistanceShBareGrd + + end associate + + end subroutine ResistanceBareGroundChen97 + +end module ResistanceBareGroundChen97Mod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/ResistanceBareGroundMostMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/ResistanceBareGroundMostMod.F90 new file mode 100644 index 000000000..5c47e7437 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/ResistanceBareGroundMostMod.F90 @@ -0,0 +1,177 @@ +module ResistanceBareGroundMostMod + +!!! Compute bare ground resistance and drag coefficient for momentum and heat +!!! based on Monin-Obukhov (M-O) Similarity Theory (MOST) + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine ResistanceBareGroundMOST(noahmp, IndIter, HeatSensibleTmp, MoStabParaSgn) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: SFCDIF1 for bare ground portion +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + +! in & out variables + integer , intent(in ) :: IndIter ! iteration index + integer , intent(inout) :: MoStabParaSgn ! number of times moz changes sign + real(kind=kind_noahmp), intent(in ) :: HeatSensibleTmp ! temporary sensible heat flux (w/m2) in each iteration + type(noahmp_type) , intent(inout) :: noahmp + +! local variable + real(kind=kind_noahmp) :: MPE ! prevents overflow for division by zero + real(kind=kind_noahmp) :: TMPCM ! temporary calculation for CM + real(kind=kind_noahmp) :: TMPCH ! temporary calculation for CH + real(kind=kind_noahmp) :: FMNEW ! stability correction factor, momentum, for current moz + real(kind=kind_noahmp) :: FHNEW ! stability correction factor, sen heat, for current moz + real(kind=kind_noahmp) :: MOZOLD ! Monin-Obukhov stability parameter from prior iteration + real(kind=kind_noahmp) :: TMP1,TMP2,TMP3,TMP4,TMP5 ! temporary calculation + real(kind=kind_noahmp) :: TVIR ! temporary virtual temperature (k) + real(kind=kind_noahmp) :: TMPCM2 ! temporary calculation for CM2 + real(kind=kind_noahmp) :: TMPCH2 ! temporary calculation for CH2 + real(kind=kind_noahmp) :: FM2NEW ! stability correction factor, momentum, for current moz + real(kind=kind_noahmp) :: FH2NEW ! stability correction factor, sen heat, for current moz + real(kind=kind_noahmp) :: TMP12,TMP22,TMP32 ! temporary calculation + real(kind=kind_noahmp) :: CMFM, CHFH, CM2FM2, CH2FH2 ! temporary calculation + +! -------------------------------------------------------------------- + associate( & + TemperatureAirRefHeight => noahmp%forcing%TemperatureAirRefHeight ,& ! in, air temperature [K] at reference height + SpecHumidityRefHeight => noahmp%forcing%SpecHumidityRefHeight ,& ! in, specific humidity [kg/kg] at reference height + RefHeightAboveGrd => noahmp%energy%state%RefHeightAboveGrd ,& ! in, reference height [m] above ground + DensityAirRefHeight => noahmp%energy%state%DensityAirRefHeight ,& ! in, density air [kg/m3] + WindSpdRefHeight => noahmp%energy%state%WindSpdRefHeight ,& ! in, wind speed [m/s] at reference height + ZeroPlaneDispGrd => noahmp%energy%state%ZeroPlaneDispGrd ,& ! in, ground zero plane displacement [m] + RoughLenShBareGrd => noahmp%energy%state%RoughLenShBareGrd ,& ! in, roughness length [m], sensible heat, bare ground + RoughLenMomGrd => noahmp%energy%state%RoughLenMomGrd ,& ! in, roughness length [m], momentum, ground + MoStabCorrMomBare => noahmp%energy%state%MoStabCorrMomBare ,& ! inout, M-O momentum stability correction, above ZeroPlaneDisp, bare ground + MoStabCorrShBare => noahmp%energy%state%MoStabCorrShBare ,& ! inout, M-O sen heat stability correction, above ZeroPlaneDisp, bare ground + MoStabCorrMomBare2m => noahmp%energy%state%MoStabCorrMomBare2m ,& ! inout, M-O momentum stability correction, 2m, bare ground + MoStabCorrShBare2m => noahmp%energy%state%MoStabCorrShBare2m ,& ! inout, M-O sen heat stability correction, 2m, bare ground + FrictionVelBare => noahmp%energy%state%FrictionVelBare ,& ! inout, friction velocity [m/s], bare ground + MoStabParaBare => noahmp%energy%state%MoStabParaBare ,& ! inout, Monin-Obukhov stability (z/L), above ZeroPlaneDisp, bare ground + MoStabParaBare2m => noahmp%energy%state%MoStabParaBare2m ,& ! out, Monin-Obukhov stability (z/L), 2m, bare ground + MoLengthBare => noahmp%energy%state%MoLengthBare ,& ! out, Monin-Obukhov length [m], above ZeroPlaneDisp, bare ground + ExchCoeffMomBare => noahmp%energy%state%ExchCoeffMomBare ,& ! out, exchange coeff [m/s] for momentum, above ZeroPlaneDisp, bare ground + ExchCoeffShBare => noahmp%energy%state%ExchCoeffShBare ,& ! out, exchange coeff [m/s] for heat, above ZeroPlaneDisp, bare ground + ExchCoeffSh2mBareMo => noahmp%energy%state%ExchCoeffSh2mBareMo ,& ! out, exchange coeff [m/s] for heat, 2m, bare ground + ResistanceMomBareGrd => noahmp%energy%state%ResistanceMomBareGrd ,& ! out, aerodynamic resistance for momentum [s/m], bare ground + ResistanceShBareGrd => noahmp%energy%state%ResistanceShBareGrd ,& ! out, aerodynamic resistance for sensible heat [s/m], bare ground + ResistanceLhBareGrd => noahmp%energy%state%ResistanceLhBareGrd & ! out, aerodynamic resistance for water vapor [s/m], bare ground + ) +! ---------------------------------------------------------------------- + + ! initialization + MPE = 1.0e-6 + MOZOLD = MoStabParaBare ! M-O stability parameter for next iteration + if ( RefHeightAboveGrd <= ZeroPlaneDispGrd ) then + write(*,*) "WARNING: critical problem: RefHeightAboveGrd <= ZeroPlaneDispGrd; model stops" + stop "Error in ResistanceBareGroundMostMod.F90" + endif + + ! temporary drag coefficients + TMPCM = log((RefHeightAboveGrd - ZeroPlaneDispGrd) / RoughLenMomGrd) + TMPCH = log((RefHeightAboveGrd - ZeroPlaneDispGrd) / RoughLenShBareGrd) + TMPCM2 = log((2.0 + RoughLenMomGrd) / RoughLenMomGrd) + TMPCH2 = log((2.0 + RoughLenShBareGrd) / RoughLenShBareGrd) + + ! compute M-O stability parameter + if ( IndIter == 1 ) then + FrictionVelBare = 0.0 + MoStabParaBare = 0.0 + MoLengthBare = 0.0 + MoStabParaBare2m = 0.0 + else + TVIR = (1.0 + 0.61*SpecHumidityRefHeight) * TemperatureAirRefHeight + TMP1 = ConstVonKarman * (ConstGravityAcc/TVIR) * HeatSensibleTmp / (DensityAirRefHeight*ConstHeatCapacAir) + if ( abs(TMP1) <= MPE ) TMP1 = MPE + MoLengthBare = -1.0 * FrictionVelBare**3 / TMP1 + MoStabParaBare = min((RefHeightAboveGrd - ZeroPlaneDispGrd) / MoLengthBare, 1.0) + MoStabParaBare2m = min((2.0 + RoughLenShBareGrd) / MoLengthBare, 1.0) + endif + + ! accumulate number of times moz changes sign. + if ( MOZOLD*MoStabParaBare < 0.0 ) MoStabParaSgn = MoStabParaSgn + 1 + if ( MoStabParaSgn >= 2 ) then + MoStabParaBare = 0.0 + MoStabCorrMomBare = 0.0 + MoStabCorrShBare = 0.0 + MoStabParaBare2m = 0.0 + MoStabCorrMomBare2m = 0.0 + MoStabCorrShBare2m = 0.0 + endif + + ! evaluate stability-dependent variables using moz from prior iteration + if ( MoStabParaBare < 0.0 ) then + TMP1 = (1.0 - 16.0 * MoStabParaBare)**0.25 + TMP2 = log((1.0 + TMP1*TMP1) / 2.0) + TMP3 = log((1.0 + TMP1) / 2.0) + FMNEW = 2.0 * TMP3 + TMP2 - 2.0 * atan(TMP1) + 1.5707963 + FHNEW = 2 * TMP2 + ! 2-meter quantities + TMP12 = (1.0 - 16.0 * MoStabParaBare2m)**0.25 + TMP22 = log((1.0 + TMP12*TMP12) / 2.0) + TMP32 = log((1.0 + TMP12) / 2.0) + FM2NEW = 2.0 * TMP32 + TMP22 - 2.0 * atan(TMP12) + 1.5707963 + FH2NEW = 2 * TMP22 + else + FMNEW = -5.0 * MoStabParaBare + FHNEW = FMNEW + FM2NEW = -5.0 * MoStabParaBare2m + FH2NEW = FM2NEW + endif + + ! except for first iteration, weight stability factors for previous + ! iteration to help avoid flip-flops from one iteration to the next + if ( IndIter == 1 ) then + MoStabCorrMomBare = FMNEW + MoStabCorrShBare = FHNEW + MoStabCorrMomBare2m = FM2NEW + MoStabCorrShBare2m = FH2NEW + else + MoStabCorrMomBare = 0.5 * (MoStabCorrMomBare + FMNEW) + MoStabCorrShBare = 0.5 * (MoStabCorrShBare + FHNEW) + MoStabCorrMomBare2m = 0.5 * (MoStabCorrMomBare2m + FM2NEW) + MoStabCorrShBare2m = 0.5 * (MoStabCorrShBare2m + FH2NEW) + endif + + ! exchange coefficients + MoStabCorrShBare = min(MoStabCorrShBare , 0.9*TMPCH ) + MoStabCorrMomBare = min(MoStabCorrMomBare , 0.9*TMPCM ) + MoStabCorrShBare2m = min(MoStabCorrShBare2m , 0.9*TMPCH2) + MoStabCorrMomBare2m = min(MoStabCorrMomBare2m, 0.9*TMPCM2) + CMFM = TMPCM - MoStabCorrMomBare + CHFH = TMPCH - MoStabCorrShBare + CM2FM2 = TMPCM2 - MoStabCorrMomBare2m + CH2FH2 = TMPCH2 - MoStabCorrShBare2m + if ( abs(CMFM) <= MPE ) CMFM = MPE + if ( abs(CHFH) <= MPE ) CHFH = MPE + if ( abs(CM2FM2) <= MPE ) CM2FM2 = MPE + if ( abs(CH2FH2) <= MPE ) CH2FH2 = MPE + ExchCoeffMomBare = ConstVonKarman * ConstVonKarman / (CMFM * CMFM) + ExchCoeffShBare = ConstVonKarman * ConstVonKarman / (CMFM * CHFH) + !ExchCoeffSh2mBareMo = ConstVonKarman * ConstVonKarman / (CM2FM2 * CH2FH2) + + ! friction velocity + FrictionVelBare = WindSpdRefHeight * sqrt(ExchCoeffMomBare) + ExchCoeffSh2mBareMo = ConstVonKarman * FrictionVelBare / CH2FH2 + + ! aerodynamic resistance + ResistanceMomBareGrd = max(1.0, 1.0/(ExchCoeffMomBare*WindSpdRefHeight)) + ResistanceShBareGrd = max(1.0, 1.0/(ExchCoeffShBare*WindSpdRefHeight)) + ResistanceLhBareGrd = ResistanceShBareGrd + + end associate + + end subroutine ResistanceBareGroundMOST + +end module ResistanceBareGroundMostMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/ResistanceCanopyStomataBallBerryMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/ResistanceCanopyStomataBallBerryMod.F90 new file mode 100644 index 000000000..d479bec04 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/ResistanceCanopyStomataBallBerryMod.F90 @@ -0,0 +1,173 @@ +module ResistanceCanopyStomataBallBerryMod + +!!! Compute canopy stomatal resistance and foliage photosynthesis based on Ball-Berry scheme + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine ResistanceCanopyStomataBallBerry(noahmp, IndexShade) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: STOMATA +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + integer , intent(in ) :: IndexShade ! index for sunlit/shaded (0=sunlit;1=shaded) + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: IndIter ! iteration index + integer, parameter :: NumIter = 3 ! number of iterations + real(kind=kind_noahmp) :: RadPhotoActAbsTmp ! temporary absorbed par for leaves [W/m2] + real(kind=kind_noahmp) :: ResistanceStomataTmp ! temporary leaf stomatal resistance [s/m] + real(kind=kind_noahmp) :: PhotosynLeafTmp ! temporary leaf photosynthesis [umol co2/m2/s] + real(kind=kind_noahmp) :: NitrogenFoliageFac ! foliage nitrogen adjustment factor (0 to 1) + real(kind=kind_noahmp) :: CarboxylRateMax ! maximum rate of carbonylation [umol co2/m2/s] + real(kind=kind_noahmp) :: MPE ! prevents overflow for division by zero + real(kind=kind_noahmp) :: RLB ! boundary layer resistance [s m2 / umol] + real(kind=kind_noahmp) :: TC ! foliage temperature [deg C] + real(kind=kind_noahmp) :: CS ! co2 concentration at leaf surface [Pa] + real(kind=kind_noahmp) :: KC ! co2 Michaelis-Menten constant [Pa] + real(kind=kind_noahmp) :: KO ! o2 Michaelis-Menten constant [Pa] + real(kind=kind_noahmp) :: A,B,C,Q ! intermediate calculations for RS + real(kind=kind_noahmp) :: R1,R2 ! roots for RS + real(kind=kind_noahmp) :: PPF ! absorb photosynthetic photon flux [umol photons/m2/s] + real(kind=kind_noahmp) :: WC ! Rubisco limited photosynthesis [umol co2/m2/s] + real(kind=kind_noahmp) :: WJ ! light limited photosynthesis [umol co2/m2/s] + real(kind=kind_noahmp) :: WE ! export limited photosynthesis [umol co2/m2/s] + real(kind=kind_noahmp) :: CP ! co2 compensation point [Pa] + real(kind=kind_noahmp) :: CI ! internal co2 [Pa] + real(kind=kind_noahmp) :: AWC ! intermediate calculation for wc + real(kind=kind_noahmp) :: J ! electron transport [umol co2/m2/s] + real(kind=kind_noahmp) :: CEA ! constrain ea or else model blows up + real(kind=kind_noahmp) :: CF ! [s m2/umol] -> [s/m] + real(kind=kind_noahmp) :: T ! temporary var +! local statement functions + real(kind=kind_noahmp) :: F1 ! generic temperature response (statement function) + real(kind=kind_noahmp) :: F2 ! generic temperature inhibition (statement function) + real(kind=kind_noahmp) :: AB ! used in statement functions + real(kind=kind_noahmp) :: BC ! used in statement functions + F1(AB, BC) = AB**( (BC - 25.0) / 10.0 ) + F2(AB) = 1.0 + exp( (-2.2e05 + 710.0 * (AB + 273.16)) / (8.314 * (AB + 273.16)) ) + +! -------------------------------------------------------------------- + associate( & + PressureAirRefHeight => noahmp%forcing%PressureAirRefHeight ,& ! in, air pressure [Pa] at reference height + TemperatureAirRefHeight => noahmp%forcing%TemperatureAirRefHeight ,& ! in, air temperature [K] at reference height + SoilTranspFacAcc => noahmp%water%state%SoilTranspFacAcc ,& ! in, accumulated soil water transpiration factor (0 to 1) + IndexGrowSeason => noahmp%biochem%state%IndexGrowSeason ,& ! in, growing season index (0=off, 1=on) + NitrogenConcFoliage => noahmp%biochem%state%NitrogenConcFoliage ,& ! in, foliage nitrogen concentration [%] + NitrogenConcFoliageMax => noahmp%biochem%param%NitrogenConcFoliageMax ,& ! in, foliage nitrogen concentration when f(n)=1 [%] + QuantumEfficiency25C => noahmp%biochem%param%QuantumEfficiency25C ,& ! in, quantum efficiency at 25c [umol co2 / umol photon] + CarboxylRateMax25C => noahmp%biochem%param%CarboxylRateMax25C ,& ! in, maximum rate of carboxylation at 25c [umol co2/m**2/s] + CarboxylRateMaxQ10 => noahmp%biochem%param%CarboxylRateMaxQ10 ,& ! in, change in maximum rate of carboxylation for each 10C temp change + PhotosynPathC3 => noahmp%biochem%param%PhotosynPathC3 ,& ! in, C3 photosynthetic pathway indicator: 0. = c4, 1. = c3 + SlopeConductToPhotosyn => noahmp%biochem%param%SlopeConductToPhotosyn ,& ! in, slope of conductance-to-photosynthesis relationship + Co2MmConst25C => noahmp%energy%param%Co2MmConst25C ,& ! in, co2 michaelis-menten constant at 25c [Pa] + O2MmConst25C => noahmp%energy%param%O2MmConst25C ,& ! in, o2 michaelis-menten constant at 25c [Pa] + Co2MmConstQ10 => noahmp%energy%param%Co2MmConstQ10 ,& ! in, q10 for Co2MmConst25C + O2MmConstQ10 => noahmp%energy%param%O2MmConstQ10 ,& ! in, q10 for ko25 + ConductanceLeafMin => noahmp%energy%param%ConductanceLeafMin ,& ! in, minimum leaf conductance [umol/m**2/s] + TemperatureCanopy => noahmp%energy%state%TemperatureCanopy ,& ! in, vegetation temperature [K] + VapPresSatCanopy => noahmp%energy%state%VapPresSatCanopy ,& ! in, canopy saturation vapor pressure at TV [Pa] + PressureVaporCanAir => noahmp%energy%state%PressureVaporCanAir ,& ! in, canopy air vapor pressure [Pa] + PressureAtmosO2 => noahmp%energy%state%PressureAtmosO2 ,& ! in, atmospheric o2 pressure [Pa] + PressureAtmosCO2 => noahmp%energy%state%PressureAtmosCO2 ,& ! in, atmospheric co2 pressure [Pa] + ResistanceLeafBoundary => noahmp%energy%state%ResistanceLeafBoundary ,& ! in, leaf boundary layer resistance [s/m] + VegFrac => noahmp%energy%state%VegFrac ,& ! in, greeness vegetation fraction + RadPhotoActAbsSunlit => noahmp%energy%flux%RadPhotoActAbsSunlit ,& ! in, average absorbed par for sunlit leaves [W/m2] + RadPhotoActAbsShade => noahmp%energy%flux%RadPhotoActAbsShade ,& ! in, average absorbed par for shaded leaves [W/m2] + ResistanceStomataSunlit => noahmp%energy%state%ResistanceStomataSunlit ,& ! out, sunlit leaf stomatal resistance [s/m] + ResistanceStomataShade => noahmp%energy%state%ResistanceStomataShade ,& ! out, shaded leaf stomatal resistance [s/m] + PhotosynLeafSunlit => noahmp%biochem%flux%PhotosynLeafSunlit ,& ! out, sunlit leaf photosynthesis [umol co2/m2/s] + PhotosynLeafShade => noahmp%biochem%flux%PhotosynLeafShade & ! out, shaded leaf photosynthesis [umol co2/m2/s] + ) +! ---------------------------------------------------------------------- + + ! initialization + MPE = 1.0e-6 + + ! initialize ResistanceStomata=maximum value and photosynthesis=0 because will only do calculations + ! for RadPhotoActAbs > 0, in which case ResistanceStomata <= maximum value and photosynthesis >= 0 + CF = PressureAirRefHeight / (8.314 * TemperatureAirRefHeight) * 1.0e06 ! unit conversion factor + ResistanceStomataTmp = 1.0 / ConductanceLeafMin * CF + PhotosynLeafTmp = 0.0 + if ( IndexShade == 0 ) RadPhotoActAbsTmp = RadPhotoActAbsSunlit / max(VegFrac,1.0e-6) ! Sunlit case + if ( IndexShade == 1 ) RadPhotoActAbsTmp = RadPhotoActAbsShade / max(VegFrac,1.0e-6) ! Shaded case + + ! only compute when there is radiation absorption + if ( RadPhotoActAbsTmp > 0.0 ) then + + NitrogenFoliageFac = min(NitrogenConcFoliage/max(MPE, NitrogenConcFoliageMax), 1.0) + TC = TemperatureCanopy - ConstFreezePoint + PPF = 4.6 * RadPhotoActAbsTmp + J = PPF * QuantumEfficiency25C + KC = Co2MmConst25C * F1(Co2MmConstQ10, TC) + KO = O2MmConst25C * F1(O2MmConstQ10, TC) + AWC = KC * ( 1.0 + PressureAtmosO2 / KO ) + CP = 0.5 * KC / KO * PressureAtmosO2 * 0.21 + CarboxylRateMax = CarboxylRateMax25C / F2(TC) * NitrogenFoliageFac * & + SoilTranspFacAcc * F1(CarboxylRateMaxQ10, TC) + ! first guess ci + CI = 0.7 * PressureAtmosCO2 * PhotosynPathC3 + 0.4 * PressureAtmosCO2 * (1.0 - PhotosynPathC3) + ! ResistanceLeafBoundary: s/m -> s m**2 / umol + RLB = ResistanceLeafBoundary / CF + ! constrain PressureVaporCanAir + CEA = max(0.25*VapPresSatCanopy*PhotosynPathC3 + 0.40*VapPresSatCanopy*(1.0-PhotosynPathC3), & + min(PressureVaporCanAir,VapPresSatCanopy)) + + ! ci iteration + do IndIter = 1, NumIter + WJ = max(CI-CP, 0.0) * J / (CI + 2.0*CP) * PhotosynPathC3 + J * (1.0 - PhotosynPathC3) + WC = max(CI-CP, 0.0) * CarboxylRateMax / (CI + AWC) * PhotosynPathC3 + & + CarboxylRateMax * (1.0 - PhotosynPathC3) + WE = 0.5 * CarboxylRateMax * PhotosynPathC3 + & + 4000.0 * CarboxylRateMax * CI / PressureAirRefHeight * (1.0 - PhotosynPathC3) + PhotosynLeafTmp = min(WJ, WC, WE) * IndexGrowSeason + CS = max(PressureAtmosCO2-1.37*RLB*PressureAirRefHeight*PhotosynLeafTmp, MPE) + A = SlopeConductToPhotosyn * PhotosynLeafTmp * PressureAirRefHeight * CEA / & + (CS * VapPresSatCanopy) + ConductanceLeafMin + B = (SlopeConductToPhotosyn * PhotosynLeafTmp * PressureAirRefHeight / CS + ConductanceLeafMin) * & + RLB - 1.0 + C = -RLB + if ( B >= 0.0 ) then + Q = -0.5 * (B + sqrt(B*B-4.0*A*C)) + else + Q = -0.5 * (B - sqrt(B*B-4.0*A*C)) + endif + R1 = Q / A + R2 = C / Q + ResistanceStomataTmp = max(R1, R2) + CI = max(CS-PhotosynLeafTmp*PressureAirRefHeight*1.65*ResistanceStomataTmp, 0.0) + enddo + + ! ResistanceStomata: s m**2 / umol -> s/m + ResistanceStomataTmp = ResistanceStomataTmp * CF + + endif ! RadPhotoActAbsTmp > 0.0 + + ! assign updated values + ! Sunlit case + if ( IndexShade == 0 ) then + ResistanceStomataSunlit = ResistanceStomataTmp + PhotosynLeafSunlit = PhotosynLeafTmp + endif + ! Shaded case + if ( IndexShade == 1 ) then + ResistanceStomataShade = ResistanceStomataTmp + PhotosynLeafShade = PhotosynLeafTmp + endif + + end associate + + end subroutine ResistanceCanopyStomataBallBerry + +end module ResistanceCanopyStomataBallBerryMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/ResistanceCanopyStomataJarvisMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/ResistanceCanopyStomataJarvisMod.F90 new file mode 100644 index 000000000..39388bd1c --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/ResistanceCanopyStomataJarvisMod.F90 @@ -0,0 +1,112 @@ +module ResistanceCanopyStomataJarvisMod + +!!! Compute canopy stomatal resistance and foliage photosynthesis based on Jarvis scheme +!!! Canopy resistance which depends on incoming solar radiation, air temperature, +!!! atmospheric water vapor pressure deficit at the lowest model level, and soil moisture (preferably +!!! unfrozen soil moisture rather than total). +!!! Source: Jarvis (1976), Noilhan and Planton (1989), Jacquemin and Noilhan (1990). +!!! See also Chen et al (1996, JGR, Vol 101(D3), 7251-7268): Eqns 12-14 and Table 2 of Sec. 3.1.2 + + use Machine + use NoahmpVarType + use ConstantDefineMod + use HumiditySaturationMod, only : HumiditySaturation + + implicit none + +contains + + subroutine ResistanceCanopyStomataJarvis(noahmp, IndexShade) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: CANRES +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + integer , intent(in ) :: IndexShade ! index for sunlit/shaded (0=sunlit;1=shaded) + type(noahmp_type), intent(inout) :: noahmp + +! local variables + real(kind=kind_noahmp) :: ResistanceVapDef ! canopy resistance multiplier + real(kind=kind_noahmp) :: ResistanceSolar ! canopy resistance multiplier + real(kind=kind_noahmp) :: ResistanceTemp ! canopy resistance multiplier + real(kind=kind_noahmp) :: RadFac ! solar radiation factor for resistance + real(kind=kind_noahmp) :: SpecHumidityTmp ! specific humidity [kg/kg] + real(kind=kind_noahmp) :: MixingRatioTmp ! mixing ratio [kg/kg] + real(kind=kind_noahmp) :: MixingRatioSat ! saturated mixing ratio [kg/kg] + real(kind=kind_noahmp) :: MixingRatioSatTempD ! d(MixingRatioSat)/d(T) + real(kind=kind_noahmp) :: RadPhotoActAbsTmp ! temporary absorbed par for leaves [W/m2] + real(kind=kind_noahmp) :: ResistanceStomataTmp ! temporary leaf stomatal resistance [s/m] + real(kind=kind_noahmp) :: PhotosynLeafTmp ! temporary leaf photosynthesis [umol co2/m2/s] + +! -------------------------------------------------------------------- + associate( & + PressureAirRefHeight => noahmp%forcing%PressureAirRefHeight ,& ! in, air pressure [Pa] at reference height + SoilTranspFacAcc => noahmp%water%state%SoilTranspFacAcc ,& ! in, accumulated soil water transpiration factor (0 to 1) + RadiationStressFac => noahmp%energy%param%RadiationStressFac ,& ! in, Parameter used in radiation stress function + ResistanceStomataMin => noahmp%energy%param%ResistanceStomataMin ,& ! in, Minimum stomatal resistance [s m-1] + ResistanceStomataMax => noahmp%energy%param%ResistanceStomataMax ,& ! in, Maximal stomatal resistance [s m-1] + AirTempOptimTransp => noahmp%energy%param%AirTempOptimTransp ,& ! in, Optimum transpiration air temperature [K] + VaporPresDeficitFac => noahmp%energy%param%VaporPresDeficitFac ,& ! in, Parameter used in vapor pressure deficit function + TemperatureCanopy => noahmp%energy%state%TemperatureCanopy ,& ! in, vegetation temperature [K] + PressureVaporCanAir => noahmp%energy%state%PressureVaporCanAir ,& ! in, canopy air vapor pressure [Pa] + VegFrac => noahmp%energy%state%VegFrac ,& ! in, greeness vegetation fraction + RadPhotoActAbsSunlit => noahmp%energy%flux%RadPhotoActAbsSunlit ,& ! in, average absorbed par for sunlit leaves [W/m2] + RadPhotoActAbsShade => noahmp%energy%flux%RadPhotoActAbsShade ,& ! in, average absorbed par for shaded leaves [W/m2] + ResistanceStomataSunlit => noahmp%energy%state%ResistanceStomataSunlit ,& ! out, sunlit leaf stomatal resistance [s/m] + ResistanceStomataShade => noahmp%energy%state%ResistanceStomataShade ,& ! out, shaded leaf stomatal resistance [s/m] + PhotosynLeafSunlit => noahmp%biochem%flux%PhotosynLeafSunlit ,& ! out, sunlit leaf photosynthesis [umol CO2/m2/s] + PhotosynLeafShade => noahmp%biochem%flux%PhotosynLeafShade & ! out, shaded leaf photosynthesis [umol CO2/m2/s] + ) +! ---------------------------------------------------------------------- + + ! initialization + ResistanceSolar = 0.0 + ResistanceTemp = 0.0 + ResistanceVapDef = 0.0 + ResistanceStomataTmp = 0.0 + if ( IndexShade == 0 ) RadPhotoActAbsTmp = RadPhotoActAbsSunlit / max(VegFrac,1.0e-6) ! Sunlit case + if ( IndexShade == 1 ) RadPhotoActAbsTmp = RadPhotoActAbsShade / max(VegFrac,1.0e-6) ! Shaded case + + ! compute MixingRatioTmp and MixingRatioSat + SpecHumidityTmp = 0.622 * PressureVaporCanAir / (PressureAirRefHeight - 0.378*PressureVaporCanAir) ! specific humidity + MixingRatioTmp = SpecHumidityTmp / (1.0 - SpecHumidityTmp) ! convert to mixing ratio [kg/kg] + call HumiditySaturation(TemperatureCanopy, PressureAirRefHeight, MixingRatioSat, MixingRatioSatTempD) + + ! contribution due to incoming solar radiation + RadFac = 2.0 * RadPhotoActAbsTmp / RadiationStressFac + ResistanceSolar = (RadFac + ResistanceStomataMin/ResistanceStomataMax) / (1.0 + RadFac) + ResistanceSolar = max(ResistanceSolar, 0.0001) + + ! contribution due to air temperature + ResistanceTemp = 1.0 - 0.0016 * ((AirTempOptimTransp - TemperatureCanopy)**2.0) + ResistanceTemp = max(ResistanceTemp, 0.0001) + + ! contribution due to vapor pressure deficit + ResistanceVapDef = 1.0 / (1.0 + VaporPresDeficitFac * max(0.0, MixingRatioSat - MixingRatioTmp)) + ResistanceVapDef = max(ResistanceVapDef, 0.01) + + ! determine canopy resistance due to all factors + ResistanceStomataTmp = ResistanceStomataMin / (ResistanceSolar * ResistanceTemp * ResistanceVapDef * SoilTranspFacAcc) + PhotosynLeafTmp = -999.99 ! photosynthesis not applied for dynamic carbon + + ! assign updated values + ! Sunlit case + if ( IndexShade == 0 ) then + ResistanceStomataSunlit = ResistanceStomataTmp + PhotosynLeafSunlit = PhotosynLeafTmp + endif + ! Shaded case + if ( IndexShade == 1 ) then + ResistanceStomataShade = ResistanceStomataTmp + PhotosynLeafShade = PhotosynLeafTmp + endif + + end associate + + end subroutine ResistanceCanopyStomataJarvis + +end module ResistanceCanopyStomataJarvisMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/ResistanceGroundEvaporationGlacierMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/ResistanceGroundEvaporationGlacierMod.F90 new file mode 100644 index 000000000..389536f64 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/ResistanceGroundEvaporationGlacierMod.F90 @@ -0,0 +1,44 @@ +module ResistanceGroundEvaporationGlacierMod + +!!! Compute glacier surface resistance to ground evaporation/sublimation +!!! It represents the resistance imposed by the molecular diffusion in +!!! surface (as opposed to aerodynamic resistance computed elsewhere in the model) + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine ResistanceGroundEvaporationGlacier(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: None (embedded in ENERGY_GLACIER subroutine) +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + +! in & out variables + type(noahmp_type), intent(inout) :: noahmp + +! local variables + +! -------------------------------------------------------------------- + associate( & + ResistanceGrdEvap => noahmp%energy%state%ResistanceGrdEvap ,& ! out, ground surface resistance [s/m] to evaporation + RelHumidityGrd => noahmp%energy%state%RelHumidityGrd & ! out, raltive humidity in surface glacier/snow air space + ) +! ---------------------------------------------------------------------- + + ResistanceGrdEvap = 1.0 + RelHumidityGrd = 1.0 + + end associate + + end subroutine ResistanceGroundEvaporationGlacier + +end module ResistanceGroundEvaporationGlacierMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/ResistanceGroundEvaporationMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/ResistanceGroundEvaporationMod.F90 new file mode 100644 index 000000000..13a48b63a --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/ResistanceGroundEvaporationMod.F90 @@ -0,0 +1,101 @@ +module ResistanceGroundEvaporationMod + +!!! Compute soil surface resistance to ground evaporation/sublimation +!!! It represents the resistance imposed by the molecular diffusion in soil +!!! surface (as opposed to aerodynamic resistance computed elsewhere in the model) + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine ResistanceGroundEvaporation(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: None (embedded in ENERGY subroutine) +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + +! in & out variables + type(noahmp_type), intent(inout) :: noahmp + +! local variables + real(kind=kind_noahmp) :: SoilEvapFac ! soil water evaporation factor (0- 1) + real(kind=kind_noahmp) :: DrySoilThickness ! Dry-layer thickness [m] for computing RSURF (Sakaguchi and Zeng, 2009) + real(kind=kind_noahmp) :: VapDiffuseRed ! Reduced vapor diffusivity [m2/s] in soil for computing RSURF (SZ09) + real(kind=kind_noahmp) :: SoilMatPotentialSfc ! surface layer soil matric potential [m] + +! -------------------------------------------------------------------- + associate( & + SurfaceType => noahmp%config%domain%SurfaceType ,& ! in, surface type 1-soil; 2-lake + DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth [m] of layer-bottom from soil surface + FlagUrban => noahmp%config%domain%FlagUrban ,& ! in, logical flag for urban grid + OptGroundResistanceEvap => noahmp%config%nmlist%OptGroundResistanceEvap ,& ! in, options for ground resistance to evaporation/sublimation + ResistanceSoilExp => noahmp%energy%param%ResistanceSoilExp ,& ! in, exponent in the shape parameter for soil resistance + ResistanceSnowSfc => noahmp%energy%param%ResistanceSnowSfc ,& ! in, surface resistance for snow [s/m] + SoilMoistureSat => noahmp%water%param%SoilMoistureSat ,& ! in, saturated value of soil moisture [m3/m3] + SoilMoistureWilt => noahmp%water%param%SoilMoistureWilt ,& ! in, wilting point soil moisture [m3/m3] + SoilExpCoeffB => noahmp%water%param%SoilExpCoeffB ,& ! in, soil B parameter + SoilMatPotentialSat => noahmp%water%param%SoilMatPotentialSat ,& ! in, saturated soil matric potential [m] + SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! in, soil water content [m3/m3] + SnowCoverFrac => noahmp%water%state%SnowCoverFrac ,& ! in, snow cover fraction + SnowDepth => noahmp%water%state%SnowDepth ,& ! in, snow depth [m] + TemperatureGrd => noahmp%energy%state%TemperatureGrd ,& ! in, ground temperature [K] + ResistanceGrdEvap => noahmp%energy%state%ResistanceGrdEvap ,& ! out, ground surface resistance [s/m] to evaporation + RelHumidityGrd => noahmp%energy%state%RelHumidityGrd & ! out, raltive humidity in surface soil/snow air space + ) +! ---------------------------------------------------------------------- + + ! initialization + SoilEvapFac = max(0.0, SoilLiqWater(1)/SoilMoistureSat(1)) + + if ( SurfaceType == 2 ) then ! lake point + ResistanceGrdEvap = 1.0 ! avoid being divided by 0 + RelHumidityGrd = 1.0 + else ! soil point + ! Sakaguchi and Zeng, 2009 + if ( (OptGroundResistanceEvap == 1) .or. (OptGroundResistanceEvap == 4) ) then + DrySoilThickness = (-DepthSoilLayer(1)) * (exp((1.0 - min(1.0,SoilLiqWater(1)/SoilMoistureSat(1))) ** & + ResistanceSoilExp) - 1.0) / (2.71828-1.0) + VapDiffuseRed = 2.2e-5 * SoilMoistureSat(1) * SoilMoistureSat(1) * & + (1.0 - SoilMoistureWilt(1)/SoilMoistureSat(1)) ** (2.0 + 3.0/SoilExpCoeffB(1)) + ResistanceGrdEvap = DrySoilThickness / VapDiffuseRed + + ! Sellers (1992) original + elseif ( OptGroundResistanceEvap == 2 ) then + ResistanceGrdEvap = SnowCoverFrac * 1.0 + (1.0 - SnowCoverFrac) * exp(8.25 - 4.225*SoilEvapFac) + + ! Sellers (1992) adjusted to decrease ResistanceGrdEvap for wet soil + elseif ( OptGroundResistanceEvap == 3 ) then + ResistanceGrdEvap = SnowCoverFrac * 1.0 + (1.0 - SnowCoverFrac) * exp(8.25 - 6.0*SoilEvapFac) + endif + + ! SnowCoverFrac weighted; snow ResistanceGrdEvap set in MPTABLE v3.8 + if ( OptGroundResistanceEvap == 4 ) then + ResistanceGrdEvap = 1.0 / (SnowCoverFrac * (1.0/ResistanceSnowSfc) + & + (1.0-SnowCoverFrac) * (1.0/max(ResistanceGrdEvap,0.001))) + endif + if ( (SoilLiqWater(1) < 0.01) .and. (SnowDepth == 0.0) ) ResistanceGrdEvap = 1.0e6 + + SoilMatPotentialSfc = -SoilMatPotentialSat(1) * & + (max(0.01,SoilLiqWater(1)) / SoilMoistureSat(1)) ** (-SoilExpCoeffB(1)) + RelHumidityGrd = SnowCoverFrac + & + (1.0-SnowCoverFrac) * exp(SoilMatPotentialSfc*ConstGravityAcc/(ConstGasWaterVapor*TemperatureGrd)) + endif + + ! urban + if ( (FlagUrban .eqv. .true.) .and. (SnowDepth == 0.0) ) then + ResistanceGrdEvap = 1.0e6 + endif + + end associate + + end subroutine ResistanceGroundEvaporation + +end module ResistanceGroundEvaporationMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/ResistanceLeafToGroundMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/ResistanceLeafToGroundMod.F90 new file mode 100644 index 000000000..8f2811d6d --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/ResistanceLeafToGroundMod.F90 @@ -0,0 +1,106 @@ +module ResistanceLeafToGroundMod + +!!! Compute under-canopy aerodynamic resistance and leaf boundary layer resistance + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine ResistanceLeafToGround(noahmp, IndIter, VegAreaIndEff, HeatSenGrdTmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: RAGRB +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + integer , intent(in ) :: IndIter ! iteration index + real(kind=kind_noahmp), intent(in ) :: HeatSenGrdTmp ! temporary ground sensible heat flux (w/m2) in each iteration + real(kind=kind_noahmp), intent(in ) :: VegAreaIndEff ! temporary effective vegetation area index with constraint (<=6.0) + type(noahmp_type) , intent(inout) :: noahmp + +! local variable + real(kind=kind_noahmp) :: MPE ! prevents overflow for division by zero + real(kind=kind_noahmp) :: KH ! turbulent transfer coefficient, sensible heat, (m2/s) + real(kind=kind_noahmp) :: TMP1 ! temporary calculation + real(kind=kind_noahmp) :: TMP2 ! temporary calculation + real(kind=kind_noahmp) :: TMPRAH2 ! temporary calculation for aerodynamic resistances + real(kind=kind_noahmp) :: TMPRB ! temporary calculation for rb + real(kind=kind_noahmp) :: FHGNEW ! temporary vars + +! -------------------------------------------------------------------- + associate( & + LeafDimLength => noahmp%energy%param%LeafDimLength ,& ! in, characteristic leaf dimension [m] + CanopyWindExtFac => noahmp%energy%param%CanopyWindExtFac ,& ! in, canopy wind extinction parameter + DensityAirRefHeight => noahmp%energy%state%DensityAirRefHeight ,& ! in, density air [kg/m3] + TemperatureCanopyAir => noahmp%energy%state%TemperatureCanopyAir ,& ! in, canopy air temperature [K] + ZeroPlaneDispSfc => noahmp%energy%state%ZeroPlaneDispSfc ,& ! in, zero plane displacement [m] + RoughLenMomGrd => noahmp%energy%state%RoughLenMomGrd ,& ! in, roughness length [m], momentum, ground + CanopyHeight => noahmp%energy%state%CanopyHeight ,& ! in, canopy height [m] + WindSpdCanopyTop => noahmp%energy%state%WindSpdCanopyTop ,& ! in, wind speed at top of canopy [m/s] + RoughLenShCanopy => noahmp%energy%state%RoughLenShCanopy ,& ! in, roughness length [m], sensible heat, canopy + RoughLenShVegGrd => noahmp%energy%state%RoughLenShVegGrd ,& ! in, roughness length [m], sensible heat ground, below canopy + FrictionVelVeg => noahmp%energy%state%FrictionVelVeg ,& ! in, friction velocity [m/s], vegetated + MoStabCorrShUndCan => noahmp%energy%state%MoStabCorrShUndCan ,& ! inout, stability correction ground, below canopy + WindExtCoeffCanopy => noahmp%energy%state%WindExtCoeffCanopy ,& ! out, canopy wind extinction coefficient + MoStabParaUndCan => noahmp%energy%state%MoStabParaUndCan ,& ! out, Monin-Obukhov stability parameter ground, below canopy + MoLengthUndCan => noahmp%energy%state%MoLengthUndCan ,& ! out, Monin-Obukhov length [m], ground, below canopy + ResistanceMomUndCan => noahmp%energy%state%ResistanceMomUndCan ,& ! out, ground aerodynamic resistance for momentum [s/m] + ResistanceShUndCan => noahmp%energy%state%ResistanceShUndCan ,& ! out, ground aerodynamic resistance for sensible heat [s/m] + ResistanceLhUndCan => noahmp%energy%state%ResistanceLhUndCan ,& ! out, ground aerodynamic resistance for water vapor [s/m] + ResistanceLeafBoundary => noahmp%energy%state%ResistanceLeafBoundary & ! out, bulk leaf boundary layer resistance [s/m] + ) +! ---------------------------------------------------------------------- + + ! initialization + MPE = 1.0e-6 + MoStabParaUndCan = 0.0 + MoLengthUndCan = 0.0 + + ! stability correction to below canopy resistance + if ( IndIter > 1 ) then + TMP1 = ConstVonKarman * (ConstGravityAcc / TemperatureCanopyAir) * HeatSenGrdTmp / & + (DensityAirRefHeight * ConstHeatCapacAir) + if ( abs(TMP1) <= MPE ) TMP1 = MPE + MoLengthUndCan = -1.0 * FrictionVelVeg**3 / TMP1 + MoStabParaUndCan = min((ZeroPlaneDispSfc-RoughLenMomGrd)/MoLengthUndCan, 1.0) + endif + if ( MoStabParaUndCan < 0.0 ) then + FHGNEW = (1.0 - 15.0 * MoStabParaUndCan)**(-0.25) + else + FHGNEW = 1.0 + 4.7 * MoStabParaUndCan + endif + if ( IndIter == 1 ) then + MoStabCorrShUndCan = FHGNEW + else + MoStabCorrShUndCan = 0.5 * (MoStabCorrShUndCan + FHGNEW) + endif + + ! wind attenuation within canopy + WindExtCoeffCanopy = (CanopyWindExtFac * VegAreaIndEff * CanopyHeight * MoStabCorrShUndCan)**0.5 + TMP1 = exp(-WindExtCoeffCanopy * RoughLenShVegGrd / CanopyHeight) + TMP2 = exp(-WindExtCoeffCanopy * (RoughLenShCanopy + ZeroPlaneDispSfc) / CanopyHeight) + TMPRAH2 = CanopyHeight * exp(WindExtCoeffCanopy) / WindExtCoeffCanopy * (TMP1-TMP2) + + ! aerodynamic resistances raw and rah between heights ZeroPlaneDisp+RoughLenShVegGrd and RoughLenShVegGrd. + KH = max(ConstVonKarman*FrictionVelVeg*(CanopyHeight-ZeroPlaneDispSfc), MPE) + ResistanceMomUndCan = 0.0 + ResistanceShUndCan = TMPRAH2 / KH + ResistanceLhUndCan = ResistanceShUndCan + + ! leaf boundary layer resistance + TMPRB = WindExtCoeffCanopy * 50.0 / (1.0 - exp(-WindExtCoeffCanopy/2.0)) + ResistanceLeafBoundary = TMPRB * sqrt(LeafDimLength / WindSpdCanopyTop) + ResistanceLeafBoundary = min(max(ResistanceLeafBoundary, 5.0), 50.0) ! limit ResistanceLeafBoundary to 5-50, typically <50 + + end associate + + end subroutine ResistanceLeafToGround + +end module ResistanceLeafToGroundMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/RunoffSubSurfaceDrainageMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSubSurfaceDrainageMod.F90 new file mode 100644 index 000000000..495756a2a --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSubSurfaceDrainageMod.F90 @@ -0,0 +1,39 @@ +module RunoffSubSurfaceDrainageMod + +!!! Calculate subsurface runoff using derived soil water drainage rate + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine RunoffSubSurfaceDrainage(noahmp) + +! ------------------------ Code history -------------------------------------------------- +! Originally embeded in WATER subroutine instead of as a separate subroutine +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! -------------------------------------------------------------------- + associate( & + DrainSoilBot => noahmp%water%flux%DrainSoilBot ,& ! in, soil bottom drainage [mm/s] + RunoffSubsurface => noahmp%water%flux%RunoffSubsurface & ! inout, subsurface runoff [mm/s] + ) +! ---------------------------------------------------------------------- + + ! compuate subsurface runoff mm/s + RunoffSubsurface = RunoffSubsurface + DrainSoilBot + + end associate + + end subroutine RunoffSubSurfaceDrainage + +end module RunoffSubSurfaceDrainageMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/RunoffSubSurfaceEquiWaterTableMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSubSurfaceEquiWaterTableMod.F90 new file mode 100644 index 000000000..fa87cba82 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSubSurfaceEquiWaterTableMod.F90 @@ -0,0 +1,52 @@ +module RunoffSubSurfaceEquiWaterTableMod + +!!! Calculate subsurface runoff using equilibrium water table depth (Niu et al., 2005) + + use Machine + use NoahmpVarType + use ConstantDefineMod + use WaterTableEquilibriumMod, only : WaterTableEquilibrium + + implicit none + +contains + + subroutine RunoffSubSurfaceEquiWaterTable(noahmp) + +! ------------------------ Code history -------------------------------------------------- +! Originally embeded in SOILWATER subroutine instead of as a separate subroutine +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! -------------------------------------------------------------------- + associate( & + SoilImpervFracMax => noahmp%water%state%SoilImpervFracMax ,& ! in, maximum soil imperviousness fraction + GridTopoIndex => noahmp%water%param%GridTopoIndex ,& ! in, gridcell mean topgraphic index (global mean) + RunoffDecayFac => noahmp%water%param%RunoffDecayFac ,& ! in, runoff decay factor [m-1] + BaseflowCoeff => noahmp%water%param%BaseflowCoeff ,& ! inout, baseflow coefficient [mm/s] + WaterTableDepth => noahmp%water%state%WaterTableDepth ,& ! out, water table depth [m] + RunoffSubsurface => noahmp%water%flux%RunoffSubsurface & ! out, subsurface runoff [mm/s] + ) +! ---------------------------------------------------------------------- + + ! set parameter values specific for this scheme + RunoffDecayFac = 2.0 + BaseflowCoeff = 4.0 + + ! compute equilibrium water table depth + call WaterTableEquilibrium(noahmp) + + ! compuate subsurface runoff mm/s + RunoffSubsurface = (1.0 - SoilImpervFracMax) * BaseflowCoeff * & + exp(-GridTopoIndex) * exp(-RunoffDecayFac * WaterTableDepth) + + end associate + + end subroutine RunoffSubSurfaceEquiWaterTable + +end module RunoffSubSurfaceEquiWaterTableMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/RunoffSubSurfaceGroundWaterMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSubSurfaceGroundWaterMod.F90 new file mode 100644 index 000000000..7659c7e5e --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSubSurfaceGroundWaterMod.F90 @@ -0,0 +1,43 @@ +module RunoffSubSurfaceGroundWaterMod + +!!! Calculate subsurface runoff based on TOPMODEL with groundwater (Niu et al 2007) + + use Machine + use NoahmpVarType + use ConstantDefineMod + use GroundWaterTopModelMod, only : GroundWaterTopModel + + implicit none + +contains + + subroutine RunoffSubSurfaceGroundWater(noahmp) + +! ------------------------ Code history -------------------------------------------------- +! Originally embeded in WATER subroutine instead of as a separate subroutine +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! -------------------------------------------------------------------- + associate( & + DischargeGw => noahmp%water%flux%DischargeGw ,& ! out, groundwater discharge [mm/s] + RunoffSubsurface => noahmp%water%flux%RunoffSubsurface & ! out, subsurface runoff [mm/s] + ) +! ---------------------------------------------------------------------- + + ! compute ground water + call GroundWaterTopModel(noahmp) + + ! compute subsurface runoff as groundwater discharge + RunoffSubsurface = DischargeGw + + end associate + + end subroutine RunoffSubSurfaceGroundWater + +end module RunoffSubSurfaceGroundWaterMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/RunoffSubSurfaceShallowMmfMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSubSurfaceShallowMmfMod.F90 new file mode 100644 index 000000000..302f8c79b --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSubSurfaceShallowMmfMod.F90 @@ -0,0 +1,52 @@ +module RunoffSubSurfaceShallowMmfMod + +!!! Calculate subsurface runoff based on MMF groundwater scheme + + use Machine + use NoahmpVarType + use ConstantDefineMod + use ShallowWaterTableMmfMod, only : ShallowWaterTableMMF + + implicit none + +contains + + subroutine RunoffSubSurfaceShallowWaterMMF(noahmp) + +! ------------------------ Code history -------------------------------------------------- +! Originally embeded in WATER subroutine instead of as a separate subroutine +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + SoilIce => noahmp%water%state%SoilIce ,& ! in, soil ice content [m3/m3] + DrainSoilBot => noahmp%water%flux%DrainSoilBot ,& ! in, soil bottom drainage [mm/s] + SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! inout, soil water content [m3/m3] + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! inout, total soil water content [m3/m3] + WaterStorageAquifer => noahmp%water%state%WaterStorageAquifer ,& ! inout, water storage in aquifer [mm] + RunoffSubsurface => noahmp%water%flux%RunoffSubsurface & ! out, subsurface runoff [mm/s] + ) +! ---------------------------------------------------------------------- + + ! compute shallow water table and moisture + call ShallowWaterTableMMF(noahmp) + + ! update moisture + SoilLiqWater(NumSoilLayer) = SoilMoisture(NumSoilLayer) - SoilIce(NumSoilLayer) + + ! compute subsurface runoff + RunoffSubsurface = RunoffSubsurface + DrainSoilBot + WaterStorageAquifer = 0.0 + + end associate + + end subroutine RunoffSubSurfaceShallowWaterMMF + +end module RunoffSubSurfaceShallowMmfMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceBatsMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceBatsMod.F90 new file mode 100644 index 000000000..1b9204b7e --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceBatsMod.F90 @@ -0,0 +1,68 @@ +module RunoffSurfaceBatsMod + +!!! Calculate surface runoff based on BATS scheme + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine RunoffSurfaceBATS(noahmp) + +! ------------------------ Code history -------------------------------------------------- +! Originally embeded in SOILWATER subroutine instead of as a separate subroutine +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variables + integer :: LoopInd ! loop index + real(kind=kind_noahmp) :: SoilMoistureTmp ! 2-m averaged soil moisture (m3/m3) + real(kind=kind_noahmp) :: SoilDepthTmp ! 2-m soil depth (m) + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! in, thickness of snow/soil layers [m] + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! in, total soil water content [m3/m3] + SoilImpervFrac => noahmp%water%state%SoilImpervFrac ,& ! in, impervious fraction due to frozen soil + SoilSfcInflowMean => noahmp%water%flux%SoilSfcInflowMean ,& ! in, water input on soil surface [m/s] + SoilMoistureSat => noahmp%water%param%SoilMoistureSat ,& ! in, saturated value of soil moisture [m3/m3] + SoilSaturateFrac => noahmp%water%state%SoilSaturateFrac ,& ! out, fractional saturated area for soil moisture + RunoffSurface => noahmp%water%flux%RunoffSurface ,& ! out, surface runoff [m/s] + InfilRateSfc => noahmp%water%flux%InfilRateSfc & ! out, infiltration rate at surface [m/s] + ) +! ---------------------------------------------------------------------- + + ! initialization + SoilMoistureTmp = 0.0 + SoilDepthTmp = 0.0 + + ! compute mean soil moisture, depth and saturation fraction + do LoopInd = 1, NumSoilLayer + SoilDepthTmp = SoilDepthTmp + ThicknessSnowSoilLayer(LoopInd) + SoilMoistureTmp = SoilMoistureTmp + & + SoilMoisture(LoopInd) / SoilMoistureSat(LoopInd) * ThicknessSnowSoilLayer(LoopInd) + if ( SoilDepthTmp >= 2.0 ) exit + enddo + SoilMoistureTmp = SoilMoistureTmp / SoilDepthTmp + SoilSaturateFrac = max(0.01, SoilMoistureTmp)**4.0 ! BATS + + ! compute surface runoff and infiltration m/s + if ( SoilSfcInflowMean > 0.0 ) then + RunoffSurface = SoilSfcInflowMean * ((1.0-SoilImpervFrac(1)) * SoilSaturateFrac + SoilImpervFrac(1)) + InfilRateSfc = SoilSfcInflowMean - RunoffSurface + endif + + end associate + + end subroutine RunoffSurfaceBATS + +end module RunoffSurfaceBatsMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceDynamicVicMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceDynamicVicMod.F90 new file mode 100644 index 000000000..d9f75e40b --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceDynamicVicMod.F90 @@ -0,0 +1,300 @@ +module RunoffSurfaceDynamicVicMod + +!!! Compuate inflitration rate at soil surface and estimate surface runoff based on dynamic VIC scheme +!!! Reference: Liang, X., & Xie, Z. (2001). A new surface runoff parameterization with subgrid-scale +!!! soil heterogeneity for land surface models. Advances in Water Resources, 24(9-10), 1173-1193. + + use Machine + use NoahmpVarType + use ConstantDefineMod + use SoilWaterInfilPhilipMod, only : SoilWaterInfilPhilip + use SoilWaterInfilGreenAmptMod, only : SoilWaterInfilGreenAmpt + use SoilWaterInfilSmithParlangeMod, only : SoilWaterInfilSmithParlange + use RunoffSurfaceExcessDynamicVicMod + + implicit none + +contains + + subroutine RunoffSurfaceDynamicVic(noahmp, TimeStep, InfilRateAcc) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: DYNAMIC_VIC +! Original code: Prasanth Valayamkunnath +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! in & out variabls + type(noahmp_type) , intent(inout) :: noahmp + real(kind=kind_noahmp), intent(in) :: TimeStep ! timestep (may not be the same as model timestep) + real(kind=kind_noahmp), intent(inout) :: InfilRateAcc ! accumulated infiltration rate (m/s) + +! local variable + integer :: IndIter ! iteration index + integer :: NumIter ! number of interation + integer :: IndInfilMax ! index to check maximum infiltration at SoilMoistureWilt + real(kind=kind_noahmp) :: InfilExpB ! B parameter for infiltration scaling curve + real(kind=kind_noahmp) :: WaterDepthTop ! actual water depth in top layers [m] + real(kind=kind_noahmp) :: WaterDepthSatTop ! saturated water depth in top layers [m] + real(kind=kind_noahmp) :: WaterInSoilSfc ! water input on soil surface [m] + real(kind=kind_noahmp) :: WaterDepthInit ! initial water depth [m] + real(kind=kind_noahmp) :: WaterDepthMax ! maximum water depth [m] + real(kind=kind_noahmp) :: InfilSfcTmp ! surface infiltration rate [m/s] + real(kind=kind_noahmp) :: InfilSfcMax ! maximum infiltration rate [m/s] + real(kind=kind_noahmp) :: RunoffSatExcess ! saturation excess runoff [m/s] + real(kind=kind_noahmp) :: RunoffInfilExcess ! infiltration excess runoff [m/s] + real(kind=kind_noahmp) :: InfilTmp ! infiltration [m/s] + real(kind=kind_noahmp) :: RunoffSatExcTmp ! temporary saturation excess runoff [m/s] + real(kind=kind_noahmp) :: RunoffInfExcTmp ! temporary infiltration excess runoff [m/s] + real(kind=kind_noahmp) :: RunoffSatExcTmp1 ! saturation excess runoff [m/s] + real(kind=kind_noahmp) :: DepthYTmp ! temporary depth Y [m] + real(kind=kind_noahmp) :: DepthYPrev ! previous depth Y [m] + real(kind=kind_noahmp) :: DepthYInit ! initial depth Y [m] + real(kind=kind_noahmp) :: TmpVar1 ! temporary variable + real(kind=kind_noahmp) :: Error ! allowed error + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth [m] of layer-bottom from soil surface + OptDynVicInfiltration => noahmp%config%nmlist%OptDynVicInfiltration ,& ! in, options for infiltration in dynamic VIC runoff scheme + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! in, total soil moisture [m3/m3] + SoilSfcInflowMean => noahmp%water%flux%SoilSfcInflowMean ,& ! in, mean water input on soil surface [m/s] + SoilMoistureSat => noahmp%water%param%SoilMoistureSat ,& ! in, saturated value of soil moisture [m3/m3] + InfilHeteroDynVic => noahmp%water%param%InfilHeteroDynVic ,& ! in, Dynamic VIC heterogeniety parameter for infiltration + InfilFacDynVic => noahmp%water%param%InfilFacDynVic ,& ! in, Dynamic VIC model infiltration parameter + RunoffSurface => noahmp%water%flux%RunoffSurface ,& ! out, surface runoff [m/s] + InfilRateSfc => noahmp%water%flux%InfilRateSfc & ! out, infiltration rate at surface [m/s] + ) +! ---------------------------------------------------------------------- + + ! initialization + WaterDepthTop = 0.0 + WaterDepthSatTop = 0.0 + InfilExpB = 1.0 + WaterInSoilSfc = 0.0 + WaterDepthMax = 0.0 + WaterDepthInit = 0.0 + RunoffSatExcess = 0.0 + RunoffInfilExcess = 0.0 + InfilTmp = 0.0 + RunoffSurface = 0.0 + InfilRateSfc = 0.0 + NumIter = 20 + Error = 1.388889E-07 * TimeStep ! 0.5 mm per hour time step + InfilExpB = InfilHeteroDynVic + + do IndIter = 1, NumSoilLayer-2 + WaterDepthTop = WaterDepthTop + (SoilMoisture(IndIter) * (-1.0) * DepthSoilLayer(IndIter)) ! actual moisture in top layers, [m] + WaterDepthSatTop = WaterDepthSatTop + (SoilMoistureSat(IndIter) * (-1.0) * DepthSoilLayer(IndIter)) ! maximum moisture in top layers, [m] + enddo + if ( WaterDepthTop > WaterDepthSatTop ) WaterDepthTop = WaterDepthSatTop + + WaterInSoilSfc = SoilSfcInflowMean * TimeStep ! precipitation depth, [m] + WaterDepthMax = WaterDepthSatTop * (InfilFacDynVic + 1.0) ! maximum infiltration capacity [m], Eq.14 + WaterDepthInit = WaterDepthMax * (1.0 - (1.0 - (WaterDepthTop/WaterDepthSatTop)**(1.0/(1.0+InfilFacDynVic)))) ! infiltration capacity, [m] in Eq.1 + !WaterDepthMax = CAP_minf ; WaterDepthInit = A + IndInfilMax = 0 + + ! compute surface infiltration + if ( OptDynVicInfiltration == 1 ) then + call SoilWaterInfilPhilip(noahmp, TimeStep, IndInfilMax, InfilRateAcc, InfilSfcTmp) + else if ( OptDynVicInfiltration == 2 ) then + call SoilWaterInfilGreenAmpt(noahmp, IndInfilMax, InfilRateAcc, InfilSfcTmp) + else if ( OptDynVicInfiltration == 3 ) then + call SoilWaterInfilSmithParlange(noahmp, IndInfilMax, InfilRateAcc, InfilSfcTmp) + endif + + ! I_MM = InfilSfcTmp; I_M = InfilSfcMax + InfilSfcMax = (InfilExpB + 1.0) * InfilSfcTmp + if ( WaterInSoilSfc <= 0.0 ) then + RunoffSatExcess = 0.0 + RunoffInfilExcess = 0.0 + InfilTmp = 0.0 + goto 2001 + else + if ( (WaterDepthTop >= WaterDepthSatTop) .and. (WaterDepthInit >= WaterDepthMax) ) then + WaterDepthTop = WaterDepthSatTop + WaterDepthInit = WaterDepthMax + RunoffSatExcess = WaterInSoilSfc + RunoffInfilExcess = 0.0 + InfilTmp = 0.0 + goto 2001 + else + WaterDepthInit = WaterDepthMax * (1.0-(1.0-(WaterDepthTop/WaterDepthSatTop)**(1.0/(1.0+InfilFacDynVic)))) + if ( (WaterInSoilSfc+WaterDepthInit) > WaterDepthMax ) then + if ( (InfilSfcMax*TimeStep) >= WaterInSoilSfc) then + DepthYTmp = WaterDepthMax - WaterDepthInit + RunoffSatExcTmp = 0.0 + call RunoffSatExcessDynamicVic(noahmp,WaterDepthInit,WaterDepthMax,DepthYTmp,RunoffSatExcTmp) + TmpVar1 = WaterDepthMax - WaterDepthInit - RunoffSatExcTmp - (InfilSfcTmp*TimeStep) * & + (1.0-(1.0-((WaterInSoilSfc-RunoffSatExcTmp)/(InfilSfcMax*TimeStep))**(InfilExpB+1.0))) + if ( TmpVar1 <= 0.0 ) then + DepthYTmp = WaterDepthMax - WaterDepthInit + InfilTmp = WaterDepthSatTop - WaterDepthTop + RunoffSatExcess = WaterInSoilSfc - InfilTmp + RunoffInfilExcess = 0.0 + WaterDepthTop = WaterDepthSatTop + WaterDepthInit = WaterDepthMax + goto 2001 + else + DepthYTmp = 0.0 + do IndIter = 1, NumIter ! loop : iteration 1 + DepthYPrev = DepthYTmp + RunoffSatExcTmp = 0.0 + call RunoffSatExcessDynamicVic(noahmp,WaterDepthInit,WaterDepthMax,DepthYTmp,RunoffSatExcTmp) + DepthYTmp = RunoffSatExcTmp + ((InfilSfcTmp*TimeStep) * & + (1.0-(1.0-((WaterInSoilSfc-RunoffSatExcTmp)/(InfilSfcMax*TimeStep))**(InfilExpB+1.0)))) + if ( (abs(DepthYTmp-DepthYPrev) <= Error) .or. (IndIter == NumIter) ) then + goto 1003 + endif + enddo + endif + else + RunoffSatExcTmp = 0.0 + call RunoffSatExcessDynamicVic(noahmp,WaterDepthInit,WaterDepthMax,DepthYTmp,RunoffSatExcTmp) + if ( (RunoffSatExcTmp+(InfilSfcMax*TimeStep)) <= WaterInSoilSfc ) then + if ( (WaterDepthMax-WaterDepthInit-RunoffSatExcTmp-(InfilSfcMax*TimeStep)) <= 0.0 ) then + DepthYTmp = WaterDepthMax - WaterDepthInit + InfilTmp = WaterDepthSatTop - WaterDepthTop + RunoffSatExcess = WaterInSoilSfc - InfilTmp + RunoffInfilExcess = 0.0 + WaterDepthTop = WaterDepthSatTop + WaterDepthInit = WaterDepthMax + goto 2001 + else + DepthYTmp = 0.0 + do IndIter = 1, NumIter ! loop : iteration 2 + DepthYPrev = DepthYTmp + RunoffSatExcTmp = 0.0 + call RunoffSatExcessDynamicVic(noahmp,WaterDepthInit,WaterDepthMax,DepthYTmp,RunoffSatExcTmp) + DepthYTmp = RunoffSatExcTmp + (InfilSfcTmp*TimeStep) + if ( (abs(DepthYTmp-DepthYPrev) <= Error) .or. (IndIter == NumIter) ) then + goto 1003 + endif + enddo + endif + else + DepthYTmp = WaterInSoilSfc / 2.0 + do IndIter = 1, NumIter ! loop : iteration 3_0 + DepthYPrev = DepthYTmp + RunoffSatExcTmp = 0.0 + call RunoffSatExcessDynamicVic(noahmp,WaterDepthInit,WaterDepthMax,DepthYTmp,RunoffSatExcTmp) + DepthYTmp = DepthYTmp - RunoffSatExcTmp - (InfilSfcTmp*TimeStep) + WaterInSoilSfc + if ( DepthYTmp <= 0.0 ) DepthYTmp = 0.0 + if ( DepthYTmp >= WaterInSoilSfc ) DepthYTmp = WaterInSoilSfc + if ( (abs(DepthYTmp-DepthYPrev) <= Error) .or. (IndIter == NumIter) ) then + DepthYInit = DepthYTmp + exit + endif + enddo + do IndIter = 1, NumIter ! loop : iteration 3 + DepthYPrev = DepthYTmp + RunoffSatExcTmp = 0.0 + RunoffInfExcTmp = 0.0 + call RunoffSatExcessDynamicVic(noahmp,WaterDepthInit,WaterDepthMax,DepthYTmp,RunoffSatExcTmp) + call RunoffInfilExcessDynamicVic(DepthYTmp,DepthYInit,RunoffSatExcTmp,InfilSfcMax,& + InfilSfcTmp,TimeStep,WaterInSoilSfc,InfilExpB,RunoffInfExcTmp) + DepthYTmp = WaterInSoilSfc - RunoffInfExcTmp + if ( (abs(DepthYTmp-DepthYPrev) <= Error) .or. (IndIter == NumIter) ) then + goto 1003 + endif + enddo +1003 if ( DepthYTmp <= 0.0 ) DepthYTmp = 0.0 + if ( DepthYTmp >= WaterInSoilSfc ) DepthYTmp = WaterInSoilSfc + call RunoffSatExcessDynamicVic(noahmp,WaterDepthInit,WaterDepthMax,DepthYTmp,RunoffSatExcTmp1) + RunoffSatExcess = RunoffSatExcTmp1 + RunoffInfilExcess = WaterInSoilSfc - DepthYTmp + InfilTmp = DepthYTmp - RunoffSatExcess + WaterDepthTop = WaterDepthTop + InfilTmp + DepthYTmp = WaterDepthInit + DepthYTmp + if ( WaterDepthTop <= 0.0 ) WaterDepthTop = 0.0 + if ( WaterDepthTop >= WaterDepthSatTop ) WaterDepthTop = WaterDepthSatTop + WaterDepthInit = WaterDepthMax * (1.0-(1.0-(WaterDepthTop/WaterDepthSatTop)**(1.0/(1.0+InfilFacDynVic)))) + goto 2001 + endif + endif + else + if ( (InfilSfcMax*TimeStep) >= WaterInSoilSfc) then + DepthYTmp = WaterInSoilSfc / 2.0 + do IndIter = 1, NumIter ! iteration 1 + DepthYPrev = DepthYTmp + RunoffSatExcTmp = 0.0 + call RunoffSatExcessDynamicVic(noahmp,WaterDepthInit,WaterDepthMax,DepthYTmp,RunoffSatExcTmp) + DepthYTmp = RunoffSatExcTmp + ((InfilSfcTmp*TimeStep) * & + (1.0-(1.0-((WaterInSoilSfc-RunoffSatExcTmp)/(InfilSfcMax*TimeStep))**(InfilExpB+1.0)))) + if ( (abs(DepthYTmp-DepthYPrev) <= Error) .or. (IndIter == NumIter) ) then + goto 1004 + endif + enddo + else + RunoffSatExcTmp = 0.0 + call RunoffSatExcessDynamicVic(noahmp,WaterDepthInit,WaterDepthMax,DepthYTmp,RunoffSatExcTmp) + if ( (RunoffSatExcTmp+(InfilSfcMax*TimeStep)) <= WaterInSoilSfc ) then + DepthYTmp = WaterInSoilSfc / 2.0 + do IndIter = 1, NumIter ! iteration 2 + DepthYPrev = DepthYTmp + RunoffSatExcTmp = 0.0 + call RunoffSatExcessDynamicVic(noahmp,WaterDepthInit,WaterDepthMax,DepthYTmp,RunoffSatExcTmp) + DepthYTmp = RunoffSatExcTmp+(InfilSfcTmp*TimeStep) + if ( (abs(DepthYTmp-DepthYPrev) <= Error) .or. (IndIter == NumIter) ) then + goto 1004 + endif + enddo + else + DepthYTmp = 0.0 + do IndIter = 1, NumIter ! iteration 3_0 + DepthYPrev = DepthYTmp + RunoffSatExcTmp = 0.0 + call RunoffSatExcessDynamicVic(noahmp,WaterDepthInit,WaterDepthMax,DepthYTmp,RunoffSatExcTmp) + DepthYTmp = (WaterInSoilSfc - (InfilSfcMax*TimeStep)) + DepthYTmp - RunoffSatExcTmp + if ( DepthYTmp <= 0.0 ) DepthYTmp = 0.0 + if ( DepthYTmp >= WaterInSoilSfc ) DepthYTmp = WaterInSoilSfc + RunoffSatExcTmp = 0.0 + call RunoffSatExcessDynamicVic(noahmp,WaterDepthInit,WaterDepthMax,DepthYTmp,RunoffSatExcTmp) + if ( (abs(RunoffSatExcTmp+(InfilSfcMax*TimeStep)-WaterInSoilSfc) <= Error) .or. (IndIter == NumIter) ) then + DepthYInit = DepthYTmp + exit + endif + enddo + do IndIter = 1, NumIter ! iteration 3 + DepthYPrev = DepthYTmp + RunoffSatExcTmp = 0.0 + RunoffInfExcTmp = 0.0 + call RunoffSatExcessDynamicVic(noahmp,WaterDepthInit,WaterDepthMax,DepthYTmp,RunoffSatExcTmp) + call RunoffInfilExcessDynamicVic(DepthYTmp,DepthYInit,RunoffSatExcTmp,InfilSfcMax,& + InfilSfcTmp,TimeStep,WaterInSoilSfc,InfilExpB,RunoffInfExcTmp) + DepthYTmp = WaterInSoilSfc - RunoffInfExcTmp + if ( (abs(DepthYTmp-DepthYPrev) <= Error) .or. (IndIter == NumIter) ) then + goto 1004 + endif + enddo + endif + endif +1004 if ( DepthYTmp <= 0.0 ) DepthYTmp = 0.0 + if ( DepthYTmp >= WaterInSoilSfc ) DepthYTmp = WaterInSoilSfc + RunoffSatExcTmp1 = 0.0 + call RunoffSatExcessDynamicVic(noahmp,WaterDepthInit,WaterDepthMax,DepthYTmp,RunoffSatExcTmp1) + RunoffSatExcess = RunoffSatExcTmp1 + RunoffInfilExcess = WaterInSoilSfc - DepthYTmp + InfilTmp = DepthYTmp - RunoffSatExcess + WaterDepthTop = WaterDepthTop + InfilTmp + if ( WaterDepthTop <= 0.0 ) WaterDepthTop = 0.0 + if ( WaterDepthTop >= WaterDepthSatTop ) WaterDepthTop = WaterDepthSatTop + WaterDepthInit = WaterDepthMax * (1.0-(1.0-(WaterDepthTop/WaterDepthSatTop)**(1.0/(1.0+InfilFacDynVic)))) + endif + endif + endif + +2001 RunoffSurface = (RunoffSatExcess + RunoffInfilExcess) / TimeStep + RunoffSurface = min(RunoffSurface, SoilSfcInflowMean) + RunoffSurface = max(RunoffSurface, 0.0) + InfilRateSfc = SoilSfcInflowMean - RunoffSurface + + end associate + + end subroutine RunoffSurfaceDynamicVic + +end module RunoffSurfaceDynamicVicMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceExcessDynamicVicMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceExcessDynamicVicMod.F90 new file mode 100644 index 000000000..910a86f27 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceExcessDynamicVicMod.F90 @@ -0,0 +1,88 @@ +module RunoffSurfaceExcessDynamicVicMod + +!!! Compute infiltration and saturation excess runoff for dyanmic VIC runoff scheme + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine RunoffSatExcessDynamicVic(noahmp, WaterDepthInit, WaterDepthMax, DepthYTmp, RunoffSatExcess) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: RR1 for saturation excess runoff +! Original code: Prasanth Valayamkunnath +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! IN & OUT variabls + type(noahmp_type) , intent(inout) :: noahmp + real(kind=kind_noahmp), intent(in) :: WaterDepthInit ! initial water depth [m] + real(kind=kind_noahmp), intent(in) :: WaterDepthMax ! maximum water depth [m] + real(kind=kind_noahmp), intent(in) :: DepthYTmp ! initial depth Y [m] + real(kind=kind_noahmp), intent(out) :: RunoffSatExcess ! saturation excess runoff [m/s] + +! local variable + real(kind=kind_noahmp) :: WaterTableDepth ! water table depth [m] + +! ------------------------------------------------------------------ + associate( & + InfilFacDynVic => noahmp%water%param%InfilFacDynVic & ! in, DVIC model infiltration parameter + ) +! ------------------------------------------------------------------ + + WaterTableDepth = WaterDepthInit + DepthYTmp + if ( WaterTableDepth > WaterDepthMax ) WaterTableDepth = WaterDepthMax + + ! Saturation excess runoff , Eq 5. + RunoffSatExcess = DepthYTmp - ((WaterDepthMax/(InfilFacDynVic+1.0)) * & + (((1.0 - (WaterDepthInit/WaterDepthMax))**(InfilFacDynVic+1.0)) & + - ((1.0 - (WaterTableDepth/WaterDepthMax))**(InfilFacDynVic+1.0)))) + + if ( RunoffSatExcess < 0.0 ) RunoffSatExcess = 0.0 + + end associate + + end subroutine RunoffSatExcessDynamicVic + + + subroutine RunoffInfilExcessDynamicVic(DepthYTmp, DepthYInit, RunoffSatExcess, InfilRateMax, & + InfilRateSfc, TimeStep, WaterInSoilSfc, InfilExpB, RunoffInfilExcess) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: RRunoffInfilExcess for infiltration excess runoff +! Original code: Prasanth Valayamkunnath +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! IN & OUT variabls + real(kind=kind_noahmp), intent(in) :: DepthYTmp ! initial depth Y [m] + real(kind=kind_noahmp), intent(in) :: DepthYInit ! initial depth Y [m] + real(kind=kind_noahmp), intent(in) :: RunoffSatExcess ! saturation excess runoff [m/s] + real(kind=kind_noahmp), intent(in) :: InfilRateMax ! maximum infiltration rate [m/s] + real(kind=kind_noahmp), intent(in) :: InfilRateSfc ! surface infiltration rate [m/s] + real(kind=kind_noahmp), intent(in) :: TimeStep ! timestep (may not be the same as model timestep) + real(kind=kind_noahmp), intent(in) :: WaterInSoilSfc ! water input on soil surface [m] + real(kind=kind_noahmp), intent(in) :: InfilExpB ! B parameter for infiltration scaling curve + real(kind=kind_noahmp), intent(out) :: RunoffInfilExcess ! infiltration excess runoff [m/s] +! ---------------------------------------------------------------------- + + if ( DepthYTmp >= DepthYInit ) then + RunoffInfilExcess = WaterInSoilSfc - RunoffSatExcess - (InfilRateMax * TimeStep * & + (1.0-((1.0-(WaterInSoilSfc-RunoffSatExcess)/(InfilRateMax*TimeStep))**(InfilExpB+1.0)))) + else + RunoffInfilExcess = WaterInSoilSfc - RunoffSatExcess - (InfilRateMax*TimeStep) + endif + + if ( RunoffInfilExcess < 0.0) RunoffInfilExcess =0.0 + + end subroutine RunoffInfilExcessDynamicVic + +end module RunoffSurfaceExcessDynamicVicMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceFreeDrainMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceFreeDrainMod.F90 new file mode 100644 index 000000000..e2e28450e --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceFreeDrainMod.F90 @@ -0,0 +1,132 @@ +module RunoffSurfaceFreeDrainMod + +!!! Calculate inflitration rate at soil surface and surface runoff for free drainage scheme + + use Machine + use NoahmpVarType + use ConstantDefineMod + use SoilHydraulicPropertyMod, only : SoilDiffusivityConductivityOpt2 + + implicit none + +contains + + subroutine RunoffSurfaceFreeDrain(noahmp, TimeStep) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: INFIL +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! IN & OUT variabls + type(noahmp_type) , intent(inout) :: noahmp + real(kind=kind_noahmp), intent(in) :: TimeStep ! timestep (may not be the same as model timestep) + +! local variable + integer :: IndSoilFrz ! number of interaction + integer :: LoopInd1, LoopInd2, LoopInd3 ! do-loop index + integer, parameter :: FrzSoilFac = 3 ! frozen soil pre-factor + real(kind=kind_noahmp) :: FracVoidRem ! remaining fraction + real(kind=kind_noahmp) :: SoilWatHoldMaxRem ! remaining accumulated maximum holdable soil water [m] + real(kind=kind_noahmp) :: WaterInSfc ! surface in water [m] + real(kind=kind_noahmp) :: TimeStepDay ! time indices + real(kind=kind_noahmp) :: SoilWatHoldMaxAcc ! accumulated maximum holdable soil water [m] + real(kind=kind_noahmp) :: SoilIceWatTmp ! maximum soil ice water [m] + real(kind=kind_noahmp) :: SoilImpervFrac ! impervious fraction due to frozen soil + real(kind=kind_noahmp) :: IndAcc ! accumulation index + real(kind=kind_noahmp) :: SoilIceCoeff ! soil ice coefficient + real(kind=kind_noahmp) :: SoilWatDiffusivity ! soil water diffusivity [m2/s] + real(kind=kind_noahmp) :: SoilWatConductivity ! soil water conductivity [m/s] + real(kind=kind_noahmp) :: SoilWatHoldCap ! soil moisture holding capacity [m3/m3] + real(kind=kind_noahmp) :: InfilRateMax ! maximum infiltration rate [m/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilWatMaxHold ! maximum soil water that can hold [m] + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth [m] of layer-bottom from soil surface + FlagUrban => noahmp%config%domain%FlagUrban ,& ! in, logical flag for urban grid + SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! in, soil water content [m3/m3] + SoilIce => noahmp%water%state%SoilIce ,& ! in, soil ice content [m3/m3] + SoilIceMax => noahmp%water%state%SoilIceMax ,& ! in, maximum soil ice content [m3/m3] + SoilSfcInflowMean => noahmp%water%flux%SoilSfcInflowMean ,& ! in, water input on soil surface [m/s] + SoilMoistureSat => noahmp%water%param%SoilMoistureSat ,& ! in, saturated value of soil moisture [m3/m3] + SoilMoistureWilt => noahmp%water%param%SoilMoistureWilt ,& ! in, wilting point soil moisture [m3/m3] + SoilInfilMaxCoeff => noahmp%water%param%SoilInfilMaxCoeff ,& ! in, parameter to calculate maximum infiltration rate + SoilImpervFracCoeff => noahmp%water%param%SoilImpervFracCoeff ,& ! in, parameter to calculate frozen soil impermeable fraction + RunoffSurface => noahmp%water%flux%RunoffSurface ,& ! out, surface runoff [m/s] + InfilRateSfc => noahmp%water%flux%InfilRateSfc & ! out, infiltration rate at surface [m/s] + ) +! ---------------------------------------------------------------------- + + ! initialize + if (.not. allocated(SoilWatMaxHold)) allocate(SoilWatMaxHold(1:NumSoilLayer)) + SoilWatMaxHold(1:NumSoilLayer) = 0.0 + + ! start infiltration for free drainage scheme + if ( SoilSfcInflowMean > 0.0 ) then + + TimeStepDay = TimeStep / 86400.0 + SoilWatHoldCap = SoilMoistureSat(1) - SoilMoistureWilt(1) + + ! compute maximum infiltration rate + SoilWatMaxHold(1) = -DepthSoilLayer(1) * SoilWatHoldCap + SoilIceWatTmp = -DepthSoilLayer(1) * SoilIce(1) + SoilWatMaxHold(1) = SoilWatMaxHold(1) * (1.0-(SoilLiqWater(1)+SoilIce(1)-SoilMoistureWilt(1)) / SoilWatHoldCap) + SoilWatHoldMaxAcc = SoilWatMaxHold(1) + do LoopInd3 = 2, NumSoilLayer + SoilIceWatTmp = SoilIceWatTmp + (DepthSoilLayer(LoopInd3-1) - DepthSoilLayer(LoopInd3))*SoilIce(LoopInd3) + SoilWatMaxHold(LoopInd3) = (DepthSoilLayer(LoopInd3-1) - DepthSoilLayer(LoopInd3)) * SoilWatHoldCap + SoilWatMaxHold(LoopInd3) = SoilWatMaxHold(LoopInd3) * (1.0 - (SoilLiqWater(LoopInd3) + SoilIce(LoopInd3) - & + SoilMoistureWilt(LoopInd3)) / SoilWatHoldCap) + SoilWatHoldMaxAcc = SoilWatHoldMaxAcc + SoilWatMaxHold(LoopInd3) + enddo + FracVoidRem = 1.0 - exp(-1.0 * SoilInfilMaxCoeff * TimeStepDay) + SoilWatHoldMaxRem = SoilWatHoldMaxAcc * FracVoidRem + WaterInSfc = max(0.0, SoilSfcInflowMean * TimeStep) + InfilRateMax = (WaterInSfc * (SoilWatHoldMaxRem/(WaterInSfc + SoilWatHoldMaxRem))) / TimeStep + + ! impermeable fraction due to frozen soil + SoilImpervFrac = 1.0 + if ( SoilIceWatTmp > 1.0e-2 ) then + SoilIceCoeff = FrzSoilFac * SoilImpervFracCoeff / SoilIceWatTmp + IndAcc = 1.0 + IndSoilFrz = FrzSoilFac - 1 + do LoopInd1 = 1, IndSoilFrz + LoopInd3 = 1 + do LoopInd2 = LoopInd1+1, IndSoilFrz + LoopInd3 = LoopInd3 * LoopInd2 + enddo + IndAcc = IndAcc + (SoilIceCoeff ** (FrzSoilFac-LoopInd1)) / float(LoopInd3) + enddo + SoilImpervFrac = 1.0 - exp(-SoilIceCoeff) * IndAcc + endif + + ! correction of infiltration limitation + InfilRateMax = InfilRateMax * SoilImpervFrac + ! jref for urban areas + ! if ( FlagUrban .eqv. .true. ) InfilRateMax == InfilRateMax * 0.05 + + ! soil hydraulic conductivity and diffusivity + call SoilDiffusivityConductivityOpt2(noahmp, SoilWatDiffusivity, SoilWatConductivity, SoilLiqWater(1), SoilIceMax, 1) + + InfilRateMax = max(InfilRateMax, SoilWatConductivity) + InfilRateMax = min(InfilRateMax, WaterInSfc/TimeStep) + + ! compute surface runoff and infiltration rate + RunoffSurface = max(0.0, SoilSfcInflowMean-InfilRateMax) + InfilRateSfc = SoilSfcInflowMean - RunoffSurface + + endif ! SoilSfcInflowMean > 0.0 + + ! deallocate local arrays to avoid memory leaks + deallocate(SoilWatMaxHold) + + end associate + + end subroutine RunoffSurfaceFreeDrain + +end module RunoffSurfaceFreeDrainMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceTopModelEquiMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceTopModelEquiMod.F90 new file mode 100644 index 000000000..3e314225d --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceTopModelEquiMod.F90 @@ -0,0 +1,54 @@ +module RunoffSurfaceTopModelEquiMod + +!!! Calculate surface runoff based on TOPMODEL with equilibrium water table (Niu et al., 2005) + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine RunoffSurfaceTopModelEqui(noahmp) + +! ------------------------ Code history -------------------------------------------------- +! Originally embeded in SOILWATER subroutine instead of as a separate subroutine +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! -------------------------------------------------------------------- + associate( & + SoilSfcInflowMean => noahmp%water%flux%SoilSfcInflowMean ,& ! in, mean water input on soil surface [m/s] + RunoffDecayFac => noahmp%water%param%RunoffDecayFac ,& ! in, runoff decay factor [1/m] + SoilSfcSatFracMax => noahmp%water%param%SoilSfcSatFracMax ,& ! in, maximum surface saturated fraction (global mean) + SoilImpervFrac => noahmp%water%state%SoilImpervFrac ,& ! in, impervious fraction due to frozen soil + WaterTableDepth => noahmp%water%state%WaterTableDepth ,& ! in, water table depth [m] + SoilSaturateFrac => noahmp%water%state%SoilSaturateFrac ,& ! out, fractional saturated area for soil moisture + RunoffSurface => noahmp%water%flux%RunoffSurface ,& ! out, surface runoff [m/s] + InfilRateSfc => noahmp%water%flux%InfilRateSfc & ! out, infiltration rate at surface [m/s] + ) +! ---------------------------------------------------------------------- + + ! set up key parameter + RunoffDecayFac = 2.0 + + ! compute saturated area fraction + SoilSaturateFrac = SoilSfcSatFracMax * exp(-0.5 * RunoffDecayFac * WaterTableDepth) + + ! compute surface runoff and infiltration m/s + if ( SoilSfcInflowMean > 0.0 ) then + RunoffSurface = SoilSfcInflowMean * ((1.0-SoilImpervFrac(1)) * SoilSaturateFrac + SoilImpervFrac(1)) + InfilRateSfc = SoilSfcInflowMean - RunoffSurface + endif + + end associate + + end subroutine RunoffSurfaceTopModelEqui + +end module RunoffSurfaceTopModelEquiMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceTopModelGrdMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceTopModelGrdMod.F90 new file mode 100644 index 000000000..b7d65aa0d --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceTopModelGrdMod.F90 @@ -0,0 +1,57 @@ +module RunoffSurfaceTopModelGrdMod + +!!! Calculate surface runoff based on TOPMODEL with groundwater scheme (Niu et al., 2007) + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine RunoffSurfaceTopModelGrd(noahmp) + +! ------------------------ Code history -------------------------------------------------- +! Originally embeded in SOILWATER subroutine instead of as a separate subroutine +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! -------------------------------------------------------------------- + associate( & + SoilSfcInflowMean => noahmp%water%flux%SoilSfcInflowMean ,& ! in, mean water input on soil surface [m/s] + RunoffDecayFac => noahmp%water%param%RunoffDecayFac ,& ! in, runoff decay factor [1/m] + SoilSfcSatFracMax => noahmp%water%param%SoilSfcSatFracMax ,& ! in, maximum surface saturated fraction (global mean) + SoilExpCoeffB => noahmp%water%param%SoilExpCoeffB ,& ! in, soil B parameter + SoilImpervFrac => noahmp%water%state%SoilImpervFrac ,& ! in, impervious fraction due to frozen soil + WaterTableDepth => noahmp%water%state%WaterTableDepth ,& ! in, water table depth [m] + SoilSaturateFrac => noahmp%water%state%SoilSaturateFrac ,& ! out, fractional saturated area for soil moisture + RunoffSurface => noahmp%water%flux%RunoffSurface ,& ! out, surface runoff [m/s] + InfilRateSfc => noahmp%water%flux%InfilRateSfc & ! out, infiltration rate at surface [m/s] + ) +! ---------------------------------------------------------------------- + + ! set up key parameter + !RunoffDecayFac = 6.0 + RunoffDecayFac = SoilExpCoeffB(1) / 3.0 ! calibratable, GY Niu's update 2022 + + ! compute saturated area fraction + !SoilSaturateFrac = SoilSfcSatFracMax * exp(-0.5 * RunoffDecayFac * (WaterTableDepth-2.0)) + SoilSaturateFrac = SoilSfcSatFracMax * exp(-0.5 * RunoffDecayFac * WaterTableDepth) ! GY Niu's update 2022 + + ! compute surface runoff and infiltration m/s + if ( SoilSfcInflowMean > 0.0 ) then + RunoffSurface = SoilSfcInflowMean * ((1.0-SoilImpervFrac(1)) * SoilSaturateFrac + SoilImpervFrac(1)) + InfilRateSfc = SoilSfcInflowMean - RunoffSurface + endif + + end associate + + end subroutine RunoffSurfaceTopModelGrd + +end module RunoffSurfaceTopModelGrdMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceTopModelMmfMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceTopModelMmfMod.F90 new file mode 100644 index 000000000..7bdb97b8d --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceTopModelMmfMod.F90 @@ -0,0 +1,54 @@ +module RunoffSurfaceTopModelMmfMod + +!!! Calculate surface runoff based on TOPMODEL with MMF groundwater scheme + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine RunoffSurfaceTopModelMMF(noahmp) + +! ------------------------ Code history -------------------------------------------------- +! Originally embeded in SOILWATER subroutine instead of as a separate subroutine +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! -------------------------------------------------------------------- + associate( & + SoilSfcInflowMean => noahmp%water%flux%SoilSfcInflowMean ,& ! in, mean water input on soil surface [m/s] + RunoffDecayFac => noahmp%water%param%RunoffDecayFac ,& ! in, runoff decay factor [1/m] + SoilSfcSatFracMax => noahmp%water%param%SoilSfcSatFracMax ,& ! in, maximum surface saturated fraction (global mean) + SoilImpervFrac => noahmp%water%state%SoilImpervFrac ,& ! in, impervious fraction due to frozen soil + WaterTableDepth => noahmp%water%state%WaterTableDepth ,& ! in, water table depth [m] + SoilSaturateFrac => noahmp%water%state%SoilSaturateFrac ,& ! out, fractional saturated area for soil moisture + RunoffSurface => noahmp%water%flux%RunoffSurface ,& ! out, surface runoff [m/s] + InfilRateSfc => noahmp%water%flux%InfilRateSfc & ! out, infiltration rate at surface [m/s] + ) +! ---------------------------------------------------------------------- + + ! set up key parameter + RunoffDecayFac = 6.0 + + ! compute saturated area fraction + SoilSaturateFrac = SoilSfcSatFracMax * exp(-0.5 * RunoffDecayFac * max(-2.0-WaterTableDepth,0.0)) + + ! compute surface runoff and infiltration m/s + if ( SoilSfcInflowMean > 0.0 ) then + RunoffSurface = SoilSfcInflowMean * ((1.0-SoilImpervFrac(1)) * SoilSaturateFrac + SoilImpervFrac(1)) + InfilRateSfc = SoilSfcInflowMean - RunoffSurface + endif + + end associate + + end subroutine RunoffSurfaceTopModelMMF + +end module RunoffSurfaceTopModelMmfMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceVicMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceVicMod.F90 new file mode 100644 index 000000000..3e29ca164 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceVicMod.F90 @@ -0,0 +1,100 @@ +module RunoffSurfaceVicMod + +!!! Compute saturated area, surface infiltration, and surface runoff based on VIC runoff scheme +!!! This scheme is adopted from VIC model + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine RunoffSurfaceVIC(noahmp, TimeStep) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: COMPUTE_VIC_SURFRUNOFF +! Original code: Prasanth Valayamkunnath +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! IN & OUT variabls + type(noahmp_type) , intent(inout) :: noahmp + real(kind=kind_noahmp), intent(in) :: TimeStep ! timestep (may not be the same as model timestep) + +! local variable + integer :: LoopInd ! do-loop index + real(kind=kind_noahmp) :: InfilExpFac ! infitration exponential factor + real(kind=kind_noahmp) :: WaterDepthInit ! initial water depth [m] + real(kind=kind_noahmp) :: WaterDepthMax ! Maximum water depth [m] + real(kind=kind_noahmp) :: InfilVarTmp ! temporary infiltration variable + real(kind=kind_noahmp) :: SoilMoistTop ! top layer soil moisture [m] + real(kind=kind_noahmp) :: SoilMoistTopMax ! top layer max soil moisture [m] + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth [m] of layer-bottom from soil surface + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! in, total soil moisture [m3/m3] + SoilSfcInflowMean => noahmp%water%flux%SoilSfcInflowMean ,& ! in, mean water input on soil surface [m/s] + SoilMoistureSat => noahmp%water%param%SoilMoistureSat ,& ! in, saturated value of soil moisture [m3/m3] + InfilFacVic => noahmp%water%param%InfilFacVic ,& ! in, VIC model infiltration parameter + RunoffSurface => noahmp%water%flux%RunoffSurface ,& ! out, surface runoff [m/s] + InfilRateSfc => noahmp%water%flux%InfilRateSfc ,& ! out, infiltration rate at surface [m/s] + SoilSaturateFrac => noahmp%water%state%SoilSaturateFrac & ! out, fractional saturated area for soil moisture + ) +! ---------------------------------------------------------------------- + + ! Initialization + InfilExpFac = 0.0 + SoilSaturateFrac = 0.0 + WaterDepthMax = 0.0 + WaterDepthInit = 0.0 + InfilVarTmp = 0.0 + SoilMoistTop = 0.0 + SoilMoistTopMax = 0.0 + RunoffSurface = 0.0 + InfilRateSfc = 0.0 + + do LoopInd = 1, NumSoilLayer-2 + SoilMoistTop = SoilMoistTop + SoilMoisture(LoopInd) * (-1.0) * DepthSoilLayer(LoopInd) + SoilMoistTopMax = SoilMoistTopMax + SoilMoistureSat(LoopInd) * (-1.0) * DepthSoilLayer(LoopInd) + enddo + + ! fractional saturated area from soil moisture + InfilExpFac = InfilFacVic / ( 1.0 + InfilFacVic ) + SoilSaturateFrac = 1.0 - (max(0.0, (1.0-(SoilMoistTop/SoilMoistTopMax))))**InfilExpFac + SoilSaturateFrac = max(0.0, SoilSaturateFrac) + SoilSaturateFrac = min(1.0, SoilSaturateFrac) + + ! Infiltration for the previous time-step soil moisture based on SoilSaturateFrac + WaterDepthMax = (1.0 + InfilFacVic) * SoilMoistTopMax + WaterDepthInit = WaterDepthMax * (1.0 - (1.0 - SoilSaturateFrac)**(1.0/InfilFacVic)) + + ! Solve for surface runoff + if ( SoilSfcInflowMean == 0.0 ) then + RunoffSurface = 0.0 + else if ( WaterDepthMax == 0.0 ) then + RunoffSurface = SoilSfcInflowMean * TimeStep + else if ( (WaterDepthInit + (SoilSfcInflowMean*TimeStep)) > WaterDepthMax ) then + RunoffSurface = SoilSfcInflowMean * TimeStep - SoilMoistTopMax + SoilMoistTop + else + InfilVarTmp = 1.0 - ((WaterDepthInit + (SoilSfcInflowMean * TimeStep) ) / WaterDepthMax) + RunoffSurface = SoilSfcInflowMean * TimeStep - SoilMoistTopMax + SoilMoistTop + & + SoilMoistTopMax * (InfilVarTmp**(1.0+InfilFacVic)) + endif + + RunoffSurface = RunoffSurface / TimeStep + if ( RunoffSurface < 0.0 ) RunoffSurface = 0.0 + if ( RunoffSurface > SoilSfcInflowMean) RunoffSurface = SoilSfcInflowMean + + InfilRateSfc = SoilSfcInflowMean - RunoffSurface + + end associate + + end subroutine RunoffSurfaceVIC + +end module RunoffSurfaceVicMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceXinAnJiangMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceXinAnJiangMod.F90 new file mode 100644 index 000000000..b067be4fe --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/RunoffSurfaceXinAnJiangMod.F90 @@ -0,0 +1,110 @@ +module RunoffSurfaceXinAnJiangMod + +!!! Compute surface infiltration rate and surface runoff based on XinAnJiang runoff scheme +!!! Reference: Knoben, W. J., et al., (2019): Modular Assessment of Rainfall-Runoff Models +!!! Toolbox (MARRMoT) v1.2 an open-source, extendable framework providing implementations +!!! of 46 conceptual hydrologic models as continuous state-space formulations. + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine RunoffSurfaceXinAnJiang(noahmp, TimeStep) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: COMPUTE_XAJ_SURFRUNOFF +! Original code: Prasanth Valayamkunnath +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! IN & OUT variables + type(noahmp_type) , intent(inout) :: noahmp + real(kind=kind_noahmp), intent(in) :: TimeStep ! timestep (may not be the same as model timestep) + +! local variable + integer :: LoopInd ! do-loop index + real(kind=kind_noahmp) :: SoilWaterTmp ! temporary soil water [m] + real(kind=kind_noahmp) :: SoilWaterMax ! maximum soil water [m] + real(kind=kind_noahmp) :: SoilWaterFree ! free soil water [m] + real(kind=kind_noahmp) :: SoilWaterFreeMax ! maximum free soil water [m] + real(kind=kind_noahmp) :: RunoffSfcImp ! impervious surface runoff [m] + real(kind=kind_noahmp) :: RunoffSfcPerv ! pervious surface runoff [m] + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth [m] of layer-bottom from soil surface + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! in, total soil moisture [m3/m3] + SoilImpervFrac => noahmp%water%state%SoilImpervFrac ,& ! in, fraction of imperviousness due to frozen soil + SoilSfcInflowMean => noahmp%water%flux%SoilSfcInflowMean ,& ! in, mean water input on soil surface [m/s] + SoilMoistureSat => noahmp%water%param%SoilMoistureSat ,& ! in, saturated value of soil moisture [m3/m3] + SoilMoistureFieldCap => noahmp%water%param%SoilMoistureFieldCap ,& ! in, reference soil moisture (field capacity) [m3/m3] + TensionWatDistrInfl => noahmp%water%param%TensionWatDistrInfl ,& ! in, Tension water distribution inflection parameter + TensionWatDistrShp => noahmp%water%param%TensionWatDistrShp ,& ! in, Tension water distribution shape parameter + FreeWatDistrShp => noahmp%water%param%FreeWatDistrShp ,& ! in, Free water distribution shape parameter + RunoffSurface => noahmp%water%flux%RunoffSurface ,& ! out, surface runoff [m/s] + InfilRateSfc => noahmp%water%flux%InfilRateSfc & ! out, infiltration rate at surface [m/s] + ) +! ---------------------------------------------------------------------- + + ! initialization + SoilWaterTmp = 0.0 + SoilWaterMax = 0.0 + SoilWaterFree = 0.0 + SoilWaterFreeMax = 0.0 + RunoffSfcImp = 0.0 + RunoffSfcPerv = 0.0 + RunoffSurface = 0.0 + InfilRateSfc = 0.0 + + do LoopInd = 1, NumSoilLayer-2 + if ( (SoilMoisture(LoopInd)-SoilMoistureFieldCap(LoopInd)) > 0.0 ) then ! soil moisture greater than field capacity + SoilWaterFree = SoilWaterFree + & + (SoilMoisture(LoopInd)-SoilMoistureFieldCap(LoopInd)) * (-1.0) * DepthSoilLayer(LoopInd) + SoilWaterTmp = SoilWaterTmp + SoilMoistureFieldCap(LoopInd) * (-1.0) * DepthSoilLayer(LoopInd) + else + SoilWaterTmp = SoilWaterTmp + SoilMoisture(LoopInd) * (-1.0) * DepthSoilLayer(LoopInd) + endif + SoilWaterMax = SoilWaterMax + SoilMoistureFieldCap(LoopInd) * (-1.0) * DepthSoilLayer(LoopInd) + SoilWaterFreeMax = SoilWaterFreeMax + & + (SoilMoistureSat(LoopInd)-SoilMoistureFieldCap(LoopInd)) * (-1.0) * DepthSoilLayer(LoopInd) + enddo + SoilWaterTmp = min(SoilWaterTmp, SoilWaterMax) ! tension water [m] + SoilWaterFree = min(SoilWaterFree, SoilWaterFreeMax) ! free water [m] + + ! impervious surface runoff R_IMP + RunoffSfcImp = SoilImpervFrac(1) * SoilSfcInflowMean * TimeStep + + ! solve pervious surface runoff (m) based on Eq. (310) + if ( (SoilWaterTmp/SoilWaterMax) <= (0.5-TensionWatDistrInfl) ) then + RunoffSfcPerv = (1.0-SoilImpervFrac(1)) * SoilSfcInflowMean * TimeStep * & + ((0.5-TensionWatDistrInfl)**(1.0-TensionWatDistrShp)) * & + ((SoilWaterTmp/SoilWaterMax)**TensionWatDistrShp) + else + RunoffSfcPerv = (1.0-SoilImpervFrac(1)) * SoilSfcInflowMean * TimeStep * & + (1.0-(((0.5+TensionWatDistrInfl)**(1.0-TensionWatDistrShp)) * & + ((1.0-(SoilWaterTmp/SoilWaterMax))**TensionWatDistrShp))) + endif + + ! estimate surface runoff based on Eq. (313) + if ( SoilSfcInflowMean == 0.0 ) then + RunoffSurface = 0.0 + else + RunoffSurface = RunoffSfcPerv * (1.0-((1.0-(SoilWaterFree/SoilWaterFreeMax))**FreeWatDistrShp)) + RunoffSfcImp + endif + RunoffSurface = RunoffSurface / TimeStep + RunoffSurface = max(0.0,RunoffSurface) + RunoffSurface = min(SoilSfcInflowMean, RunoffSurface) + InfilRateSfc = SoilSfcInflowMean - RunoffSurface + + end associate + + end subroutine RunoffSurfaceXinAnJiang + +end module RunoffSurfaceXinAnJiangMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/ShallowWaterTableMmfMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/ShallowWaterTableMmfMod.F90 new file mode 100644 index 000000000..32c1b70aa --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/ShallowWaterTableMmfMod.F90 @@ -0,0 +1,176 @@ +module ShallowWaterTableMmfMod + +!!! Diagnoses water table depth and computes recharge when the water table is +!!! within the resolved soil layers, according to the Miguez-Macho&Fan scheme + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine ShallowWaterTableMMF(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: SHALLOWWATERTABLE +! Original code: Miguez-Macho&Fan (Miguez-Macho et al 2007, Fan et al 2007) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: LoopInd ! do-loop index + integer :: IndAbvWatTbl ! layer index above water table layer + integer :: IndWatTbl ! layer index where the water table layer is + real(kind=kind_noahmp) :: WatTblDepthOld ! old water table depth + real(kind=kind_noahmp) :: ThicknessUpLy ! upper layer thickness + real(kind=kind_noahmp) :: SoilMoistDeep ! deep layer soil moisture + real(kind=kind_noahmp), allocatable, dimension(:) :: DepthSoilLayer0 ! temporary soil depth + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + SoilTimeStep => noahmp%config%domain%SoilTimeStep ,& ! in, noahmp soil timestep [s] + DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth of soil layer-bottom [m] + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! in, thickness of snow/soil layers [m] + SoilMoistureEqui => noahmp%water%state%SoilMoistureEqui ,& ! in, equilibrium soil water content [m3/m3] + SoilMoistureSat => noahmp%water%param%SoilMoistureSat ,& ! in, saturated value of soil moisture [m3/m3] + SoilMatPotentialSat => noahmp%water%param%SoilMatPotentialSat ,& ! in, saturated soil matric potential [m] + SoilExpCoeffB => noahmp%water%param%SoilExpCoeffB ,& ! in, soil B parameter + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! inout, total soil water content [m3/m3] + WaterTableDepth => noahmp%water%state%WaterTableDepth ,& ! inout, water table depth [m] + SoilMoistureToWT => noahmp%water%state%SoilMoistureToWT ,& ! inout, soil moisture between bottom of soil & water table + DrainSoilBot => noahmp%water%flux%DrainSoilBot ,& ! inout, soil bottom drainage [m/s] + RechargeGwShallowWT => noahmp%water%state%RechargeGwShallowWT & ! out, groundwater recharge (net vertical flux across water table), positive up + ) +! ---------------------------------------------------------------------- + + ! initialization + if (.not. allocated(DepthSoilLayer0)) allocate(DepthSoilLayer0(0:NumSoilLayer)) + DepthSoilLayer0(1:NumSoilLayer) = DepthSoilLayer(1:NumSoilLayer) + DepthSoilLayer0(0) = 0.0 + + ! find the layer where the water table is + do LoopInd = NumSoilLayer, 1, -1 + if ( (WaterTableDepth+1.0e-6) < DepthSoilLayer0(LoopInd) ) exit + enddo + IndAbvWatTbl = LoopInd + + IndWatTbl = IndAbvWatTbl + 1 ! layer where the water table is + if ( IndWatTbl <= NumSoilLayer ) then ! water table depth in the resolved layers + WatTblDepthOld = WaterTableDepth + if ( SoilMoisture(IndWatTbl) > SoilMoistureEqui(IndWatTbl) ) then + if ( SoilMoisture(IndWatTbl) == SoilMoistureSat(IndWatTbl) ) then ! wtd went to the layer above + WaterTableDepth = DepthSoilLayer0(IndAbvWatTbl) + RechargeGwShallowWT = -(WatTblDepthOld - WaterTableDepth) * & + (SoilMoistureSat(IndWatTbl) - SoilMoistureEqui(IndWatTbl)) + IndAbvWatTbl = IndAbvWatTbl-1 + IndWatTbl = IndWatTbl-1 + if ( IndWatTbl >= 1 ) then + if ( SoilMoisture(IndWatTbl) > SoilMoistureEqui(IndWatTbl) ) then + WatTblDepthOld = WaterTableDepth + WaterTableDepth = min((SoilMoisture(IndWatTbl)*ThicknessSnowSoilLayer(IndWatTbl) - & + SoilMoistureEqui(IndWatTbl)*DepthSoilLayer0(IndAbvWatTbl) + & + SoilMoistureSat(IndWatTbl)*DepthSoilLayer0(IndWatTbl)) / & + (SoilMoistureSat(IndWatTbl)-SoilMoistureEqui(IndWatTbl)), & + DepthSoilLayer0(IndAbvWatTbl) ) + RechargeGwShallowWT = RechargeGwShallowWT - (WatTblDepthOld-WaterTableDepth) * & + (SoilMoistureSat(IndWatTbl)-SoilMoistureEqui(IndWatTbl)) + endif + endif + else ! water table depth stays in the layer + WaterTableDepth = min((SoilMoisture(IndWatTbl)*ThicknessSnowSoilLayer(IndWatTbl) - & + SoilMoistureEqui(IndWatTbl)*DepthSoilLayer0(IndAbvWatTbl) + & + SoilMoistureSat(IndWatTbl)*DepthSoilLayer0(IndWatTbl) ) / & + (SoilMoistureSat(IndWatTbl)-SoilMoistureEqui(IndWatTbl)), & + DepthSoilLayer0(IndAbvWatTbl)) + RechargeGwShallowWT = -(WatTblDepthOld-WaterTableDepth) * & + (SoilMoistureSat(IndWatTbl) - SoilMoistureEqui(IndWatTbl)) + endif + else ! water table depth has gone down to the layer below + WaterTableDepth = DepthSoilLayer0(IndWatTbl) + RechargeGwShallowWT = -(WatTblDepthOld-WaterTableDepth) * & + (SoilMoistureSat(IndWatTbl) - SoilMoistureEqui(IndWatTbl)) + IndWatTbl = IndWatTbl + 1 + IndAbvWatTbl = IndAbvWatTbl + 1 + ! water table depth crossed to the layer below. Now adjust it there + if ( IndWatTbl <= NumSoilLayer ) then + WatTblDepthOld = WaterTableDepth + if ( SoilMoisture(IndWatTbl) > SoilMoistureEqui(IndWatTbl) ) then + WaterTableDepth = min((SoilMoisture(IndWatTbl)*ThicknessSnowSoilLayer(IndWatTbl) - & + SoilMoistureEqui(IndWatTbl)*DepthSoilLayer0(IndAbvWatTbl) + & + SoilMoistureSat(IndWatTbl)*DepthSoilLayer0(IndWatTbl) ) / & + (SoilMoistureSat(IndWatTbl)-SoilMoistureEqui(IndWatTbl)), & + DepthSoilLayer0(IndAbvWatTbl)) + else + WaterTableDepth = DepthSoilLayer0(IndWatTbl) + endif + RechargeGwShallowWT = RechargeGwShallowWT - (WatTblDepthOld-WaterTableDepth) * & + (SoilMoistureSat(IndWatTbl) - SoilMoistureEqui(IndWatTbl)) + else + WatTblDepthOld = WaterTableDepth + ! restore smoi to equilibrium value with water from the ficticious layer below + ! SoilMoistureToWT = SoilMoistureToWT - (SoilMoistureEqui(NumSoilLayer)-SoilMoisture(NumSoilLayer)) + ! DrainSoilBot = DrainSoilBot - 1000 * & + ! (SoilMoistureEqui(NumSoilLayer) - SoilMoisture(NumSoilLayer)) * & + ! ThicknessSnowSoilLayer(NumSoilLayer) / SoilTimeStep + ! SoilMoisture(NumSoilLayer) = SoilMoistureEqui(NumSoilLayer) + + ! adjust water table depth in the ficticious layer below + SoilMoistDeep = SoilMoistureSat(NumSoilLayer) * (-SoilMatPotentialSat(NumSoilLayer) / & + (-SoilMatPotentialSat(NumSoilLayer) - ThicknessSnowSoilLayer(NumSoilLayer)))** & + (1.0/SoilExpCoeffB(NumSoilLayer)) + WaterTableDepth = min((SoilMoistureToWT * ThicknessSnowSoilLayer(NumSoilLayer) - & + SoilMoistDeep * DepthSoilLayer0(NumSoilLayer) + & + SoilMoistureSat(NumSoilLayer) * (DepthSoilLayer0(NumSoilLayer) - & + ThicknessSnowSoilLayer(NumSoilLayer))) / & + (SoilMoistureSat(NumSoilLayer)-SoilMoistDeep), DepthSoilLayer0(NumSoilLayer)) + RechargeGwShallowWT = RechargeGwShallowWT - (WatTblDepthOld-WaterTableDepth) * & + (SoilMoistureSat(NumSoilLayer) - SoilMoistDeep) + endif + endif + else if ( WaterTableDepth >= (DepthSoilLayer0(NumSoilLayer)-ThicknessSnowSoilLayer(NumSoilLayer)) ) then + ! if water table depth was already below the bottom of the resolved soil crust + WatTblDepthOld = WaterTableDepth + SoilMoistDeep = SoilMoistureSat(NumSoilLayer) * (-SoilMatPotentialSat(NumSoilLayer) / & + (-SoilMatPotentialSat(NumSoilLayer) - ThicknessSnowSoilLayer(NumSoilLayer)))** & + (1.0/SoilExpCoeffB(NumSoilLayer)) + if ( SoilMoistureToWT > SoilMoistDeep ) then + WaterTableDepth = min((SoilMoistureToWT * ThicknessSnowSoilLayer(NumSoilLayer) - & + SoilMoistDeep * DepthSoilLayer0(NumSoilLayer) + & + SoilMoistureSat(NumSoilLayer) * (DepthSoilLayer0(NumSoilLayer) - & + ThicknessSnowSoilLayer(NumSoilLayer))) / & + (SoilMoistureSat(NumSoilLayer)-SoilMoistDeep), DepthSoilLayer0(NumSoilLayer)) + RechargeGwShallowWT = -(WatTblDepthOld-WaterTableDepth) * (SoilMoistureSat(NumSoilLayer)-SoilMoistDeep) + else + RechargeGwShallowWT = -(WatTblDepthOld - (DepthSoilLayer0(NumSoilLayer)-ThicknessSnowSoilLayer(NumSoilLayer))) * & + (SoilMoistureSat(NumSoilLayer) - SoilMoistDeep) + WatTblDepthOld = DepthSoilLayer0(NumSoilLayer) - ThicknessSnowSoilLayer(NumSoilLayer) + ! and now even further down + ThicknessUpLy = (SoilMoistDeep - SoilMoistureToWT) * ThicknessSnowSoilLayer(NumSoilLayer) / & + (SoilMoistureSat(NumSoilLayer) - SoilMoistDeep) + WaterTableDepth = WatTblDepthOld - ThicknessUpLy + RechargeGwShallowWT = RechargeGwShallowWT - (SoilMoistureSat(NumSoilLayer)-SoilMoistDeep) * ThicknessUpLy + SoilMoistureToWT = SoilMoistDeep + endif + endif + + if ( (IndAbvWatTbl < NumSoilLayer) .and. (IndAbvWatTbl > 0) ) then + SoilMoistureToWT = SoilMoistureSat(IndAbvWatTbl) + else if ( (IndAbvWatTbl < NumSoilLayer) .and. (IndAbvWatTbl <= 0) ) then + SoilMoistureToWT = SoilMoistureSat(1) + endif + + ! deallocate local arrays to avoid memory leaks + deallocate(DepthSoilLayer0) + + end associate + + end subroutine ShallowWaterTableMMF + +end module ShallowWaterTableMmfMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SnowAgingBatsMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SnowAgingBatsMod.F90 new file mode 100644 index 000000000..c883c1ef6 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SnowAgingBatsMod.F90 @@ -0,0 +1,74 @@ +module SnowAgingBatsMod + +!!! Estimate snow age based on BATS snow albedo scheme for use in BATS snow albedo calculation +!!! Reference: Yang et al. (1997) J.of Climate + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine SnowAgingBats(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: SNOW_AGE +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + real(kind=kind_noahmp) :: SnowAgeFacTot ! total aging effects + real(kind=kind_noahmp) :: SnowAgeVapEff ! effects of grain growth due to vapor diffusion + real(kind=kind_noahmp) :: SnowAgeFrzEff ! effects of grain growth at freezing of melt water + real(kind=kind_noahmp) :: SnowAgeSootEff ! effects of soot + real(kind=kind_noahmp) :: SnowAgeChg ! nondimensional snow age change + real(kind=kind_noahmp) :: SnowAgeTmp ! temporary nondimensional snow age + real(kind=kind_noahmp) :: SnowFreshFac ! fresh snowfall factor + real(kind=kind_noahmp) :: SnowAgeTimeFac ! snow aging time factor + real(kind=kind_noahmp) :: SnowGrowVapExp ! snow vapor diffusion growth exponential factor + +! -------------------------------------------------------------------- + associate( & + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, main noahmp timestep [s] + SnowMassFullCoverOld => noahmp%water%param%SnowMassFullCoverOld ,& ! in, new snow mass to fully cover old snow [mm] + SnowAgeFacBats => noahmp%energy%param%SnowAgeFacBats ,& ! in, snow aging parameter + SnowGrowVapFacBats => noahmp%energy%param%SnowGrowVapFacBats ,& ! in, vapor diffusion snow growth factor + SnowGrowFrzFacBats => noahmp%energy%param%SnowGrowFrzFacBats ,& ! in, extra snow growth factor near freezing + SnowSootFacBats => noahmp%energy%param%SnowSootFacBats ,& ! in, dirt and soot effect factor + TemperatureGrd => noahmp%energy%state%TemperatureGrd ,& ! in, ground temperature [K] + SnowWaterEquiv => noahmp%water%state%SnowWaterEquiv ,& ! in, snow water equivalent [mm] + SnowWaterEquivPrev => noahmp%water%state%SnowWaterEquivPrev ,& ! in, snow water equivalent at previous time step [mm] + SnowAgeNondim => noahmp%energy%state%SnowAgeNondim ,& ! inout, non-dimensional snow age + SnowAgeFac => noahmp%energy%state%SnowAgeFac & ! out, snow age factor + ) +! ---------------------------------------------------------------------- + + if ( SnowWaterEquiv <= 0.0 ) then + SnowAgeNondim = 0.0 + else + SnowAgeTimeFac = MainTimeStep / SnowAgeFacBats + SnowGrowVapExp = SnowGrowVapFacBats * (1.0/ConstFreezePoint - 1.0/TemperatureGrd) + SnowAgeVapEff = exp(SnowGrowVapExp) + SnowAgeFrzEff = exp(amin1(0.0, SnowGrowFrzFacBats*SnowGrowVapExp)) + SnowAgeSootEff = SnowSootFacBats + SnowAgeFacTot = SnowAgeVapEff + SnowAgeFrzEff + SnowAgeSootEff + SnowAgeChg = SnowAgeTimeFac * SnowAgeFacTot + SnowFreshFac = amax1(0.0, SnowWaterEquiv-SnowWaterEquivPrev) / SnowMassFullCoverOld + SnowAgeTmp = (SnowAgeNondim + SnowAgeChg) * (1.0 - SnowFreshFac) + SnowAgeNondim = amax1(0.0, SnowAgeTmp) + endif + + SnowAgeFac = SnowAgeNondim / (SnowAgeNondim + 1.0) + + end associate + + end subroutine SnowAgingBats + +end module SnowAgingBatsMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SnowAlbedoBatsMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SnowAlbedoBatsMod.F90 new file mode 100644 index 000000000..9ab51bc5b --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SnowAlbedoBatsMod.F90 @@ -0,0 +1,68 @@ +module SnowAlbedoBatsMod + +!!! Compute snow albedo based on BATS scheme (Yang et al. (1997) J.of Climate) + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine SnowAlbedoBats(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: SNOWALB_BATS +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + real(kind=kind_noahmp) :: ZenithAngFac ! solar zenith angle correction factor + real(kind=kind_noahmp) :: ZenithAngFacTmp ! temperary zenith angle correction factor + real(kind=kind_noahmp) :: SolarAngleFac2 ! 2.0 * SolarAngleFac + real(kind=kind_noahmp) :: SolarAngleFac1 ! 1 / SolarAngleFac + real(kind=kind_noahmp) :: SolarAngleFac ! adjustable solar zenith angle factor + +! -------------------------------------------------------------------- + associate( & + NumSwRadBand => noahmp%config%domain%NumSwRadBand ,& ! in, number of solar radiation wave bands + CosSolarZenithAngle => noahmp%config%domain%CosSolarZenithAngle ,& ! in, cosine solar zenith angle + SolarZenithAdjBats => noahmp%energy%param%SolarZenithAdjBats ,& ! in, zenith angle snow albedo adjustment + FreshSnoAlbVisBats => noahmp%energy%param%FreshSnoAlbVisBats ,& ! in, new snow visible albedo + FreshSnoAlbNirBats => noahmp%energy%param%FreshSnoAlbNirBats ,& ! in, new snow NIR albedo + SnoAgeFacDifVisBats => noahmp%energy%param%SnoAgeFacDifVisBats ,& ! in, age factor for diffuse visible snow albedo + SnoAgeFacDifNirBats => noahmp%energy%param%SnoAgeFacDifNirBats ,& ! in, age factor for diffuse NIR snow albedo + SzaFacDirVisBats => noahmp%energy%param%SzaFacDirVisBats ,& ! in, cosz factor for direct visible snow albedo + SzaFacDirNirBats => noahmp%energy%param%SzaFacDirNirBats ,& ! in, cosz factor for direct NIR snow albedo + SnowAgeFac => noahmp%energy%state%SnowAgeFac ,& ! in, snow age factor + AlbedoSnowDir => noahmp%energy%state%AlbedoSnowDir ,& ! out, snow albedo for direct(1=vis, 2=nir) + AlbedoSnowDif => noahmp%energy%state%AlbedoSnowDif & ! out, snow albedo for diffuse(1=vis, 2=nir) + ) +! ---------------------------------------------------------------------- + + ! initialization + AlbedoSnowDir(1:NumSwRadBand) = 0.0 + AlbedoSnowDif(1:NumSwRadBand) = 0.0 + + ! when CosSolarZenithAngle > 0 + SolarAngleFac = SolarZenithAdjBats + SolarAngleFac1 = 1.0 / SolarAngleFac + SolarAngleFac2 = 2.0 * SolarAngleFac + ZenithAngFacTmp = (1.0 + SolarAngleFac1) / (1.0 + SolarAngleFac2*CosSolarZenithAngle) - SolarAngleFac1 + ZenithAngFac = amax1(ZenithAngFacTmp, 0.0) + AlbedoSnowDif(1) = FreshSnoAlbVisBats * (1.0 - SnoAgeFacDifVisBats * SnowAgeFac) + AlbedoSnowDif(2) = FreshSnoAlbNirBats * (1.0 - SnoAgeFacDifNirBats * SnowAgeFac) + AlbedoSnowDir(1) = AlbedoSnowDif(1) + SzaFacDirVisBats * ZenithAngFac * (1.0 - AlbedoSnowDif(1)) + AlbedoSnowDir(2) = AlbedoSnowDif(2) + SzaFacDirNirBats * ZenithAngFac * (1.0 - AlbedoSnowDif(2)) + + end associate + + end subroutine SnowAlbedoBats + +end module SnowAlbedoBatsMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SnowAlbedoClassMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SnowAlbedoClassMod.F90 new file mode 100644 index 000000000..06185e9d6 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SnowAlbedoClassMod.F90 @@ -0,0 +1,68 @@ +module SnowAlbedoClassMod + +!!! Compute snow albedo based on the CLASS scheme (Verseghy, 1991) + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine SnowAlbedoClass(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: SNOWALB_CLASS +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + real(kind=kind_noahmp) :: SnowAlbedoTmp ! temporary snow albedo + +! -------------------------------------------------------------------- + associate( & + NumSwRadBand => noahmp%config%domain%NumSwRadBand ,& ! in, number of solar radiation wave bands + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, noahmp main time step [s] + SnowfallGround => noahmp%water%flux%SnowfallGround ,& ! in, snowfall at ground [mm/s] + SnowMassFullCoverOld => noahmp%water%param%SnowMassFullCoverOld ,& ! in, new snow mass to fully cover old snow [mm] + SnowAlbRefClass => noahmp%energy%param%SnowAlbRefClass ,& ! in, reference snow albedo in CLASS scheme + SnowAgeFacClass => noahmp%energy%param%SnowAgeFacClass ,& ! in, snow aging e-folding time [s] + SnowAlbFreshClass => noahmp%energy%param%SnowAlbFreshClass ,& ! in, fresh snow albedo + AlbedoSnowPrev => noahmp%energy%state%AlbedoSnowPrev ,& ! in, snow albedo at last time step + AlbedoSnowDir => noahmp%energy%state%AlbedoSnowDir ,& ! out, snow albedo for direct (1=vis, 2=nir) + AlbedoSnowDif => noahmp%energy%state%AlbedoSnowDif & ! out, snow albedo for diffuse (1=vis, 2=nir) + ) +! ---------------------------------------------------------------------- + + ! initialization + AlbedoSnowDir(1:NumSwRadBand) = 0.0 + AlbedoSnowDif(1:NumSwRadBand) = 0.0 + + ! when CosSolarZenithAngle > 0 + SnowAlbedoTmp = SnowAlbRefClass + (AlbedoSnowPrev-SnowAlbRefClass) * exp(-0.01*MainTimeStep/SnowAgeFacClass) + + ! 1 mm fresh snow(SWE) -- 10mm snow depth, assumed the fresh snow density 100kg/m3 + ! here assume 1cm snow depth will fully cover the old snow + if ( SnowfallGround > 0.0 ) then + SnowAlbedoTmp = SnowAlbedoTmp + min(SnowfallGround, SnowMassFullCoverOld/MainTimeStep) * & + (SnowAlbFreshClass-SnowAlbedoTmp) / (SnowMassFullCoverOld/MainTimeStep) + endif + + AlbedoSnowDif(1) = SnowAlbedoTmp + AlbedoSnowDif(2) = SnowAlbedoTmp + AlbedoSnowDir(1) = SnowAlbedoTmp + AlbedoSnowDir(2) = SnowAlbedoTmp + + AlbedoSnowPrev = SnowAlbedoTmp + + end associate + + end subroutine SnowAlbedoClass + +end module SnowAlbedoClassMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SnowCoverGlacierMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SnowCoverGlacierMod.F90 new file mode 100644 index 000000000..9d0b58f12 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SnowCoverGlacierMod.F90 @@ -0,0 +1,41 @@ +module SnowCoverGlacierMod + +!!! Compute glacier ground snow cover fraction + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine SnowCoverGlacier(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: None (embedded in RADIATION_GLACIER subroutine) +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + +! -------------------------------------------------------------------- + associate( & + SnowWaterEquiv => noahmp%water%state%SnowWaterEquiv ,& ! in, snow water equivalent [mm] + SnowCoverFrac => noahmp%water%state%SnowCoverFrac & ! out, snow cover fraction + ) +! ---------------------------------------------------------------------- + + SnowCoverFrac = 0.0 + if ( SnowWaterEquiv > 0.0 ) SnowCoverFrac = 1.0 + + end associate + + end subroutine SnowCoverGlacier + +end module SnowCoverGlacierMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SnowCoverGroundNiu07Mod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SnowCoverGroundNiu07Mod.F90 new file mode 100644 index 000000000..78456dee9 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SnowCoverGroundNiu07Mod.F90 @@ -0,0 +1,51 @@ +module SnowCoverGroundNiu07Mod + +!!! Compute ground snow cover fraction based on Niu and Yang (2007, JGR) scheme + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine SnowCoverGroundNiu07(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: None (embedded in ENERGY subroutine) +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + real(kind=kind_noahmp) :: SnowDensBulk ! bulk density of snow [Kg/m3] + real(kind=kind_noahmp) :: MeltFac ! melting factor for snow cover frac + +! -------------------------------------------------------------------- + associate( & + SnowMeltFac => noahmp%water%param%SnowMeltFac ,& ! in, snowmelt m parameter + SnowCoverFac => noahmp%water%param%SnowCoverFac ,& ! in, snow cover factor [m] + SnowDepth => noahmp%water%state%SnowDepth ,& ! in, snow depth [m] + SnowWaterEquiv => noahmp%water%state%SnowWaterEquiv ,& ! in, snow water equivalent [mm] + SnowCoverFrac => noahmp%water%state%SnowCoverFrac & ! out, snow cover fraction + ) +! ---------------------------------------------------------------------- + + SnowCoverFrac = 0.0 + if ( SnowDepth > 0.0 ) then + SnowDensBulk = SnowWaterEquiv / SnowDepth + MeltFac = (SnowDensBulk / 100.0)**SnowMeltFac + !SnowCoverFrac = tanh( SnowDepth /(2.5 * Z0 * MeltFac)) + SnowCoverFrac = tanh( SnowDepth /(SnowCoverFac * MeltFac)) ! C.He: bring hard-coded 2.5*z0 to MPTABLE + endif + + end associate + + end subroutine SnowCoverGroundNiu07 + +end module SnowCoverGroundNiu07Mod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SnowLayerCombineMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SnowLayerCombineMod.F90 new file mode 100644 index 000000000..909542f2b --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SnowLayerCombineMod.F90 @@ -0,0 +1,185 @@ +module SnowLayerCombineMod + +!!! Snowpack layer combination process +!!! Update snow ice, snow water, snow thickness, snow temperature + + use Machine + use NoahmpVarType + use ConstantDefineMod + use SnowLayerWaterComboMod, only: SnowLayerWaterCombo + + implicit none + +contains + + subroutine SnowLayerCombine(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: COMBINE +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: I,J,K,L ! node indices + integer :: NumSnowLayerOld ! number of snow layer + integer :: IndLayer ! node index + integer :: IndNeighbor ! adjacent node selected for combination + real(kind=kind_noahmp) :: SnowIceTmp ! total ice mass in snow + real(kind=kind_noahmp) :: SnowLiqTmp ! total liquid water in snow + real(kind=kind_noahmp) :: SnowThickMin(3) ! minimum thickness of each snow layer + data SnowThickMin /0.025, 0.025, 0.1/ ! MB: change limit + !data SnowThickMin /0.045, 0.05, 0.2/ + +! -------------------------------------------------------------------- + associate( & + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! inout, actual number of snow layers (negative) + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! inout, thickness of snow/soil layers [m] + SnowDepth => noahmp%water%state%SnowDepth ,& ! inout, snow depth [m] + SnowWaterEquiv => noahmp%water%state%SnowWaterEquiv ,& ! inout, snow water equivalent [mm] + SnowIce => noahmp%water%state%SnowIce ,& ! inout, snow layer ice [mm] + SnowLiqWater => noahmp%water%state%SnowLiqWater ,& ! inout, snow layer liquid water [mm] + SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! inout, soil liquid moisture [m3/m3] + SoilIce => noahmp%water%state%SoilIce ,& ! inout, soil ice moisture [m3/m3] + TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow ,& ! inout, snow and soil layer temperature [K] + PondSfcThinSnwComb => noahmp%water%state%PondSfcThinSnwComb ,& ! out, surface ponding [mm] from liquid in thin snow layer combination + PondSfcThinSnwTrans => noahmp%water%state%PondSfcThinSnwTrans & ! out, surface ponding [mm] from thin snow liquid during transition from multilayer to no layer + ) +! ---------------------------------------------------------------------- + +! check and combine small ice content layer + NumSnowLayerOld = NumSnowLayerNeg + + do J = NumSnowLayerOld+1,0 + if ( SnowIce(J) <= 0.1 ) then + if ( J /= 0 ) then + SnowLiqWater(J+1) = SnowLiqWater(J+1) + SnowLiqWater(J) + SnowIce(J+1) = SnowIce(J+1) + SnowIce(J) + ThicknessSnowSoilLayer(J+1) = ThicknessSnowSoilLayer(J+1) + ThicknessSnowSoilLayer(J) + else + if ( NumSnowLayerNeg < -1 ) then ! MB/KM: change to NumSnowLayerNeg + SnowLiqWater(J-1) = SnowLiqWater(J-1) + SnowLiqWater(J) + SnowIce(J-1) = SnowIce(J-1) + SnowIce(J) + ThicknessSnowSoilLayer(J-1) = ThicknessSnowSoilLayer(J-1) + ThicknessSnowSoilLayer(J) + else + if ( SnowIce(J) >= 0.0 ) then + PondSfcThinSnwComb = SnowLiqWater(J) ! NumSnowLayerNeg WILL GET SET TO ZERO BELOW; PondSfcThinSnwComb WILL GET + SnowWaterEquiv = SnowIce(J) ! ADDED TO PONDING FROM PHASECHANGE PONDING SHOULD BE + SnowDepth = ThicknessSnowSoilLayer(J) ! ZERO HERE BECAUSE IT WAS CALCULATED FOR THIN SNOW + else ! SnowIce OVER-SUBLIMATED EARLIER + PondSfcThinSnwComb = SnowLiqWater(J) + SnowIce(J) + if ( PondSfcThinSnwComb < 0.0 ) then ! IF SnowIce AND SnowLiqWater SUBLIMATES REMOVE FROM SOIL + SoilIce(1) = SoilIce(1) + PondSfcThinSnwComb/(ThicknessSnowSoilLayer(1)*1000.0) ! negative SoilIce from oversublimation is adjusted below + PondSfcThinSnwComb = 0.0 + endif + SnowWaterEquiv = 0.0 + SnowDepth = 0.0 + endif ! if(SnowIce(J) >= 0.0) + SnowLiqWater(J) = 0.0 + SnowIce(J) = 0.0 + ThicknessSnowSoilLayer(J) = 0.0 + endif ! if(NumSnowLayerOld < -1) + + !SoilLiqWater(1) = SoilLiqWater(1) + SnowLiqWater(J)/(ThicknessSnowSoilLayer(1)*1000.0) + !SoilIce(1) = SoilIce(1) + SnowIce(J)/(ThicknessSnowSoilLayer(1)*1000.0) + endif ! if(J /= 0) + + ! shift all elements above this down by one. + if ( (J > NumSnowLayerNeg+1) .and. (NumSnowLayerNeg < -1) ) then + do I = J, NumSnowLayerNeg+2, -1 + TemperatureSoilSnow(I) = TemperatureSoilSnow(I-1) + SnowLiqWater(I) = SnowLiqWater(I-1) + SnowIce(I) = SnowIce(I-1) + ThicknessSnowSoilLayer(I) = ThicknessSnowSoilLayer(I-1) + enddo + endif + NumSnowLayerNeg = NumSnowLayerNeg + 1 + + endif ! if(SnowIce(J) <= 0.1) + enddo ! do J + +! to conserve water in case of too large surface sublimation + if ( SoilIce(1) < 0.0) then + SoilLiqWater(1) = SoilLiqWater(1) + SoilIce(1) + SoilIce(1) = 0.0 + endif + + if ( NumSnowLayerNeg ==0 ) return ! MB: get out if no longer multi-layer + + SnowWaterEquiv = 0.0 + SnowDepth = 0.0 + SnowIceTmp = 0.0 + SnowLiqTmp = 0.0 + + do J = NumSnowLayerNeg+1, 0 + SnowWaterEquiv = SnowWaterEquiv + SnowIce(J) + SnowLiqWater(J) + SnowDepth = SnowDepth + ThicknessSnowSoilLayer(J) + SnowIceTmp = SnowIceTmp + SnowIce(J) + SnowLiqTmp = SnowLiqTmp + SnowLiqWater(J) + enddo + +! check the snow depth - all snow gone, the liquid water assumes ponding on soil surface. + !if ( (SnowDepth < 0.05) .and. (NumSnowLayerNeg < 0) ) then + if ( (SnowDepth < 0.025) .and. (NumSnowLayerNeg < 0) ) then ! MB: change limit + NumSnowLayerNeg = 0 + SnowWaterEquiv = SnowIceTmp + PondSfcThinSnwTrans = SnowLiqTmp ! LIMIT OF NumSnowLayerNeg < 0 MEANS INPUT PONDING + if ( SnowWaterEquiv <= 0.0 ) SnowDepth = 0.0 ! SHOULD BE ZERO; SEE ABOVE + endif + +! check the snow depth - snow layers combined + if ( NumSnowLayerNeg < -1 ) then + NumSnowLayerOld = NumSnowLayerNeg + IndLayer = 1 + do I = NumSnowLayerOld+1, 0 + if ( ThicknessSnowSoilLayer(I) < SnowThickMin(IndLayer) ) then + if ( I == NumSnowLayerNeg+1 ) then + IndNeighbor = I + 1 + else if ( I == 0 ) then + IndNeighbor = I - 1 + else + IndNeighbor = I + 1 + if ( (ThicknessSnowSoilLayer(I-1)+ThicknessSnowSoilLayer(I)) < & + (ThicknessSnowSoilLayer(I+1)+ThicknessSnowSoilLayer(I)) ) IndNeighbor = I-1 + endif + ! Node l and j are combined and stored as node j. + if ( IndNeighbor > I ) then + J = IndNeighbor + L = I + else + J = I + L = IndNeighbor + endif + + ! update combined snow water & temperature + call SnowLayerWaterCombo(ThicknessSnowSoilLayer(J), SnowLiqWater(J), SnowIce(J), TemperatureSoilSnow(J), & + ThicknessSnowSoilLayer(L), SnowLiqWater(L), SnowIce(L), TemperatureSoilSnow(L) ) + + ! Now shift all elements above this down one. + if ( (J-1) > (NumSnowLayerNeg+1) ) then + do K = J-1, NumSnowLayerNeg+2, -1 + TemperatureSoilSnow(K) = TemperatureSoilSnow(K-1) + SnowIce(K) = SnowIce(K-1) + SnowLiqWater(K) = SnowLiqWater(K-1) + ThicknessSnowSoilLayer(K) = ThicknessSnowSoilLayer(K-1) + enddo + endif + ! Decrease the number of snow layers + NumSnowLayerNeg = NumSnowLayerNeg + 1 + if ( NumSnowLayerNeg >= -1 ) Exit + else + ! The layer thickness is greater than the prescribed minimum value + IndLayer = IndLayer + 1 + endif + enddo + endif + + end associate + + end subroutine SnowLayerCombine + +end module SnowLayerCombineMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SnowLayerDivideMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SnowLayerDivideMod.F90 new file mode 100644 index 000000000..6254978a4 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SnowLayerDivideMod.F90 @@ -0,0 +1,160 @@ +module SnowLayerDivideMod + +!!! Snowpack layer division process +!!! Update snow ice, snow water, snow thickness, snow temperature + + use Machine + use NoahmpVarType + use ConstantDefineMod + use SnowLayerWaterComboMod, only: SnowLayerWaterCombo + + implicit none + +contains + + subroutine SnowLayerDivide(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: DIVIDE +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: LoopInd ! snow layer loop index + integer :: NumSnowLayerTmp ! number of snow layer top to bottom + real(kind=kind_noahmp) :: SnowThickCombTmp ! thickness of the combined [m] + real(kind=kind_noahmp) :: SnowIceExtra ! extra snow ice to be divided compared to allowed layer thickness + real(kind=kind_noahmp) :: SnowLiqExtra ! extra snow liquid water to be divided compared to allowed layer thickness + real(kind=kind_noahmp) :: SnowFracExtra ! fraction of extra snow to be divided compared to allowed layer thickness + real(kind=kind_noahmp) :: SnowTempGrad ! temperature gradient between two snow layers + real(kind=kind_noahmp), allocatable, dimension(:) :: SnowThickTmp ! snow layer thickness [m] + real(kind=kind_noahmp), allocatable, dimension(:) :: SnowIceTmp ! partial volume of ice [m3/m3] + real(kind=kind_noahmp), allocatable, dimension(:) :: SnowLiqTmp ! partial volume of liquid water [m3/m3] + real(kind=kind_noahmp), allocatable, dimension(:) :: TemperatureSnowTmp ! node temperature [K] + +! -------------------------------------------------------------------- + associate( & + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! inout, actual number of snow layers (negative) + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! inout, thickness of snow/soil layers [m] + TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow ,& ! inout, snow and soil layer temperature [K] + SnowIce => noahmp%water%state%SnowIce ,& ! inout, snow layer ice [mm] + SnowLiqWater => noahmp%water%state%SnowLiqWater & ! inout, snow layer liquid water [mm] + ) +! ---------------------------------------------------------------------- + + ! initialization + if (.not. allocated(SnowIceTmp) ) allocate(SnowIceTmp (1:NumSnowLayerMax)) + if (.not. allocated(SnowLiqTmp) ) allocate(SnowLiqTmp (1:NumSnowLayerMax)) + if (.not. allocated(TemperatureSnowTmp)) allocate(TemperatureSnowTmp(1:NumSnowLayerMax)) + if (.not. allocated(SnowThickTmp) ) allocate(SnowThickTmp (1:NumSnowLayerMax)) + SnowIceTmp (:) = 0.0 + SnowLiqTmp (:) = 0.0 + TemperatureSnowTmp(:) = 0.0 + SnowThickTmp (:) = 0.0 + + do LoopInd = 1, NumSnowLayerMax + if ( LoopInd <= abs(NumSnowLayerNeg) ) then + SnowThickTmp(LoopInd) = ThicknessSnowSoilLayer(LoopInd+NumSnowLayerNeg) + SnowIceTmp(LoopInd) = SnowIce(LoopInd+NumSnowLayerNeg) + SnowLiqTmp(LoopInd) = SnowLiqWater(LoopInd+NumSnowLayerNeg) + TemperatureSnowTmp(LoopInd) = TemperatureSoilSnow(LoopInd+NumSnowLayerNeg) + endif + enddo + + ! start snow layer division + NumSnowLayerTmp = abs(NumSnowLayerNeg) + + if ( NumSnowLayerTmp == 1 ) then + ! Specify a new snow layer + if ( SnowThickTmp(1) > 0.05 ) then + NumSnowLayerTmp = 2 + SnowThickTmp(1) = SnowThickTmp(1)/2.0 + SnowIceTmp(1) = SnowIceTmp(1)/2.0 + SnowLiqTmp(1) = SnowLiqTmp(1)/2.0 + SnowThickTmp(2) = SnowThickTmp(1) + SnowIceTmp(2) = SnowIceTmp(1) + SnowLiqTmp(2) = SnowLiqTmp(1) + TemperatureSnowTmp(2) = TemperatureSnowTmp(1) + endif + endif + + if ( NumSnowLayerTmp > 1 ) then + if ( SnowThickTmp(1) > 0.05 ) then ! maximum allowed thickness (5cm) for top snow layer + SnowThickCombTmp = SnowThickTmp(1) - 0.05 + SnowFracExtra = SnowThickCombTmp / SnowThickTmp(1) + SnowIceExtra = SnowFracExtra * SnowIceTmp(1) + SnowLiqExtra = SnowFracExtra * SnowLiqTmp(1) + SnowFracExtra = 0.05 / SnowThickTmp(1) + SnowIceTmp(1) = SnowFracExtra*SnowIceTmp(1) + SnowLiqTmp(1) = SnowFracExtra*SnowLiqTmp(1) + SnowThickTmp(1) = 0.05 + + ! update combined snow water & temperature + call SnowLayerWaterCombo(SnowThickTmp(2), SnowLiqTmp(2), SnowIceTmp(2), TemperatureSnowTmp(2), & + SnowThickCombTmp, SnowLiqExtra, SnowIceExtra, TemperatureSnowTmp(1)) + + ! subdivide a new layer, maximum allowed thickness (20cm) for second snow layer + if ( (NumSnowLayerTmp <= 2) .and. (SnowThickTmp(2) > 0.20) ) then ! MB: change limit + !if ( (NumSnowLayerTmp <= 2) .and. (SnowThickTmp(2) > 0.10) ) then + NumSnowLayerTmp = 3 + SnowTempGrad = (TemperatureSnowTmp(1) - TemperatureSnowTmp(2)) / & + ((SnowThickTmp(1)+SnowThickTmp(2)) / 2.0) + SnowThickTmp(2) = SnowThickTmp(2) / 2.0 + SnowIceTmp(2) = SnowIceTmp(2) / 2.0 + SnowLiqTmp(2) = SnowLiqTmp(2) / 2.0 + SnowThickTmp(3) = SnowThickTmp(2) + SnowIceTmp(3) = SnowIceTmp(2) + SnowLiqTmp(3) = SnowLiqTmp(2) + TemperatureSnowTmp(3) = TemperatureSnowTmp(2) - SnowTempGrad * SnowThickTmp(2) / 2.0 + if ( TemperatureSnowTmp(3) >= ConstFreezePoint ) then + TemperatureSnowTmp(3) = TemperatureSnowTmp(2) + else + TemperatureSnowTmp(2) = TemperatureSnowTmp(2) + SnowTempGrad * SnowThickTmp(2) / 2.0 + endif + endif + endif ! if(SnowThickTmp(1) > 0.05) + endif ! if (NumSnowLayerTmp > 1) + + if ( NumSnowLayerTmp > 2 ) then + if ( SnowThickTmp(2) > 0.2 ) then + SnowThickCombTmp = SnowThickTmp(2) - 0.2 + SnowFracExtra = SnowThickCombTmp / SnowThickTmp(2) + SnowIceExtra = SnowFracExtra * SnowIceTmp(2) + SnowLiqExtra = SnowFracExtra * SnowLiqTmp(2) + SnowFracExtra = 0.2 / SnowThickTmp(2) + SnowIceTmp(2) = SnowFracExtra * SnowIceTmp(2) + SnowLiqTmp(2) = SnowFracExtra * SnowLiqTmp(2) + SnowThickTmp(2) = 0.2 + + ! update combined snow water & temperature + call SnowLayerWaterCombo(SnowThickTmp(3), SnowLiqTmp(3), SnowIceTmp(3), TemperatureSnowTmp(3), & + SnowThickCombTmp, SnowLiqExtra, SnowIceExtra, TemperatureSnowTmp(2)) + endif + endif + + NumSnowLayerNeg = -NumSnowLayerTmp + + do LoopInd = NumSnowLayerNeg+1, 0 + ThicknessSnowSoilLayer(LoopInd) = SnowThickTmp(LoopInd-NumSnowLayerNeg) + SnowIce(LoopInd) = SnowIceTmp(LoopInd-NumSnowLayerNeg) + SnowLiqWater(LoopInd) = SnowLiqTmp(LoopInd-NumSnowLayerNeg) + TemperatureSoilSnow(LoopInd) = TemperatureSnowTmp(LoopInd-NumSnowLayerNeg) + enddo + + ! deallocate local arrays to avoid memory leaks + deallocate(SnowIceTmp ) + deallocate(SnowLiqTmp ) + deallocate(TemperatureSnowTmp) + deallocate(SnowThickTmp ) + + end associate + + end subroutine SnowLayerDivide + +end module SnowLayerDivideMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SnowLayerWaterComboMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SnowLayerWaterComboMod.F90 new file mode 100644 index 000000000..37c48d3d1 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SnowLayerWaterComboMod.F90 @@ -0,0 +1,70 @@ +module SnowLayerWaterComboMod + +!!! Update snow water and temperature for combined snowpack layer + + use Machine + use ConstantDefineMod + + implicit none + +contains + + subroutine SnowLayerWaterCombo(ThickLayer1, LiqLayer1, IceLayer1, TempLayer1, & + ThickLayer2, LiqLayer2, IceLayer2, TempLayer2) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: COMBO +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + +! IN and OUT variables + real(kind=kind_noahmp), intent(in) :: ThickLayer2 ! nodal thickness of 2 elements being combined [m] + real(kind=kind_noahmp), intent(in) :: LiqLayer2 ! liquid water of element 2 [kg/m2] + real(kind=kind_noahmp), intent(in) :: IceLayer2 ! ice of element 2 [kg/m2] + real(kind=kind_noahmp), intent(in) :: TempLayer2 ! nodal temperature of element 2 [K] + real(kind=kind_noahmp), intent(inout) :: ThickLayer1 ! nodal thickness of 1 elements being combined [m] + real(kind=kind_noahmp), intent(inout) :: LiqLayer1 ! liquid water of element 1 + real(kind=kind_noahmp), intent(inout) :: IceLayer1 ! ice of element 1 [kg/m2] + real(kind=kind_noahmp), intent(inout) :: TempLayer1 ! node temperature of element 1 [K] + +! local variable + real(kind=kind_noahmp) :: ThickLayerComb ! total thickness of nodes 1 and 2 + real(kind=kind_noahmp) :: LiqLayerComb ! combined liquid water [kg/m2] + real(kind=kind_noahmp) :: IceLayerComb ! combined ice [kg/m2] + real(kind=kind_noahmp) :: TempLayerComb ! combined node temperature [K] + real(kind=kind_noahmp) :: EnthLayer1 ! enthalpy of element 1 [J/m2] + real(kind=kind_noahmp) :: EnthLayer2 ! enthalpy of element 2 [J/m2] + real(kind=kind_noahmp) :: EnthLayerComb ! combined enthalpy [J/m2] + +! ---------------------------------------------------------------------- + + ThickLayerComb = ThickLayer1 + ThickLayer2 + IceLayerComb = IceLayer1 + IceLayer2 + LiqLayerComb = LiqLayer1 + LiqLayer2 + EnthLayer1 = (ConstHeatCapacIce*IceLayer1 + ConstHeatCapacWater*LiqLayer1) * & + (TempLayer1-ConstFreezePoint) + ConstLatHeatFusion*LiqLayer1 + EnthLayer2 = (ConstHeatCapacIce*IceLayer2 + ConstHeatCapacWater*LiqLayer2) * & + (TempLayer2-ConstFreezePoint) + ConstLatHeatFusion*LiqLayer2 + + EnthLayerComb = EnthLayer1 + EnthLayer2 + if ( EnthLayerComb < 0.0 ) then + TempLayerComb = ConstFreezePoint + EnthLayerComb / & + (ConstHeatCapacIce*IceLayerComb + ConstHeatCapacWater*LiqLayerComb) + else if ( EnthLayerComb <= (ConstLatHeatFusion*LiqLayerComb) ) then + TempLayerComb = ConstFreezePoint + else + TempLayerComb = ConstFreezePoint + (EnthLayerComb-ConstLatHeatFusion*LiqLayerComb) / & + (ConstHeatCapacIce*IceLayerComb + ConstHeatCapacWater*LiqLayerComb) + endif + + ThickLayer1 = ThickLayerComb + IceLayer1 = IceLayerComb + LiqLayer1 = LiqLayerComb + TempLayer1 = TempLayerComb + + end subroutine SnowLayerWaterCombo + +end module SnowLayerWaterComboMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SnowThermalPropertyMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SnowThermalPropertyMod.F90 new file mode 100644 index 000000000..6e6db9a7e --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SnowThermalPropertyMod.F90 @@ -0,0 +1,85 @@ +module SnowThermalPropertyMod + +!!! Compute snowpack thermal conductivity and volumetric specific heat + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine SnowThermalProperty(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: CSNOW +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: LoopInd ! loop index + real(kind=kind_noahmp), allocatable, dimension(:) :: SnowDensBulk ! bulk density of snow [kg/m3] + +! -------------------------------------------------------------------- + associate( & + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! in, actual number of snow layers (negative) + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! in, thickness of snow/soil layers [m] + OptSnowThermConduct => noahmp%config%nmlist%OptSnowThermConduct ,& ! in, options for snow thermal conductivity schemes + SnowIce => noahmp%water%state%SnowIce ,& ! in, snow layer ice [mm] + SnowLiqWater => noahmp%water%state%SnowLiqWater ,& ! in, snow layer liquid water [mm] + SnowIceVol => noahmp%water%state%SnowIceVol ,& ! out, partial volume of snow ice [m3/m3] + SnowLiqWaterVol => noahmp%water%state%SnowLiqWaterVol ,& ! out, partial volume of snow liquid water [m3/m3] + SnowEffPorosity => noahmp%water%state%SnowEffPorosity ,& ! out, snow effective porosity [m3/m3] + HeatCapacVolSnow => noahmp%energy%state%HeatCapacVolSnow ,& ! out, snow layer volumetric specific heat [J/m3/K] + ThermConductSnow => noahmp%energy%state%ThermConductSnow & ! out, snow layer thermal conductivity [W/m/K] + ) +! ---------------------------------------------------------------------- + + ! initialization + if (.not. allocated(SnowDensBulk)) allocate(SnowDensBulk(-NumSnowLayerMax+1:0)) + SnowDensBulk = 0.0 + + ! effective porosity of snow + do LoopInd = NumSnowLayerNeg+1, 0 + SnowIceVol(LoopInd) = min(1.0, SnowIce(LoopInd)/(ThicknessSnowSoilLayer(LoopInd)*ConstDensityIce)) + SnowEffPorosity(LoopInd) = 1.0 - SnowIceVol(LoopInd) + SnowLiqWaterVol(LoopInd) = min(SnowEffPorosity(LoopInd), & + SnowLiqWater(LoopInd)/(ThicknessSnowSoilLayer(LoopInd)*ConstDensityWater)) + enddo + + ! thermal capacity of snow + do LoopInd = NumSnowLayerNeg+1, 0 + SnowDensBulk(LoopInd) = (SnowIce(LoopInd) + SnowLiqWater(LoopInd)) / ThicknessSnowSoilLayer(LoopInd) + HeatCapacVolSnow(LoopInd) = ConstHeatCapacIce*SnowIceVol(LoopInd) + ConstHeatCapacWater*SnowLiqWaterVol(LoopInd) + !HeatCapacVolSnow(LoopInd) = 0.525e06 ! constant + enddo + + ! thermal conductivity of snow + do LoopInd = NumSnowLayerNeg+1, 0 + if (OptSnowThermConduct == 1) & + ThermConductSnow(LoopInd) = 3.2217e-6 * SnowDensBulk(LoopInd)**2.0 ! Stieglitz(yen,1965) + if (OptSnowThermConduct == 2) & + ThermConductSnow(LoopInd) = 2e-2 + 2.5e-6*SnowDensBulk(LoopInd)*SnowDensBulk(LoopInd) ! Anderson, 1976 + if (OptSnowThermConduct == 3) & + ThermConductSnow(LoopInd) = 0.35 ! constant + if (OptSnowThermConduct == 4) & + ThermConductSnow(LoopInd) = 2.576e-6 * SnowDensBulk(LoopInd)**2.0 + 0.074 ! Verseghy (1991) + if (OptSnowThermConduct == 5) & + ThermConductSnow(LoopInd) = 2.22 * (SnowDensBulk(LoopInd)/1000.0)**1.88 ! Douvill(Yen, 1981) + enddo + + ! deallocate local arrays to avoid memory leaks + deallocate(SnowDensBulk) + + end associate + + end subroutine SnowThermalProperty + +end module SnowThermalPropertyMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SnowWaterMainGlacierMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SnowWaterMainGlacierMod.F90 new file mode 100644 index 000000000..0fac6ec05 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SnowWaterMainGlacierMod.F90 @@ -0,0 +1,141 @@ +module SnowWaterMainGlacierMod + +!!! Main glacier snow water module including all snowpack processes +!!! Snowfall -> Snowpack compaction -> Snow layer combination -> Snow layer division -> Snow Hydrology + + use Machine + use NoahmpVarType + use ConstantDefineMod + use SnowfallBelowCanopyMod, only : SnowfallAfterCanopyIntercept + use SnowpackCompactionMod, only : SnowpackCompaction + use SnowLayerCombineMod, only : SnowLayerCombine + use SnowLayerDivideMod, only : SnowLayerDivide + use SnowpackHydrologyGlacierMod, only : SnowpackHydrologyGlacier + + implicit none + +contains + + subroutine SnowWaterMainGlacier(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: SNOWWATER_GLACIER +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variables + integer :: LoopInd ! do loop/array indices + real(kind=kind_noahmp) :: SnowDensBulk ! bulk density of snow [kg/m3] + +! -------------------------------------------------------------------- + associate( & + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, noahmp main time step [s] + DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth [m] of layer-bottom from soil surface + SnoWatEqvMaxGlacier => noahmp%water%param%SnoWatEqvMaxGlacier ,& ! in, Maximum SWE allowed at glaciers [mm] + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! inout, thickness of snow/soil layers [m] + DepthSnowSoilLayer => noahmp%config%domain%DepthSnowSoilLayer ,& ! inout, depth of snow/soil layer-bottom [m] + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! inout, actual number of snow layers (negative) + SnowDepth => noahmp%water%state%SnowDepth ,& ! inout, snow depth [m] + SnowWaterEquiv => noahmp%water%state%SnowWaterEquiv ,& ! inout, snow water equivalent [mm] + SnowIce => noahmp%water%state%SnowIce ,& ! inout, snow layer ice [mm] + SnowLiqWater => noahmp%water%state%SnowLiqWater ,& ! inout, snow layer liquid water [mm] + TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow ,& ! inout, snow and soil layer temperature [K] + GlacierExcessFlow => noahmp%water%flux%GlacierExcessFlow ,& ! out, glacier excess flow [mm/s] + PondSfcThinSnwComb => noahmp%water%state%PondSfcThinSnwComb ,& ! out, surface ponding [mm] from liquid in thin snow layer combination + PondSfcThinSnwTrans => noahmp%water%state%PondSfcThinSnwTrans & ! out, surface ponding [mm] from thin snow liquid during transition from multilayer to no layer + ) +! ---------------------------------------------------------------------- + + ! initialize out-only variables + GlacierExcessFlow = 0.0 + PondSfcThinSnwComb = 0.0 + PondSfcThinSnwTrans = 0.0 + + ! snowfall + call SnowfallAfterCanopyIntercept(noahmp) + + ! do following snow layer compaction, combination, and division only for multi-layer snowpack + + ! snowpack compaction + if ( NumSnowLayerNeg < 0 ) call SnowpackCompaction(noahmp) + + ! snow layer combination + if ( NumSnowLayerNeg < 0 ) call SnowLayerCombine(noahmp) + + ! snow layer division + if ( NumSnowLayerNeg < 0 ) call SnowLayerDivide(noahmp) + + ! snow hydrology for all snow cases + call SnowpackHydrologyGlacier(noahmp) + + ! set empty snow layer properties to zero + do LoopInd = -NumSnowLayerMax+1, NumSnowLayerNeg + SnowIce(LoopInd) = 0.0 + SnowLiqWater(LoopInd) = 0.0 + TemperatureSoilSnow(LoopInd) = 0.0 + ThicknessSnowSoilLayer(LoopInd) = 0.0 + DepthSnowSoilLayer(LoopInd) = 0.0 + enddo + + ! to obtain equilibrium state of snow in glacier region + if ( SnowWaterEquiv > SnoWatEqvMaxGlacier ) then + SnowDensBulk = SnowIce(0) / ThicknessSnowSoilLayer(0) + GlacierExcessFlow = SnowWaterEquiv - SnoWatEqvMaxGlacier + SnowIce(0) = SnowIce(0) - GlacierExcessFlow + ThicknessSnowSoilLayer(0) = ThicknessSnowSoilLayer(0) - GlacierExcessFlow / SnowDensBulk + GlacierExcessFlow = GlacierExcessFlow / MainTimeStep + endif + + ! sum up snow mass for layered snow + if ( NumSnowLayerNeg < 0 ) then ! MB: only do for multi-layer + SnowWaterEquiv = 0.0 + do LoopInd = NumSnowLayerNeg+1, 0 + SnowWaterEquiv = SnowWaterEquiv + SnowIce(LoopInd) + SnowLiqWater(LoopInd) + enddo + endif + + ! Reset DepthSnowSoilLayer and ThicknessSnowSoilLayer + do LoopInd = NumSnowLayerNeg+1, 0 + ThicknessSnowSoilLayer(LoopInd) = -ThicknessSnowSoilLayer(LoopInd) + enddo + + ThicknessSnowSoilLayer(1) = DepthSoilLayer(1) + do LoopInd = 2, NumSoilLayer + ThicknessSnowSoilLayer(LoopInd) = DepthSoilLayer(LoopInd) - DepthSoilLayer(LoopInd-1) + enddo + + DepthSnowSoilLayer(NumSnowLayerNeg+1) = ThicknessSnowSoilLayer(NumSnowLayerNeg+1) + do LoopInd = NumSnowLayerNeg+2, NumSoilLayer + DepthSnowSoilLayer(LoopInd) = DepthSnowSoilLayer(LoopInd-1) + ThicknessSnowSoilLayer(LoopInd) + enddo + + do LoopInd = NumSnowLayerNeg+1, NumSoilLayer + ThicknessSnowSoilLayer(LoopInd) = -ThicknessSnowSoilLayer(LoopInd) + enddo + + ! Update SnowDepth for multi-layer snow + if ( NumSnowLayerNeg < 0 ) then + SnowDepth = 0.0 + do LoopInd = NumSnowLayerNeg+1, 0 + SnowDepth = SnowDepth + ThicknessSnowSoilLayer(LoopInd) + enddo + endif + + ! update snow quantity + if ( (SnowDepth <= 1.0e-6) .or. (SnowWaterEquiv <= 1.0e-6) ) then + SnowDepth = 0.0 + SnowWaterEquiv = 0.0 + endif + + end associate + + end subroutine SnowWaterMainGlacier + +end module SnowWaterMainGlacierMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SnowWaterMainMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SnowWaterMainMod.F90 new file mode 100644 index 000000000..2e3e7f00a --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SnowWaterMainMod.F90 @@ -0,0 +1,141 @@ +module SnowWaterMainMod + +!!! Main snow water module including all snowpack processes +!!! Snowfall -> Snowpack compaction -> Snow layer combination -> Snow layer division -> Snow Hydrology + + use Machine + use NoahmpVarType + use ConstantDefineMod + use SnowfallBelowCanopyMod, only : SnowfallAfterCanopyIntercept + use SnowpackCompactionMod, only : SnowpackCompaction + use SnowLayerCombineMod, only : SnowLayerCombine + use SnowLayerDivideMod, only : SnowLayerDivide + use SnowpackHydrologyMod, only : SnowpackHydrology + + implicit none + +contains + + subroutine SnowWaterMain(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: SNOWWATER +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: LoopInd ! do loop/array indices + real(kind=kind_noahmp) :: SnowDensBulk ! bulk density of snow [kg/m3] + +! -------------------------------------------------------------------- + associate( & + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, noahmp main time step [s] + DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth [m] of layer-bottom from soil surface + SnoWatEqvMaxGlacier => noahmp%water%param%SnoWatEqvMaxGlacier ,& ! in, Maximum SWE allowed at glaciers [mm] + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! inout, thickness of snow/soil layers [m] + DepthSnowSoilLayer => noahmp%config%domain%DepthSnowSoilLayer ,& ! inout, depth of snow/soil layer-bottom [m] + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! inout, actual number of snow layers (negative) + SnowDepth => noahmp%water%state%SnowDepth ,& ! inout, snow depth [m] + SnowWaterEquiv => noahmp%water%state%SnowWaterEquiv ,& ! inout, snow water equivalent [mm] + SnowIce => noahmp%water%state%SnowIce ,& ! inout, snow layer ice [mm] + SnowLiqWater => noahmp%water%state%SnowLiqWater ,& ! inout, snow layer liquid water [mm] + TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow ,& ! inout, snow and soil layer temperature [K] + GlacierExcessFlow => noahmp%water%flux%GlacierExcessFlow ,& ! out, glacier snow excess flow [mm/s] + PondSfcThinSnwComb => noahmp%water%state%PondSfcThinSnwComb ,& ! out, surface ponding [mm] from liquid in thin snow layer combination + PondSfcThinSnwTrans => noahmp%water%state%PondSfcThinSnwTrans & ! out, surface ponding [mm] from thin snow liquid during transition from multilayer to no layer + ) +! ---------------------------------------------------------------------- + + ! initialize out-only variables + GlacierExcessFlow = 0.0 + PondSfcThinSnwComb = 0.0 + PondSfcThinSnwTrans = 0.0 + + ! snowfall after canopy interception + call SnowfallAfterCanopyIntercept(noahmp) + + ! do following snow layer compaction, combination, and division only for multi-layer snowpack + + ! snowpack compaction + if ( NumSnowLayerNeg < 0 ) call SnowpackCompaction(noahmp) + + ! snow layer combination + if ( NumSnowLayerNeg < 0 ) call SnowLayerCombine(noahmp) + + ! snow layer division + if ( NumSnowLayerNeg < 0 ) call SnowLayerDivide(noahmp) + + ! snow hydrology for all snow cases + call SnowpackHydrology(noahmp) + + ! set empty snow layer properties to zero + do LoopInd = -NumSnowLayerMax+1, NumSnowLayerNeg + SnowIce(LoopInd) = 0.0 + SnowLiqWater(LoopInd) = 0.0 + TemperatureSoilSnow(LoopInd) = 0.0 + ThicknessSnowSoilLayer(LoopInd) = 0.0 + DepthSnowSoilLayer(LoopInd) = 0.0 + enddo + + ! to obtain equilibrium state of snow in glacier region + if ( SnowWaterEquiv > SnoWatEqvMaxGlacier ) then + SnowDensBulk = SnowIce(0) / ThicknessSnowSoilLayer(0) + GlacierExcessFlow = SnowWaterEquiv - SnoWatEqvMaxGlacier + SnowIce(0) = SnowIce(0) - GlacierExcessFlow + ThicknessSnowSoilLayer(0) = ThicknessSnowSoilLayer(0) - GlacierExcessFlow / SnowDensBulk + GlacierExcessFlow = GlacierExcessFlow / MainTimeStep + endif + + ! sum up snow mass for layered snow + if ( NumSnowLayerNeg < 0 ) then ! MB: only do for multi-layer + SnowWaterEquiv = 0.0 + do LoopInd = NumSnowLayerNeg+1, 0 + SnowWaterEquiv = SnowWaterEquiv + SnowIce(LoopInd) + SnowLiqWater(LoopInd) + enddo + endif + + ! Reset DepthSnowSoilLayer and ThicknessSnowSoilLayer + do LoopInd = NumSnowLayerNeg+1, 0 + ThicknessSnowSoilLayer(LoopInd) = -ThicknessSnowSoilLayer(LoopInd) + enddo + + ThicknessSnowSoilLayer(1) = DepthSoilLayer(1) + do LoopInd = 2, NumSoilLayer + ThicknessSnowSoilLayer(LoopInd) = DepthSoilLayer(LoopInd) - DepthSoilLayer(LoopInd-1) + enddo + + DepthSnowSoilLayer(NumSnowLayerNeg+1) = ThicknessSnowSoilLayer(NumSnowLayerNeg+1) + do LoopInd = NumSnowLayerNeg+2, NumSoilLayer + DepthSnowSoilLayer(LoopInd) = DepthSnowSoilLayer(LoopInd-1) + ThicknessSnowSoilLayer(LoopInd) + enddo + + do LoopInd = NumSnowLayerNeg+1, NumSoilLayer + ThicknessSnowSoilLayer(LoopInd) = -ThicknessSnowSoilLayer(LoopInd) + enddo + + ! Update SnowDepth for multi-layer snow + if ( NumSnowLayerNeg < 0 ) then + SnowDepth = 0.0 + do LoopInd = NumSnowLayerNeg+1, 0 + SnowDepth = SnowDepth + ThicknessSnowSoilLayer(LoopInd) + enddo + endif + + ! update snow quantity + if ( (SnowDepth <= 1.0e-6) .or. (SnowWaterEquiv <= 1.0e-6) ) then + SnowDepth = 0.0 + SnowWaterEquiv = 0.0 + endif + + end associate + + end subroutine SnowWaterMain + +end module SnowWaterMainMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SnowfallBelowCanopyMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SnowfallBelowCanopyMod.F90 new file mode 100644 index 000000000..5d37a407d --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SnowfallBelowCanopyMod.F90 @@ -0,0 +1,78 @@ +module SnowfallBelowCanopyMod + +!!! Snowfall process after canopy interception +!!! Update snow water equivalent and snow depth + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine SnowfallAfterCanopyIntercept(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: SNOWFALL +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: IndNewSnowLayer ! 0-no new layers, 1-creating new layers + +! -------------------------------------------------------------------- + associate( & + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, noahmp main time step [s] + SnowfallGround => noahmp%water%flux%SnowfallGround ,& ! in, snowfall rate at ground [mm/s] + SnowDepthIncr => noahmp%water%flux%SnowDepthIncr ,& ! in, snow depth increasing rate [m/s] due to snowfall + TemperatureAirRefHeight => noahmp%forcing%TemperatureAirRefHeight ,& ! in, air temperature [K] at reference height + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! inout, actual number of snow layers (negative) + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! inout, thickness of snow/soil layers [m] + SnowDepth => noahmp%water%state%SnowDepth ,& ! inout, snow depth [m] + SnowWaterEquiv => noahmp%water%state%SnowWaterEquiv ,& ! inout, snow water equivalent [mm] + SnowIce => noahmp%water%state%SnowIce ,& ! inout, snow layer ice [mm] + SnowLiqWater => noahmp%water%state%SnowLiqWater ,& ! inout, snow layer liquid water [mm] + TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow & ! inout, snow and soil layer temperature [K] + ) +! ---------------------------------------------------------------------- + + IndNewSnowLayer = 0 + + ! shallow snow / no layer + if ( (NumSnowLayerNeg == 0) .and. (SnowfallGround > 0.0) ) then + SnowDepth = SnowDepth + SnowDepthIncr * MainTimeStep + SnowWaterEquiv = SnowWaterEquiv + SnowfallGround * MainTimeStep + endif + + ! creating a new layer + !if ( (NumSnowLayerNeg == 0) .and. (SnowfallGround > 0.0) .and. (SnowDepth >= 0.05) ) then + !if ( (NumSnowLayerNeg == 0) .and. (SnowfallGround > 0.0) .and. (SnowDepth >= 0.025) ) then !MB: change limit + ! C.He: remove SnowfallGround > 0.0 to allow adjusting snow layer number based on SnowDepth when no snowfall + if ( (NumSnowLayerNeg == 0) .and. (SnowDepth >= 0.025) ) then + NumSnowLayerNeg = -1 + IndNewSnowLayer = 1 + ThicknessSnowSoilLayer(0) = SnowDepth + SnowDepth = 0.0 + TemperatureSoilSnow(0) = min(273.16, TemperatureAirRefHeight) ! temporary setup + SnowIce(0) = SnowWaterEquiv + SnowLiqWater(0) = 0.0 + endif + + ! snow with layers + if ( (NumSnowLayerNeg < 0) .and. (IndNewSnowLayer == 0) .and. (SnowfallGround > 0.0) ) then + SnowIce(NumSnowLayerNeg+1) = SnowIce(NumSnowLayerNeg+1) + SnowfallGround * MainTimeStep + ThicknessSnowSoilLayer(NumSnowLayerNeg+1) = ThicknessSnowSoilLayer(NumSnowLayerNeg+1) + & + SnowDepthIncr * MainTimeStep + endif + + end associate + + end subroutine SnowfallAfterCanopyIntercept + +end module SnowfallBelowCanopyMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SnowpackCompactionMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SnowpackCompactionMod.F90 new file mode 100644 index 000000000..05d59b0d7 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SnowpackCompactionMod.F90 @@ -0,0 +1,126 @@ +module SnowpackCompactionMod + +!!! Snowpack compaction process +!!! Update snow depth via compaction due to destructive metamorphism, overburden, & melt + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine SnowpackCompaction(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: COMPACT +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: LoopInd ! snow layer loop index + real(kind=kind_noahmp) :: SnowBurden ! pressure of overlying snow [kg/m2] + real(kind=kind_noahmp) :: SnowCompactAgeExpFac ! EXPF=exp(-c4*(273.15-TemperatureSoilSnow)) + real(kind=kind_noahmp) :: TempDiff ! ConstFreezePoint - TemperatureSoilSnow[K] + real(kind=kind_noahmp) :: SnowVoid ! void (1 - SnowIce - SnowLiqWater) + real(kind=kind_noahmp) :: SnowWatTotTmp ! water mass (ice + liquid) [kg/m2] + real(kind=kind_noahmp) :: SnowIceDens ! partial density of ice [kg/m3] + +! -------------------------------------------------------------------- + associate( & + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, noahmp main time step [s] + TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow ,& ! in, snow and soil layer temperature [K] + SnowIce => noahmp%water%state%SnowIce ,& ! in, snow layer ice [mm] + SnowLiqWater => noahmp%water%state%SnowLiqWater ,& ! in, snow layer liquid water [mm] + IndexPhaseChange => noahmp%water%state%IndexPhaseChange ,& ! in, phase change index [0-none;1-melt;2-refreeze] + SnowIceFracPrev => noahmp%water%state%SnowIceFracPrev ,& ! in, ice fraction in snow layers at previous timestep + SnowCompactBurdenFac => noahmp%water%param%SnowCompactBurdenFac ,& ! in, snow overburden compaction parameter [m3/kg] + SnowCompactAgingFac1 => noahmp%water%param%SnowCompactAgingFac1 ,& ! in, snow desctructive metamorphism compaction factor1 [1/s] + SnowCompactAgingFac2 => noahmp%water%param%SnowCompactAgingFac2 ,& ! in, snow desctructive metamorphism compaction factor2 [1/k] + SnowCompactAgingFac3 => noahmp%water%param%SnowCompactAgingFac3 ,& ! in, snow desctructive metamorphism compaction factor3 + SnowCompactAgingMax => noahmp%water%param%SnowCompactAgingMax ,& ! in, maximum destructive metamorphism compaction [kg/m3] + SnowViscosityCoeff => noahmp%water%param%SnowViscosityCoeff ,& ! in, snow viscosity coeff [kg s/m2],Anderson1979:0.52e6~1.38e6 + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! inout, actual number of snow layers (negative) + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! inout, thickness of snow/soil layers [m] + CompactionSnowAging => noahmp%water%flux%CompactionSnowAging ,& ! out, rate of compaction due to destructive metamorphism [1/s] + CompactionSnowBurden => noahmp%water%flux%CompactionSnowBurden ,& ! out, rate of compaction of snowpack due to overburden [1/s] + CompactionSnowMelt => noahmp%water%flux%CompactionSnowMelt ,& ! out, rate of compaction of snowpack due to melt [1/s] + CompactionSnowTot => noahmp%water%flux%CompactionSnowTot ,& ! out, change in fractional-thickness due to compaction [1/s] + SnowIceFrac => noahmp%water%state%SnowIceFrac & ! out, fraction of ice in snow layers at current time step + ) +! ---------------------------------------------------------------------- + +! initialization for out-only variables + CompactionSnowAging(:) = 0.0 + CompactionSnowBurden(:) = 0.0 + CompactionSnowMelt(:) = 0.0 + CompactionSnowTot(:) = 0.0 + SnowIceFrac(:) = 0.0 + +! start snow compaction + SnowBurden = 0.0 + do LoopInd = NumSnowLayerNeg+1, 0 + + SnowWatTotTmp = SnowIce(LoopInd) + SnowLiqWater(LoopInd) + SnowIceFrac(LoopInd) = SnowIce(LoopInd) / SnowWatTotTmp + SnowVoid = 1.0 - (SnowIce(LoopInd)/ConstDensityIce + SnowLiqWater(LoopInd)/ConstDensityWater) / & + ThicknessSnowSoilLayer(LoopInd) + + ! Allow compaction only for non-saturated node and higher ice lens node. + if ( (SnowVoid > 0.001) .and. (SnowIce(LoopInd) > 0.1) ) then + SnowIceDens = SnowIce(LoopInd) / ThicknessSnowSoilLayer(LoopInd) + TempDiff = max(0.0, ConstFreezePoint-TemperatureSoilSnow(LoopInd)) + + ! Settling/compaction as a result of destructive metamorphism + SnowCompactAgeExpFac = exp(-SnowCompactAgingFac2 * TempDiff) + CompactionSnowAging(LoopInd) = -SnowCompactAgingFac1 * SnowCompactAgeExpFac + if ( SnowIceDens > SnowCompactAgingMax ) & + CompactionSnowAging(LoopInd) = CompactionSnowAging(LoopInd) * exp(-46.0e-3*(SnowIceDens-SnowCompactAgingMax)) + if ( SnowLiqWater(LoopInd) > (0.01*ThicknessSnowSoilLayer(LoopInd)) ) & + CompactionSnowAging(LoopInd) = CompactionSnowAging(LoopInd) * SnowCompactAgingFac3 ! Liquid water term + + ! Compaction due to overburden + CompactionSnowBurden(LoopInd) = -(SnowBurden + 0.5*SnowWatTotTmp) * & + exp(-0.08*TempDiff-SnowCompactBurdenFac*SnowIceDens) / SnowViscosityCoeff ! 0.5*SnowWatTotTmp -> self-burden + + ! Compaction occurring during melt + if ( IndexPhaseChange(LoopInd) == 1 ) then + CompactionSnowMelt(LoopInd) = max(0.0, (SnowIceFracPrev(LoopInd)-SnowIceFrac(LoopInd)) / & + max(1.0e-6, SnowIceFracPrev(LoopInd))) + CompactionSnowMelt(LoopInd) = -CompactionSnowMelt(LoopInd) / MainTimeStep ! sometimes too large + else + CompactionSnowMelt(LoopInd) = 0.0 + endif + + ! Time rate of fractional change in snow thickness (units of s-1) + CompactionSnowTot(LoopInd) = (CompactionSnowAging(LoopInd) + CompactionSnowBurden(LoopInd) + & + CompactionSnowMelt(LoopInd) ) * MainTimeStep + CompactionSnowTot(LoopInd) = max(-0.5, CompactionSnowTot(LoopInd)) + + ! The change in DZ due to compaction + ThicknessSnowSoilLayer(LoopInd) = ThicknessSnowSoilLayer(LoopInd) * (1.0 + CompactionSnowTot(LoopInd)) + ThicknessSnowSoilLayer(LoopInd) = max(ThicknessSnowSoilLayer(LoopInd), & + SnowIce(LoopInd)/ConstDensityIce + SnowLiqWater(LoopInd)/ConstDensityWater) + + ! Constrain snow density to a reasonable range (50~500 kg/m3) + ThicknessSnowSoilLayer(LoopInd) = min( max( ThicknessSnowSoilLayer(LoopInd),& + (SnowIce(LoopInd)+SnowLiqWater(LoopInd))/500.0 ), & + (SnowIce(LoopInd)+SnowLiqWater(LoopInd))/50.0 ) + endif + + ! Pressure of overlying snow + SnowBurden = SnowBurden + SnowWatTotTmp + + enddo + + end associate + + end subroutine SnowpackCompaction + +end module SnowpackCompactionMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SnowpackHydrologyGlacierMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SnowpackHydrologyGlacierMod.F90 new file mode 100644 index 000000000..dc702ceab --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SnowpackHydrologyGlacierMod.F90 @@ -0,0 +1,169 @@ +module SnowpackHydrologyGlacierMod + +!!! Snowpack hydrology processes (sublimation/frost, evaporation/dew, meltwater) +!!! Update snowpack ice and liquid water content + + use Machine + use NoahmpVarType + use ConstantDefineMod + use SnowLayerCombineMod, only : SnowLayerCombine + + implicit none + +contains + + subroutine SnowpackHydrologyGlacier(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: SNOWH2O_GLACIER +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variables + integer :: LoopInd ! do loop/array indices + real(kind=kind_noahmp) :: InflowSnowLayer ! water flow into each snow layer (mm/s) + real(kind=kind_noahmp) :: OutflowSnowLayer ! water flow out of each snow layer (mm/s) + real(kind=kind_noahmp) :: SnowIceTmp ! ice mass after minus sublimation + real(kind=kind_noahmp) :: SnowWaterRatio ! ratio of SWE after frost & sublimation to original SWE + real(kind=kind_noahmp) :: SnowWaterTmp ! temporary SWE + real(kind=kind_noahmp), allocatable, dimension(:) :: SnowLiqVol ! partial volume of liquid water in layer + real(kind=kind_noahmp), allocatable, dimension(:) :: SnowIceVol ! partial volume of ice lens in layer + +! -------------------------------------------------------------------- + associate( & + OptGlacierTreatment => noahmp%config%nmlist%OptGlacierTreatment ,& ! in, option for glacier treatment + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, noahmp main time step [s] + HeatSensibleSfc => noahmp%energy%flux%HeatSensibleSfc ,& ! in, total sensible heat [W/m2] (+ to atm) + FrostSnowSfcIce => noahmp%water%flux%FrostSnowSfcIce ,& ! in, snow surface frost rate [mm/s] + SublimSnowSfcIce => noahmp%water%flux%SublimSnowSfcIce ,& ! in, snow surface sublimation rate [mm/s] + RainfallGround => noahmp%water%flux%RainfallGround ,& ! in, ground surface rain rate [mm/s] + SnowLiqFracMax => noahmp%water%param%SnowLiqFracMax ,& ! in, maximum liquid water fraction in snow + SnowLiqHoldCap => noahmp%water%param%SnowLiqHoldCap ,& ! in, liquid water holding capacity for snowpack [m3/m3] + SnowLiqReleaseFac => noahmp%water%param%SnowLiqReleaseFac ,& ! in, snowpack water release timescale factor [1/s] + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! inout, actual number of snow layers (negative) + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! inout, thickness of snow/soil layers [m] + SnowDepth => noahmp%water%state%SnowDepth ,& ! inout, snow depth [m] + SnowWaterEquiv => noahmp%water%state%SnowWaterEquiv ,& ! inout, snow water equivalent [mm] + SnowIce => noahmp%water%state%SnowIce ,& ! inout, snow layer ice [mm] + SnowLiqWater => noahmp%water%state%SnowLiqWater ,& ! inout, snow layer liquid water [mm] + SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! inout, soil liquid moisture [m3/m3] + SoilIce => noahmp%water%state%SoilIce ,& ! inout, soil ice moisture [m3/m3] + SnowEffPorosity => noahmp%water%state%SnowEffPorosity ,& ! out, snow effective porosity [m3/m3] + SnowBotOutflow => noahmp%water%flux%SnowBotOutflow & ! out, total water (snowmelt + rain through pack) out of snowpack bottom [mm/s] + ) +! ---------------------------------------------------------------------- + + ! initialization + if (.not. allocated(SnowLiqVol)) allocate(SnowLiqVol(-NumSnowLayerMax+1:0)) + if (.not. allocated(SnowIceVol)) allocate(SnowIceVol(-NumSnowLayerMax+1:0)) + SnowLiqVol(:) = 0.0 + SnowIceVol(:) = 0.0 + SnowEffPorosity(:) = 0.0 + SnowBotOutflow = 0.0 + InflowSnowLayer = 0.0 + OutflowSnowLayer = 0.0 + + ! for the case when SnowWaterEquiv becomes '0' after 'COMBINE' + if ( SnowWaterEquiv == 0.0 ) then + if ( OptGlacierTreatment == 1 ) then + SoilIce(1) = SoilIce(1) + (FrostSnowSfcIce-SublimSnowSfcIce) * MainTimeStep / & + (ThicknessSnowSoilLayer(1)*1000.0) ! Barlage: SoilLiqWater->SoilIce v3.6 + elseif ( OptGlacierTreatment == 2 ) then + HeatSensibleSfc = HeatSensibleSfc - (FrostSnowSfcIce - SublimSnowSfcIce) * ConstLatHeatSublim + FrostSnowSfcIce = 0.0 + SublimSnowSfcIce = 0.0 + endif + endif + + ! for shallow snow without a layer + ! snow surface sublimation may be larger than existing snow mass. To conserve water, + ! excessive sublimation is used to reduce soil water. Smaller time steps would tend to aviod this problem. + if ( (NumSnowLayerNeg == 0) .and. (SnowWaterEquiv > 0.0) ) then + if ( OptGlacierTreatment == 1 ) then + SnowWaterTmp = SnowWaterEquiv + SnowWaterEquiv = SnowWaterEquiv - SublimSnowSfcIce*MainTimeStep + FrostSnowSfcIce*MainTimeStep + SnowWaterRatio = SnowWaterEquiv / SnowWaterTmp + SnowDepth = max(0.0, SnowWaterRatio*SnowDepth) + SnowDepth = min(max(SnowDepth, SnowWaterEquiv/500.0), SnowWaterEquiv/50.0) ! limit adjustment to a reasonable density + elseif ( OptGlacierTreatment == 2 ) then + HeatSensibleSfc = HeatSensibleSfc - (FrostSnowSfcIce - SublimSnowSfcIce) * ConstLatHeatSublim + FrostSnowSfcIce = 0.0 + SublimSnowSfcIce = 0.0 + endif + if ( SnowWaterEquiv < 0.0 ) then + SoilIce(1) = SoilIce(1) + SnowWaterEquiv / (ThicknessSnowSoilLayer(1)*1000.0) + SnowWaterEquiv = 0.0 + SnowDepth = 0.0 + endif + if ( SoilIce(1) < 0.0 ) then + SoilLiqWater(1) = SoilLiqWater(1) + SoilIce(1) + SoilIce(1) = 0.0 + endif + endif + + if ( (SnowDepth <= 1.0e-8) .or. (SnowWaterEquiv <= 1.0e-6) ) then + SnowDepth = 0.0 + SnowWaterEquiv = 0.0 + endif + + ! for multi-layer (>=1) snow + if ( NumSnowLayerNeg < 0 ) then + SnowIceTmp = SnowIce(NumSnowLayerNeg+1) - SublimSnowSfcIce*MainTimeStep + FrostSnowSfcIce*MainTimeStep + SnowIce(NumSnowLayerNeg+1) = SnowIceTmp + if ( (SnowIceTmp < 1.0e-6) .and. (NumSnowLayerNeg < 0) ) call SnowLayerCombine(noahmp) + if ( NumSnowLayerNeg < 0 ) then + SnowLiqWater(NumSnowLayerNeg+1) = SnowLiqWater(NumSnowLayerNeg+1) + RainfallGround * MainTimeStep + SnowLiqWater(NumSnowLayerNeg+1) = max(0.0, SnowLiqWater(NumSnowLayerNeg+1)) + endif + endif + + ! Porosity and partial volume + do LoopInd = NumSnowLayerNeg+1, 0 + SnowIceVol(LoopInd) = min(1.0, SnowIce(LoopInd)/(ThicknessSnowSoilLayer(LoopInd)*ConstDensityIce)) + SnowEffPorosity(LoopInd) = 1.0 - SnowIceVol(LoopInd) + enddo + + ! compute inter-layer snow water flow + do LoopInd = NumSnowLayerNeg+1, 0 + SnowLiqWater(LoopInd) = SnowLiqWater(LoopInd) + InflowSnowLayer + SnowLiqVol(LoopInd) = SnowLiqWater(LoopInd) / (ThicknessSnowSoilLayer(LoopInd)*ConstDensityWater) + OutflowSnowLayer = max(0.0, (SnowLiqVol(LoopInd) - SnowLiqHoldCap*SnowEffPorosity(LoopInd)) * & + ThicknessSnowSoilLayer(LoopInd)) + if ( LoopInd == 0 ) then + OutflowSnowLayer = max((SnowLiqVol(LoopInd)-SnowEffPorosity(LoopInd)) * ThicknessSnowSoilLayer(LoopInd), & + SnowLiqReleaseFac * MainTimeStep * OutflowSnowLayer) + endif + OutflowSnowLayer = OutflowSnowLayer * ConstDensityWater + SnowLiqWater(LoopInd) = SnowLiqWater(LoopInd) - OutflowSnowLayer + if ( ( SnowLiqWater(LoopInd) / (SnowIce(LoopInd)+SnowLiqWater(LoopInd)) ) > SnowLiqFracMax ) then + OutflowSnowLayer = OutflowSnowLayer + & + (SnowLiqWater(LoopInd) - SnowLiqFracMax/(1.0-SnowLiqFracMax) * SnowIce(LoopInd)) + SnowLiqWater(LoopInd) = SnowLiqFracMax / (1.0 - SnowLiqFracMax) * SnowIce(LoopInd) + endif + InflowSnowLayer = OutflowSnowLayer + enddo + + ! update snow depth + do LoopInd = NumSnowLayerNeg+1, 0 + ThicknessSnowSoilLayer(LoopInd) = max(ThicknessSnowSoilLayer(LoopInd), & + SnowLiqWater(LoopInd)/ConstDensityWater + SnowIce(LoopInd)/ConstDensityIce) + enddo + + ! Liquid water from snow bottom to soil (mm/s) + SnowBotOutflow = OutflowSnowLayer / MainTimeStep + + ! deallocate local arrays to avoid memory leaks + deallocate(SnowLiqVol) + deallocate(SnowIceVol) + + end associate + + end subroutine SnowpackHydrologyGlacier + +end module SnowpackHydrologyGlacierMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SnowpackHydrologyMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SnowpackHydrologyMod.F90 new file mode 100644 index 000000000..8b3638d4e --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SnowpackHydrologyMod.F90 @@ -0,0 +1,159 @@ +module SnowpackHydrologyMod + +!!! Snowpack hydrology processes (sublimation/frost, evaporation/dew, meltwater) +!!! Update snowpack ice and liquid water content + + use Machine + use NoahmpVarType + use ConstantDefineMod + use SnowLayerCombineMod, only : SnowLayerCombine + + implicit none + +contains + + subroutine SnowpackHydrology(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: SNOWH2O +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: LoopInd ! do loop/array indices + real(kind=kind_noahmp) :: InflowSnowLayer ! water flow into each snow layer [mm/s] + real(kind=kind_noahmp) :: OutflowSnowLayer ! water flow out of each snow layer [mm/s] + real(kind=kind_noahmp) :: SnowIceTmp ! ice mass after minus sublimation + real(kind=kind_noahmp) :: SnowWaterRatio ! ratio of SWE after frost & sublimation to original SWE + real(kind=kind_noahmp) :: SnowWaterTmp ! temporary SWE + real(kind=kind_noahmp), allocatable, dimension(:) :: SnowLiqVol ! partial volume of liquid water in layer + real(kind=kind_noahmp), allocatable, dimension(:) :: SnowIceVol ! partial volume of ice lens in layer + +! -------------------------------------------------------------------- + associate( & + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, noahmp main time step [s] + FrostSnowSfcIce => noahmp%water%flux%FrostSnowSfcIce ,& ! in, snow surface frost rate [mm/s] + SublimSnowSfcIce => noahmp%water%flux%SublimSnowSfcIce ,& ! in, snow surface sublimation rate [mm/s] + RainfallGround => noahmp%water%flux%RainfallGround ,& ! in, ground surface rain rate [mm/s] + SnowLiqFracMax => noahmp%water%param%SnowLiqFracMax ,& ! in, maximum liquid water fraction in snow + SnowLiqHoldCap => noahmp%water%param%SnowLiqHoldCap ,& ! in, liquid water holding capacity for snowpack [m3/m3] + SnowLiqReleaseFac => noahmp%water%param%SnowLiqReleaseFac ,& ! in, snowpack water release timescale factor [1/s] + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! inout, actual number of snow layers (negative) + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! inout, thickness of snow/soil layers [m] + SnowDepth => noahmp%water%state%SnowDepth ,& ! inout, snow depth [m] + SnowWaterEquiv => noahmp%water%state%SnowWaterEquiv ,& ! inout, snow water equivalent [mm] + SnowIce => noahmp%water%state%SnowIce ,& ! inout, snow layer ice [mm] + SnowLiqWater => noahmp%water%state%SnowLiqWater ,& ! inout, snow layer liquid water [mm] + SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! inout, soil liquid moisture [m3/m3] + SoilIce => noahmp%water%state%SoilIce ,& ! inout, soil ice moisture [m3/m3] + SnowEffPorosity => noahmp%water%state%SnowEffPorosity ,& ! out, snow effective porosity [m3/m3] + SnowBotOutflow => noahmp%water%flux%SnowBotOutflow & ! out, total water (snowmelt + rain through pack) out of snowpack bottom [mm/s] + ) +! ---------------------------------------------------------------------- + + ! initialization + if (.not. allocated(SnowLiqVol)) allocate(SnowLiqVol(-NumSnowLayerMax+1:0)) + if (.not. allocated(SnowIceVol)) allocate(SnowIceVol(-NumSnowLayerMax+1:0)) + SnowLiqVol(:) = 0.0 + SnowIceVol(:) = 0.0 + SnowEffPorosity(:) = 0.0 + SnowBotOutflow = 0.0 + InflowSnowLayer = 0.0 + OutflowSnowLayer = 0.0 + + ! for the case when SnowWaterEquiv becomes '0' after 'COMBINE' + if ( SnowWaterEquiv == 0.0 ) then + SoilIce(1) = SoilIce(1) + (FrostSnowSfcIce-SublimSnowSfcIce) * MainTimeStep / & + (ThicknessSnowSoilLayer(1)*1000.0) ! Barlage: SoilLiqWater->SoilIce v3.6 + if ( SoilIce(1) < 0.0 ) then + SoilLiqWater(1) = SoilLiqWater(1) + SoilIce(1) + SoilIce(1) = 0.0 + endif + endif + + ! for shallow snow without a layer + ! snow surface sublimation may be larger than existing snow mass. To conserve water, + ! excessive sublimation is used to reduce soil water. Smaller time steps would tend to aviod this problem. + if ( (NumSnowLayerNeg == 0) .and. (SnowWaterEquiv > 0.0) ) then + SnowWaterTmp = SnowWaterEquiv + SnowWaterEquiv = SnowWaterEquiv - SublimSnowSfcIce*MainTimeStep + FrostSnowSfcIce*MainTimeStep + SnowWaterRatio = SnowWaterEquiv / SnowWaterTmp + SnowDepth = max(0.0, SnowWaterRatio*SnowDepth ) + SnowDepth = min(max(SnowDepth,SnowWaterEquiv/500.0), SnowWaterEquiv/50.0) ! limit adjustment to a reasonable density + if ( SnowWaterEquiv < 0.0 ) then + SoilIce(1) = SoilIce(1) + SnowWaterEquiv / (ThicknessSnowSoilLayer(1)*1000.0) + SnowWaterEquiv = 0.0 + SnowDepth = 0.0 + endif + if ( SoilIce(1) < 0.0 ) then + SoilLiqWater(1) = SoilLiqWater(1) + SoilIce(1) + SoilIce(1) = 0.0 + endif + endif + + if ( (SnowDepth <= 1.0e-8) .or. (SnowWaterEquiv <= 1.0e-6) ) then + SnowDepth = 0.0 + SnowWaterEquiv = 0.0 + endif + + ! for multi-layer (>=1) snow + if ( NumSnowLayerNeg < 0 ) then + SnowIceTmp = SnowIce(NumSnowLayerNeg+1) - SublimSnowSfcIce*MainTimeStep + FrostSnowSfcIce*MainTimeStep + SnowIce(NumSnowLayerNeg+1) = SnowIceTmp + if ( (SnowIceTmp < 1.0e-6) .and. (NumSnowLayerNeg < 0) ) call SnowLayerCombine(noahmp) + if ( NumSnowLayerNeg < 0 ) then + SnowLiqWater(NumSnowLayerNeg+1) = SnowLiqWater(NumSnowLayerNeg+1) + RainfallGround * MainTimeStep + SnowLiqWater(NumSnowLayerNeg+1) = max(0.0, SnowLiqWater(NumSnowLayerNeg+1)) + endif + endif + + ! Porosity and partial volume + do LoopInd = NumSnowLayerNeg+1, 0 + SnowIceVol(LoopInd) = min(1.0, SnowIce(LoopInd)/(ThicknessSnowSoilLayer(LoopInd)*ConstDensityIce)) + SnowEffPorosity(LoopInd) = 1.0 - SnowIceVol(LoopInd) + enddo + + ! compute inter-layer snow water flow + do LoopInd = NumSnowLayerNeg+1, 0 + SnowLiqWater(LoopInd) = SnowLiqWater(LoopInd) + InflowSnowLayer + SnowLiqVol(LoopInd) = SnowLiqWater(LoopInd) / (ThicknessSnowSoilLayer(LoopInd)*ConstDensityWater) + OutflowSnowLayer = max(0.0, (SnowLiqVol(LoopInd)-SnowLiqHoldCap*SnowEffPorosity(LoopInd)) * & + ThicknessSnowSoilLayer(LoopInd)) + if ( LoopInd == 0 ) then + OutflowSnowLayer = max((SnowLiqVol(LoopInd)-SnowEffPorosity(LoopInd)) * ThicknessSnowSoilLayer(LoopInd), & + SnowLiqReleaseFac * MainTimeStep * OutflowSnowLayer) + endif + OutflowSnowLayer = OutflowSnowLayer * ConstDensityWater + SnowLiqWater(LoopInd) = SnowLiqWater(LoopInd) - OutflowSnowLayer + if ( (SnowLiqWater(LoopInd)/(SnowIce(LoopInd)+SnowLiqWater(LoopInd))) > SnowLiqFracMax ) then + OutflowSnowLayer = OutflowSnowLayer + (SnowLiqWater(LoopInd) - & + SnowLiqFracMax / (1.0-SnowLiqFracMax) * SnowIce(LoopInd)) + SnowLiqWater(LoopInd) = SnowLiqFracMax / (1.0 - SnowLiqFracMax) * SnowIce(LoopInd) + endif + InflowSnowLayer = OutflowSnowLayer + enddo + + ! update snow depth + do LoopInd = NumSnowLayerNeg+1, 0 + ThicknessSnowSoilLayer(LoopInd) = max(ThicknessSnowSoilLayer(LoopInd), & + SnowLiqWater(LoopInd)/ConstDensityWater+SnowIce(LoopInd)/ConstDensityIce) + enddo + + ! Liquid water from snow bottom to soil [mm/s] + SnowBotOutflow = OutflowSnowLayer / MainTimeStep + + ! deallocate local arrays to avoid memory leaks + deallocate(SnowLiqVol) + deallocate(SnowIceVol) + + end associate + + end subroutine SnowpackHydrology + +end module SnowpackHydrologyMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SoilHydraulicPropertyMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SoilHydraulicPropertyMod.F90 new file mode 100644 index 000000000..438624f5c --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SoilHydraulicPropertyMod.F90 @@ -0,0 +1,118 @@ +module SoilHydraulicPropertyMod + +!!! Two methods for calculating soil water diffusivity and soil hydraulic conductivity +!!! Option 1: linear effects (more permeable, Niu and Yang,2006); Option 2: nonlinear effects (less permeable) + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine SoilDiffusivityConductivityOpt1(noahmp, SoilWatDiffusivity, SoilWatConductivity, & + SoilMoisture, SoilImpervFrac, IndLayer) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: WDFCND1 +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! IN and OUT variables + type(noahmp_type) , intent(inout) :: noahmp + integer , intent(in) :: IndLayer ! soil layer index + real(kind=kind_noahmp), intent(in) :: SoilMoisture ! soil moisture [m3/m3] + real(kind=kind_noahmp), intent(in) :: SoilImpervFrac ! impervious fraction due to frozen soil + real(kind=kind_noahmp), intent(out) :: SoilWatConductivity ! soil water conductivity [m/s] + real(kind=kind_noahmp), intent(out) :: SoilWatDiffusivity ! soil water diffusivity [m2/s] + +! local variable + real(kind=kind_noahmp) :: SoilExpTmp ! exponential local factor + real(kind=kind_noahmp) :: SoilPreFac ! pre-factor + +! -------------------------------------------------------------------- + associate( & + SoilMoistureSat => noahmp%water%param%SoilMoistureSat ,& ! in, saturated value of soil moisture [m3/m3] + SoilExpCoeffB => noahmp%water%param%SoilExpCoeffB ,& ! in, soil B parameter + SoilWatDiffusivitySat => noahmp%water%param%SoilWatDiffusivitySat ,& ! in, saturated soil hydraulic diffusivity [m2/s] + SoilWatConductivitySat => noahmp%water%param%SoilWatConductivitySat & ! in, saturated soil hydraulic conductivity [m/s] + ) +! ---------------------------------------------------------------------- + + SoilPreFac = max(0.01, SoilMoisture/SoilMoistureSat(IndLayer)) + + ! soil water diffusivity + SoilExpTmp = SoilExpCoeffB(IndLayer) + 2.0 + SoilWatDiffusivity = SoilWatDiffusivitySat(IndLayer) * SoilPreFac ** SoilExpTmp + SoilWatDiffusivity = SoilWatDiffusivity * (1.0 - SoilImpervFrac) + + ! soil hydraulic conductivity + SoilExpTmp = 2.0 * SoilExpCoeffB(IndLayer) + 3.0 + SoilWatConductivity = SoilWatConductivitySat(IndLayer) * SoilPreFac ** SoilExpTmp + SoilWatConductivity = SoilWatConductivity * (1.0 - SoilImpervFrac) + + end associate + + end subroutine SoilDiffusivityConductivityOpt1 + + + subroutine SoilDiffusivityConductivityOpt2(noahmp, SoilWatDiffusivity, SoilWatConductivity, & + SoilMoisture, SoilIce, IndLayer) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: WDFCND2 +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! IN and OUT variables + type(noahmp_type) , intent(inout) :: noahmp + integer , intent(in) :: IndLayer ! soil layer index + real(kind=kind_noahmp), intent(in) :: SoilMoisture ! soil moisture [m3/m3] + real(kind=kind_noahmp), intent(in) :: SoilIce ! soil ice content [m3/m3] + real(kind=kind_noahmp), intent(out) :: SoilWatConductivity ! soil water conductivity [m/s] + real(kind=kind_noahmp), intent(out) :: SoilWatDiffusivity ! soil water diffusivity [m2/s] + +! local variable + real(kind=kind_noahmp) :: SoilExpTmp ! exponential local factor + real(kind=kind_noahmp) :: SoilPreFac1 ! pre-factor + real(kind=kind_noahmp) :: SoilPreFac2 ! pre-factor + real(kind=kind_noahmp) :: SoilIceWgt ! weights + +! -------------------------------------------------------------------- + associate( & + SoilMoistureSat => noahmp%water%param%SoilMoistureSat ,& ! in, saturated value of soil moisture [m3/m3] + SoilExpCoeffB => noahmp%water%param%SoilExpCoeffB ,& ! in, soil B parameter + SoilWatDiffusivitySat => noahmp%water%param%SoilWatDiffusivitySat ,& ! in, saturated soil hydraulic diffusivity [m2/s] + SoilWatConductivitySat => noahmp%water%param%SoilWatConductivitySat & ! in, saturated soil hydraulic conductivity [m/s] + ) +! ---------------------------------------------------------------------- + + SoilPreFac1 = 0.05 / SoilMoistureSat(IndLayer) + SoilPreFac2 = max(0.01, SoilMoisture/SoilMoistureSat(IndLayer)) + SoilPreFac1 = min(SoilPreFac1, SoilPreFac2) + + ! soil water diffusivity + SoilExpTmp = SoilExpCoeffB(IndLayer) + 2.0 + SoilWatDiffusivity = SoilWatDiffusivitySat(IndLayer) * SoilPreFac2 ** SoilExpTmp + if ( SoilIce > 0.0 ) then + SoilIceWgt = 1.0 / (1.0 + (500.0 * SoilIce)**3.0) + SoilWatDiffusivity = SoilIceWgt * SoilWatDiffusivity + & + (1.0-SoilIceWgt) * SoilWatDiffusivitySat(IndLayer) * SoilPreFac1**SoilExpTmp + endif + + ! soil hydraulic conductivity + SoilExpTmp = 2.0 * SoilExpCoeffB(IndLayer) + 3.0 + SoilWatConductivity = SoilWatConductivitySat(IndLayer) * SoilPreFac2 ** SoilExpTmp + + end associate + + end subroutine SoilDiffusivityConductivityOpt2 + +end module SoilHydraulicPropertyMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SoilMoistureSolverMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SoilMoistureSolverMod.F90 new file mode 100644 index 000000000..b7ac40166 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SoilMoistureSolverMod.F90 @@ -0,0 +1,148 @@ +module SoilMoistureSolverMod + +!!! Compute soil moisture content using based on Richards diffusion & tri-diagonal matrix +!!! Dependent on the output from SoilWaterDiffusionRichards subroutine + + use Machine + use NoahmpVarType + use ConstantDefineMod + use MatrixSolverTriDiagonalMod, only : MatrixSolverTriDiagonal + + implicit none + +contains + + subroutine SoilMoistureSolver(noahmp, TimeStep, MatLeft1, MatLeft2, MatLeft3, MatRight) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: SSTEP +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! in & out variables + type(noahmp_type) , intent(inout) :: noahmp + real(kind=kind_noahmp), intent(in) :: TimeStep ! timestep (may not be the same as model timestep) + real(kind=kind_noahmp), allocatable, dimension(:), intent(inout) :: MatRight ! right-hand side term of the matrix + real(kind=kind_noahmp), allocatable, dimension(:), intent(inout) :: MatLeft1 ! left-hand side term of the matrix + real(kind=kind_noahmp), allocatable, dimension(:), intent(inout) :: MatLeft2 ! left-hand side term of the matrix + real(kind=kind_noahmp), allocatable, dimension(:), intent(inout) :: MatLeft3 ! left-hand side term of the matrix + +! local variable + integer :: LoopInd ! soil layer loop index + real(kind=kind_noahmp) :: WatDefiTmp ! temporary water deficiency + real(kind=kind_noahmp), allocatable, dimension(:) :: MatRightTmp ! temporary MatRight matrix coefficient + real(kind=kind_noahmp), allocatable, dimension(:) :: MatLeft3Tmp ! temporary MatLeft3 matrix coefficient + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth [m] of layer-bottom from soil surface + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! in, thickness of snow/soil layers [m] + OptRunoffSubsurface => noahmp%config%nmlist%OptRunoffSubsurface ,& ! in, options for drainage and subsurface runoff + SoilMoistureSat => noahmp%water%param%SoilMoistureSat ,& ! in, saturated value of soil moisture [m3/m3] + WaterTableDepth => noahmp%water%state%WaterTableDepth ,& ! in, water table depth [m] + SoilIce => noahmp%water%state%SoilIce ,& ! in, soil ice content [m3/m3] + SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! inout, soil water content [m3/m3] + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! inout, total soil moisture [m3/m3] + SoilMoistureToWT => noahmp%water%state%SoilMoistureToWT ,& ! inout, soil moisture between bottom of soil & water table + RechargeGwDeepWT => noahmp%water%state%RechargeGwDeepWT ,& ! inout, recharge to or from the water table when deep [m] + DrainSoilBot => noahmp%water%flux%DrainSoilBot ,& ! inout, soil bottom drainage (m/s) + SoilEffPorosity => noahmp%water%state%SoilEffPorosity ,& ! out, soil effective porosity (m3/m3) + SoilSaturationExcess => noahmp%water%state%SoilSaturationExcess & ! out, saturation excess of the total soil [m] + ) +! ---------------------------------------------------------------------- + + ! initialization + if (.not. allocated(MatRightTmp)) allocate(MatRightTmp(1:NumSoilLayer)) + if (.not. allocated(MatLeft3Tmp)) allocate(MatLeft3Tmp(1:NumSoilLayer)) + MatRightTmp = 0.0 + MatLeft3Tmp = 0.0 + SoilSaturationExcess = 0.0 + SoilEffPorosity(:) = 0.0 + + ! update tri-diagonal matrix elements + do LoopInd = 1, NumSoilLayer + MatRight(LoopInd) = MatRight(LoopInd) * TimeStep + MatLeft1(LoopInd) = MatLeft1(LoopInd) * TimeStep + MatLeft2(LoopInd) = 1.0 + MatLeft2(LoopInd) * TimeStep + MatLeft3(LoopInd) = MatLeft3(LoopInd) * TimeStep + enddo + + ! copy values for input variables before calling rosr12 + do LoopInd = 1, NumSoilLayer + MatRightTmp(LoopInd) = MatRight(LoopInd) + MatLeft3Tmp(LoopInd) = MatLeft3(LoopInd) + enddo + + ! call ROSR12 to solve the tri-diagonal matrix + call MatrixSolverTriDiagonal(MatLeft3,MatLeft1,MatLeft2,MatLeft3Tmp,MatRightTmp,MatRight,1,NumSoilLayer,0) + + do LoopInd = 1, NumSoilLayer + SoilLiqWater(LoopInd) = SoilLiqWater(LoopInd) + MatLeft3(LoopInd) + enddo + + ! excessive water above saturation in a layer is moved to + ! its unsaturated layer like in a bucket + + ! for MMF scheme, there is soil moisture below NumSoilLayer, to the water table + if ( OptRunoffSubsurface == 5 ) then + ! update SoilMoistureToWT + if ( WaterTableDepth < (DepthSoilLayer(NumSoilLayer)-ThicknessSnowSoilLayer(NumSoilLayer)) ) then + ! accumulate soil drainage to update deep water table and soil moisture later + RechargeGwDeepWT = RechargeGwDeepWT + TimeStep * DrainSoilBot + else + SoilMoistureToWT = SoilMoistureToWT + & + TimeStep * DrainSoilBot / ThicknessSnowSoilLayer(NumSoilLayer) + SoilSaturationExcess = max((SoilMoistureToWT - SoilMoistureSat(NumSoilLayer)), 0.0) * & + ThicknessSnowSoilLayer(NumSoilLayer) + WatDefiTmp = max((1.0e-4 - SoilMoistureToWT), 0.0) * ThicknessSnowSoilLayer(NumSoilLayer) + SoilMoistureToWT = max(min(SoilMoistureToWT, SoilMoistureSat(NumSoilLayer)), 1.0e-4) + SoilLiqWater(NumSoilLayer) = SoilLiqWater(NumSoilLayer) + & + SoilSaturationExcess / ThicknessSnowSoilLayer(NumSoilLayer) + ! reduce fluxes at the bottom boundaries accordingly + DrainSoilBot = DrainSoilBot - SoilSaturationExcess/TimeStep + RechargeGwDeepWT = RechargeGwDeepWT - WatDefiTmp + endif + endif + + do LoopInd = NumSoilLayer, 2, -1 + SoilEffPorosity(LoopInd) = max(1.0e-4, (SoilMoistureSat(LoopInd) - SoilIce(LoopInd))) + SoilSaturationExcess = max((SoilLiqWater(LoopInd)-SoilEffPorosity(LoopInd)), 0.0) * & + ThicknessSnowSoilLayer(LoopInd) + SoilLiqWater(LoopInd) = min(SoilEffPorosity(LoopInd), SoilLiqWater(LoopInd) ) + SoilLiqWater(LoopInd-1) = SoilLiqWater(LoopInd-1) + SoilSaturationExcess / ThicknessSnowSoilLayer(LoopInd-1) + enddo + + SoilEffPorosity(1) = max(1.0e-4, (SoilMoistureSat(1)-SoilIce(1))) + SoilSaturationExcess = max((SoilLiqWater(1)-SoilEffPorosity(1)), 0.0) * ThicknessSnowSoilLayer(1) + SoilLiqWater(1) = min(SoilEffPorosity(1), SoilLiqWater(1)) + + if ( SoilSaturationExcess > 0.0 ) then + SoilLiqWater(2) = SoilLiqWater(2) + SoilSaturationExcess / ThicknessSnowSoilLayer(2) + do LoopInd = 2, NumSoilLayer-1 + SoilEffPorosity(LoopInd) = max(1.0e-4, (SoilMoistureSat(LoopInd) - SoilIce(LoopInd))) + SoilSaturationExcess = max((SoilLiqWater(LoopInd)-SoilEffPorosity(LoopInd)), 0.0) * & + ThicknessSnowSoilLayer(LoopInd) + SoilLiqWater(LoopInd) = min(SoilEffPorosity(LoopInd), SoilLiqWater(LoopInd)) + SoilLiqWater(LoopInd+1) = SoilLiqWater(LoopInd+1) + SoilSaturationExcess / ThicknessSnowSoilLayer(LoopInd+1) + enddo + SoilEffPorosity(NumSoilLayer) = max(1.0e-4, (SoilMoistureSat(NumSoilLayer) - SoilIce(NumSoilLayer))) + SoilSaturationExcess = max((SoilLiqWater(NumSoilLayer)-SoilEffPorosity(NumSoilLayer)), 0.0) * & + ThicknessSnowSoilLayer(NumSoilLayer) + SoilLiqWater(NumSoilLayer) = min(SoilEffPorosity(NumSoilLayer), SoilLiqWater(NumSoilLayer)) + endif + + SoilMoisture = SoilLiqWater + SoilIce + + ! deallocate local arrays to avoid memory leaks + deallocate(MatRightTmp) + deallocate(MatLeft3Tmp) + + end associate + + end subroutine SoilMoistureSolver + +end module SoilMoistureSolverMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SoilSnowTemperatureMainMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SoilSnowTemperatureMainMod.F90 new file mode 100644 index 000000000..cf4a906b2 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SoilSnowTemperatureMainMod.F90 @@ -0,0 +1,84 @@ +module SoilSnowTemperatureMainMod + +!!! Main module to compute snow (if exists) and soil layer temperature. +!!! Note that snow temperatures during melting season may exceed melting +!!! point but later in SoilSnowPhaseChange subroutine the snow +!!! temperatures are reset to melting point for melting snow. + + use Machine + use NoahmpVarType + use ConstantDefineMod + use SoilSnowTemperatureSolverMod, only : SoilSnowTemperatureSolver + use SoilSnowThermalDiffusionMod, only : SoilSnowThermalDiffusion + + implicit none + +contains + + subroutine SoilSnowTemperatureMain(noahmp) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: TSNOSOI +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! in & out variables + type(noahmp_type) , intent(inout) :: noahmp + +! local variable + real(kind=kind_noahmp), allocatable, dimension(:) :: MatRight ! right-hand side term of the matrix + real(kind=kind_noahmp), allocatable, dimension(:) :: MatLeft1 ! left-hand side term + real(kind=kind_noahmp), allocatable, dimension(:) :: MatLeft2 ! left-hand side term + real(kind=kind_noahmp), allocatable, dimension(:) :: MatLeft3 ! left-hand side term + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! in, actual number of snow layers (negative) + SoilTimeStep => noahmp%config%domain%SoilTimeStep ,& ! in, noahmp soil process timestep [s] + DepthSoilTempBottom => noahmp%config%domain%DepthSoilTempBottom ,& ! in, depth [m] from soil surface for soil temp. lower boundary + SnowDepth => noahmp%water%state%SnowDepth ,& ! in, snow depth [m] + DepthSoilTempBotToSno => noahmp%energy%state%DepthSoilTempBotToSno ,& ! out, depth [m] of soil temp. lower boundary from snow surface + HeatFromSoilBot => noahmp%energy%flux%HeatFromSoilBot ,& ! out, energy influx from soil bottom during soil timestep [J/m2] + RadSwPenetrateGrd => noahmp%energy%flux%RadSwPenetrateGrd & ! out, light penetrating through soil/snow water [W/m2] + ) +! ---------------------------------------------------------------------- + + ! initialization + if (.not. allocated(MatRight)) allocate(MatRight(-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(MatLeft1)) allocate(MatLeft1(-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(MatLeft2)) allocate(MatLeft2(-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(MatLeft3)) allocate(MatLeft3(-NumSnowLayerMax+1:NumSoilLayer)) + MatRight(:) = 0.0 + MatLeft1(:) = 0.0 + MatLeft2(:) = 0.0 + MatLeft3(:) = 0.0 + + ! compute solar penetration through water, needs more work + RadSwPenetrateGrd(NumSnowLayerNeg+1:NumSoilLayer) = 0.0 + + ! adjust DepthSoilTempBottom from soil surface to DepthSoilTempBotToSno from snow surface + DepthSoilTempBotToSno = DepthSoilTempBottom - SnowDepth + + ! compute soil temperatures + call SoilSnowThermalDiffusion(noahmp, MatLeft1, MatLeft2, MatLeft3, MatRight) + call SoilSnowTemperatureSolver(noahmp, SoilTimeStep, MatLeft1, MatLeft2, MatLeft3, MatRight) + + ! accumulate soil bottom flux for soil timestep + HeatFromSoilBot = HeatFromSoilBot * SoilTimeStep + + ! deallocate local arrays to avoid memory leaks + deallocate(MatRight) + deallocate(MatLeft1) + deallocate(MatLeft2) + deallocate(MatLeft3) + + end associate + + end subroutine SoilSnowTemperatureMain + +end module SoilSnowTemperatureMainMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SoilSnowTemperatureSolverMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SoilSnowTemperatureSolverMod.F90 new file mode 100644 index 000000000..1a4288908 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SoilSnowTemperatureSolverMod.F90 @@ -0,0 +1,84 @@ +module SoilSnowTemperatureSolverMod + +!!! Compute soil and snow layer temperature using tri-diagonal matrix solution +!!! Dependent on the output from SoilSnowThermalDiffusion subroutine + + use Machine + use NoahmpVarType + use ConstantDefineMod + use MatrixSolverTriDiagonalMod, only : MatrixSolverTriDiagonal + + implicit none + +contains + + subroutine SoilSnowTemperatureSolver(noahmp, TimeStep, MatLeft1, MatLeft2, MatLeft3, MatRight) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: HSTEP +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! in & out variables + type(noahmp_type) , intent(inout) :: noahmp + real(kind=kind_noahmp), intent(in) :: TimeStep ! timestep (may not be the same as model timestep) + real(kind=kind_noahmp), allocatable, dimension(:), intent(inout) :: MatRight ! right-hand side term of the matrix + real(kind=kind_noahmp), allocatable, dimension(:), intent(inout) :: MatLeft1 ! left-hand side term of the matrix + real(kind=kind_noahmp), allocatable, dimension(:), intent(inout) :: MatLeft2 ! left-hand side term of the matrix + real(kind=kind_noahmp), allocatable, dimension(:), intent(inout) :: MatLeft3 ! left-hand side term of the matrix + +! local variable + integer :: LoopInd ! layer loop index + real(kind=kind_noahmp), allocatable, dimension(:) :: MatRightTmp ! temporary MatRight matrix coefficient + real(kind=kind_noahmp), allocatable, dimension(:) :: MatLeft3Tmp ! temporary MatLeft3 matrix coefficient + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! in, actual number of snow layers (negative) + TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow & ! inout, snow and soil layer temperature [K] + ) +! ---------------------------------------------------------------------- + + ! initialization + if (.not. allocated(MatRightTmp)) allocate(MatRightTmp(-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(MatLeft3Tmp)) allocate(MatLeft3Tmp(-NumSnowLayerMax+1:NumSoilLayer)) + MatRightTmp = 0.0 + MatLeft3Tmp = 0.0 + + ! update tri-diagonal matrix elements + do LoopInd = NumSnowLayerNeg+1, NumSoilLayer + MatRight(LoopInd) = MatRight(LoopInd) * TimeStep + MatLeft1(LoopInd) = MatLeft1(LoopInd) * TimeStep + MatLeft2(LoopInd) = 1.0 + MatLeft2(LoopInd) * TimeStep + MatLeft3(LoopInd) = MatLeft3(LoopInd) * TimeStep + enddo + + ! copy values for input variables before call to rosr12 + do LoopInd = NumSnowLayerNeg+1, NumSoilLayer + MatRightTmp(LoopInd) = MatRight(LoopInd) + MatLeft3Tmp(LoopInd) = MatLeft3(LoopInd) + enddo + + ! solve the tri-diagonal matrix equation + call MatrixSolverTriDiagonal(MatLeft3,MatLeft1,MatLeft2,MatLeft3Tmp,MatRightTmp,& + MatRight,NumSnowLayerNeg+1,NumSoilLayer,NumSnowLayerMax) + + ! update snow & soil temperature + do LoopInd = NumSnowLayerNeg+1, NumSoilLayer + TemperatureSoilSnow(LoopInd) = TemperatureSoilSnow(LoopInd) + MatLeft3(LoopInd) + enddo + + ! deallocate local arrays to avoid memory leaks + deallocate(MatRightTmp) + deallocate(MatLeft3Tmp) + + end associate + + end subroutine SoilSnowTemperatureSolver + +end module SoilSnowTemperatureSolverMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SoilSnowThermalDiffusionMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SoilSnowThermalDiffusionMod.F90 new file mode 100644 index 000000000..9655b77d5 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SoilSnowThermalDiffusionMod.F90 @@ -0,0 +1,141 @@ +module SoilSnowThermalDiffusionMod + +!!! Solve soil and snow layer thermal diffusion +!!! Calculate the right hand side of the time tendency term of the soil +!!! and snow thermal diffusion equation. Currently snow and soil layers +!!! are coupled in solving the equations. Also compute/prepare the matrix +!!! coefficients for the tri-diagonal matrix of the implicit time scheme. + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine SoilSnowThermalDiffusion(noahmp, MatLeft1, MatLeft2, MatLeft3, MatRight) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: HRT +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! in & out variables + type(noahmp_type) , intent(inout) :: noahmp + real(kind=kind_noahmp), allocatable, dimension(:), intent(inout) :: MatRight ! right-hand side term of the matrix + real(kind=kind_noahmp), allocatable, dimension(:), intent(inout) :: MatLeft1 ! left-hand side term of the matrix + real(kind=kind_noahmp), allocatable, dimension(:), intent(inout) :: MatLeft2 ! left-hand side term of the matrix + real(kind=kind_noahmp), allocatable, dimension(:), intent(inout) :: MatLeft3 ! left-hand side term of the matrix + +! local variable + integer :: LoopInd ! loop index + real(kind=kind_noahmp) :: DepthSnowSoilTmp ! temporary snow/soil layer depth [m] + real(kind=kind_noahmp), allocatable, dimension(:) :: DepthSnowSoilInv ! inverse of snow/soil layer depth [1/m] + real(kind=kind_noahmp), allocatable, dimension(:) :: HeatCapacPerArea ! Heat capacity of soil/snow per area [J/m2/K] + real(kind=kind_noahmp), allocatable, dimension(:) :: TempGradDepth ! temperature gradient (derivative) with soil/snow depth [K/m] + real(kind=kind_noahmp), allocatable, dimension(:) :: EnergyExcess ! energy flux excess in soil/snow [W/m2] + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! in, actual number of snow layers (negative) + DepthSnowSoilLayer => noahmp%config%domain%DepthSnowSoilLayer ,& ! in, depth of snow/soil layer-bottom [m] + OptSoilTemperatureBottom => noahmp%config%nmlist%OptSoilTemperatureBottom ,& ! in, options for lower boundary condition of soil temp. + OptSnowSoilTempTime => noahmp%config%nmlist%OptSnowSoilTempTime ,& ! in, options for snow/soil temperature time scheme + TemperatureSoilBottom => noahmp%forcing%TemperatureSoilBottom ,& ! in, bottom boundary soil temperature [K] + DepthSoilTempBotToSno => noahmp%energy%state%DepthSoilTempBotToSno ,& ! in, depth of lower boundary condition [m] from snow surface + TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow ,& ! in, snow and soil layer temperature [K] + ThermConductSoilSnow => noahmp%energy%state%ThermConductSoilSnow ,& ! in, thermal conductivity [W/m/K] for all soil & snow + HeatCapacSoilSnow => noahmp%energy%state%HeatCapacSoilSnow ,& ! in, heat capacity [J/m3/K] for all soil & snow + HeatGroundTotMean => noahmp%energy%flux%HeatGroundTotMean ,& ! in, total ground heat flux [W/m2] averaged during soil timestep + RadSwPenetrateGrd => noahmp%energy%flux%RadSwPenetrateGrd ,& ! in, light penetrating through soil/snow water [W/m2] + HeatFromSoilBot => noahmp%energy%flux%HeatFromSoilBot & ! out, energy influx from soil bottom [W/m2] + ) +! ---------------------------------------------------------------------- + + ! initialization + if (.not. allocated(DepthSnowSoilInv)) allocate(DepthSnowSoilInv(-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(HeatCapacPerArea)) allocate(HeatCapacPerArea(-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(TempGradDepth) ) allocate(TempGradDepth (-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(EnergyExcess) ) allocate(EnergyExcess (-NumSnowLayerMax+1:NumSoilLayer)) + MatRight(:) = 0.0 + MatLeft1(:) = 0.0 + MatLeft2(:) = 0.0 + MatLeft3(:) = 0.0 + DepthSnowSoilInv(:) = 0.0 + HeatCapacPerArea(:) = 0.0 + TempGradDepth(:) = 0.0 + EnergyExcess(:) = 0.0 + + ! compute gradient and flux of soil/snow thermal diffusion + do LoopInd = NumSnowLayerNeg+1, NumSoilLayer + if ( LoopInd == (NumSnowLayerNeg+1) ) then + HeatCapacPerArea(LoopInd) = - DepthSnowSoilLayer(LoopInd) * HeatCapacSoilSnow(LoopInd) + DepthSnowSoilTmp = - DepthSnowSoilLayer(LoopInd+1) + DepthSnowSoilInv(LoopInd) = 2.0 / DepthSnowSoilTmp + TempGradDepth(LoopInd) = 2.0 * (TemperatureSoilSnow(LoopInd) - TemperatureSoilSnow(LoopInd+1)) / DepthSnowSoilTmp + EnergyExcess(LoopInd) = ThermConductSoilSnow(LoopInd) * TempGradDepth(LoopInd) - & + HeatGroundTotMean - RadSwPenetrateGrd(LoopInd) + elseif ( LoopInd < NumSoilLayer ) then + HeatCapacPerArea(LoopInd) = (DepthSnowSoilLayer(LoopInd-1) - DepthSnowSoilLayer(LoopInd)) * HeatCapacSoilSnow(LoopInd) + DepthSnowSoilTmp = DepthSnowSoilLayer(LoopInd-1) - DepthSnowSoilLayer(LoopInd+1) + DepthSnowSoilInv(LoopInd) = 2.0 / DepthSnowSoilTmp + TempGradDepth(LoopInd) = 2.0 * (TemperatureSoilSnow(LoopInd) - TemperatureSoilSnow(LoopInd+1)) / DepthSnowSoilTmp + EnergyExcess(LoopInd) = (ThermConductSoilSnow(LoopInd)*TempGradDepth(LoopInd) - & + ThermConductSoilSnow(LoopInd-1) * TempGradDepth(LoopInd-1) ) - RadSwPenetrateGrd(LoopInd) + elseif ( LoopInd == NumSoilLayer ) then + HeatCapacPerArea(LoopInd) = (DepthSnowSoilLayer(LoopInd-1) - DepthSnowSoilLayer(LoopInd)) * HeatCapacSoilSnow(LoopInd) + DepthSnowSoilTmp = DepthSnowSoilLayer(LoopInd-1) - DepthSnowSoilLayer(LoopInd) + if ( OptSoilTemperatureBottom == 1 ) then + HeatFromSoilBot = 0.0 + endif + if ( OptSoilTemperatureBottom == 2 ) then + TempGradDepth(LoopInd) = (TemperatureSoilSnow(LoopInd) - TemperatureSoilBottom) / & + (0.5*(DepthSnowSoilLayer(LoopInd-1)+DepthSnowSoilLayer(LoopInd)) - DepthSoilTempBotToSno) + HeatFromSoilBot = -ThermConductSoilSnow(LoopInd) * TempGradDepth(LoopInd) + endif + EnergyExcess(LoopInd) = (-HeatFromSoilBot - ThermConductSoilSnow(LoopInd-1) * TempGradDepth(LoopInd-1)) - & + RadSwPenetrateGrd(LoopInd) + endif + enddo + + ! prepare the matrix coefficients for the tri-diagonal matrix + do LoopInd = NumSnowLayerNeg+1, NumSoilLayer + if ( LoopInd == (NumSnowLayerNeg+1) ) then + MatLeft1(LoopInd) = 0.0 + MatLeft3(LoopInd) = - ThermConductSoilSnow(LoopInd) * DepthSnowSoilInv(LoopInd) / HeatCapacPerArea(LoopInd) + if ( (OptSnowSoilTempTime == 1) .or. (OptSnowSoilTempTime == 3) ) then + MatLeft2(LoopInd) = - MatLeft3(LoopInd) + endif + if ( OptSnowSoilTempTime == 2 ) then + MatLeft2(LoopInd) = - MatLeft3(LoopInd) + ThermConductSoilSnow(LoopInd) / & + (0.5*DepthSnowSoilLayer(LoopInd)*DepthSnowSoilLayer(LoopInd)*HeatCapacSoilSnow(LoopInd)) + endif + elseif ( LoopInd < NumSoilLayer ) then + MatLeft1(LoopInd) = - ThermConductSoilSnow(LoopInd-1) * DepthSnowSoilInv(LoopInd-1) / HeatCapacPerArea(LoopInd) + MatLeft3(LoopInd) = - ThermConductSoilSnow(LoopInd ) * DepthSnowSoilInv(LoopInd ) / HeatCapacPerArea(LoopInd) + MatLeft2(LoopInd) = - (MatLeft1(LoopInd) + MatLeft3 (LoopInd)) + elseif ( LoopInd == NumSoilLayer ) then + MatLeft1(LoopInd) = - ThermConductSoilSnow(LoopInd-1) * DepthSnowSoilInv(LoopInd-1) / HeatCapacPerArea(LoopInd) + MatLeft3(LoopInd) = 0.0 + MatLeft2(LoopInd) = - (MatLeft1(LoopInd) + MatLeft3(LoopInd)) + endif + MatRight(LoopInd) = EnergyExcess(LoopInd) / (-HeatCapacPerArea(LoopInd)) + enddo + + ! deallocate local arrays to avoid memory leaks + deallocate(DepthSnowSoilInv) + deallocate(HeatCapacPerArea) + deallocate(TempGradDepth ) + deallocate(EnergyExcess ) + + end associate + + end subroutine SoilSnowThermalDiffusion + +end module SoilSnowThermalDiffusionMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SoilSnowWaterPhaseChangeMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SoilSnowWaterPhaseChangeMod.F90 new file mode 100644 index 000000000..5a2de9865 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SoilSnowWaterPhaseChangeMod.F90 @@ -0,0 +1,290 @@ +module SoilSnowWaterPhaseChangeMod + +!!! Compute the phase change (melting/freezing) of snow water and soil water + + use Machine + use NoahmpVarType + use ConstantDefineMod + use SoilWaterSupercoolKoren99Mod, only : SoilWaterSupercoolKoren99 + use SoilWaterSupercoolNiu06Mod, only : SoilWaterSupercoolNiu06 + use mpas_log + + implicit none + +contains + + subroutine SoilSnowWaterPhaseChange(noahmp) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: PHASECHANGE +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! in & out variables + type(noahmp_type) , intent(inout) :: noahmp + +! local variable + integer :: LoopInd ! do loop index + real(kind=kind_noahmp) :: EnergyResLeft ! energy residual or loss after melting/freezing + real(kind=kind_noahmp) :: SnowWaterPrev ! old/previous snow water equivalent [kg/m2] + real(kind=kind_noahmp) :: SnowWaterRatio ! ratio of previous vs updated snow water equivalent + real(kind=kind_noahmp) :: HeatLhTotPhsChg ! total latent heat of phase change + real(kind=kind_noahmp), allocatable, dimension(:) :: EnergyRes ! energy residual [w/m2] + real(kind=kind_noahmp), allocatable, dimension(:) :: TemperatureRes ! TemperatureRes residual [K] + real(kind=kind_noahmp), allocatable, dimension(:) :: WaterPhaseChg ! melting or freezing water [kg/m2] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassWatTotInit ! initial total water (ice + liq) mass + real(kind=kind_noahmp), allocatable, dimension(:) :: MassWatIceInit ! initial ice content + real(kind=kind_noahmp), allocatable, dimension(:) :: MassWatLiqInit ! initial liquid content + real(kind=kind_noahmp), allocatable, dimension(:) :: MassWatIceTmp ! soil/snow ice mass [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: MassWatLiqTmp ! soil/snow liquid water mass [mm] + +! -------------------------------------------------------------------- + associate( & + OptSoilSupercoolWater => noahmp%config%nmlist%OptSoilSupercoolWater ,& ! in, options for soil supercooled liquid water + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& ! in, maximum number of snow layers + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! in, actual number of snow layers (negative) + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, main noahmp timestep [s] + SurfaceType => noahmp%config%domain%SurfaceType ,& ! in, surface type 1-soil; 2-lake + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! in, thickness of snow/soil layers [m] + SoilExpCoeffB => noahmp%water%param%SoilExpCoeffB ,& ! in, soil B parameter + SoilMatPotentialSat => noahmp%water%param%SoilMatPotentialSat ,& ! in, saturated soil matric potential [m] + SoilMoistureSat => noahmp%water%param%SoilMoistureSat ,& ! in, saturated value of soil moisture [m3/m3] + PhaseChgFacSoilSnow => noahmp%energy%state%PhaseChgFacSoilSnow ,& ! in, energy factor for soil & snow phase change + TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow ,& ! inout, snow and soil layer temperature [K] + SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! inout, soil water content [m3/m3] + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! inout, total soil moisture [m3/m3] + SnowIce => noahmp%water%state%SnowIce ,& ! inout, snow layer ice [mm] + SnowLiqWater => noahmp%water%state%SnowLiqWater ,& ! inout, snow layer liquid water [mm] + SnowDepth => noahmp%water%state%SnowDepth ,& ! inout, snow depth [m] + SnowWaterEquiv => noahmp%water%state%SnowWaterEquiv ,& ! inout, snow water equivalent [mm] + IndexPhaseChange => noahmp%water%state%IndexPhaseChange ,& ! out, phase change index [0-none;1-melt;2-refreeze] + SoilSupercoolWater => noahmp%water%state%SoilSupercoolWater ,& ! out, supercooled water in soil [kg/m2] + PondSfcThinSnwMelt => noahmp%water%state%PondSfcThinSnwMelt ,& ! out, surface ponding [mm] from melt when thin snow w/o layer + MeltGroundSnow => noahmp%water%flux%MeltGroundSnow & ! out, ground snowmelt rate [mm/s] + ) +! ---------------------------------------------------------------------- + + !--- Initialization + if (.not. allocated(EnergyRes) ) allocate(EnergyRes (-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(TemperatureRes)) allocate(TemperatureRes(-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(WaterPhaseChg) ) allocate(WaterPhaseChg (-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(MassWatTotInit)) allocate(MassWatTotInit(-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(MassWatIceInit)) allocate(MassWatIceInit(-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(MassWatLiqInit)) allocate(MassWatLiqInit(-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(MassWatIceTmp) ) allocate(MassWatIceTmp (-NumSnowLayerMax+1:NumSoilLayer)) + if (.not. allocated(MassWatLiqTmp) ) allocate(MassWatLiqTmp (-NumSnowLayerMax+1:NumSoilLayer)) + EnergyRes = 0.0 + TemperatureRes = 0.0 + WaterPhaseChg = 0.0 + MassWatTotInit = 0.0 + MassWatIceInit = 0.0 + MassWatLiqInit = 0.0 + MassWatIceTmp = 0.0 + MassWatLiqTmp = 0.0 + MeltGroundSnow = 0.0 + PondSfcThinSnwMelt = 0.0 + HeatLhTotPhsChg = 0.0 + + + ! supercooled water content + do LoopInd = -NumSnowLayerMax+1, NumSoilLayer + SoilSupercoolWater(LoopInd) = 0.0 + enddo + + ! snow layer water mass + do LoopInd = NumSnowLayerNeg+1, 0 + MassWatIceTmp(LoopInd) = SnowIce(LoopInd) + MassWatLiqTmp(LoopInd) = SnowLiqWater(LoopInd) + enddo + +!PK call mpas_log_write('noahmp input max SoilLiqWater=$r', realArgs=(/maxval(SoilLiqWater)/)) +!PK call mpas_log_write('noahmp input min SoilLiqWater=$r', realArgs=(/minval(SoilLiqWater)/)) + +!PK call mpas_log_write('noahmp input max SoilMoisture=$r', realArgs=(/maxval(SoilMoisture)/)) +!PK call mpas_log_write('noahmp input min SoilMoisture=$r', realArgs=(/minval(SoilMoisture)/)) + + ! soil layer water mass + do LoopInd = 1, NumSoilLayer + MassWatLiqTmp(LoopInd) = SoilLiqWater(LoopInd) * ThicknessSnowSoilLayer(LoopInd) * 1000.0 + MassWatIceTmp(LoopInd) = (SoilMoisture(LoopInd) - SoilLiqWater(LoopInd)) * ThicknessSnowSoilLayer(LoopInd) * 1000.0 + enddo + + ! other required variables + do LoopInd = NumSnowLayerNeg+1, NumSoilLayer + IndexPhaseChange(LoopInd) = 0 + EnergyRes(LoopInd) = 0.0 + WaterPhaseChg(LoopInd) = 0.0 + TemperatureRes(LoopInd) = TemperatureSoilSnow(LoopInd) + MassWatIceInit(LoopInd) = MassWatIceTmp(LoopInd) + MassWatLiqInit(LoopInd) = MassWatLiqTmp(LoopInd) + MassWatTotInit(LoopInd) = MassWatIceTmp(LoopInd) + MassWatLiqTmp(LoopInd) + enddo + + !--- compute soil supercool water content + if ( SurfaceType == 1 ) then ! land points + do LoopInd = 1, NumSoilLayer + if ( OptSoilSupercoolWater == 1 ) then + if ( TemperatureSoilSnow(LoopInd) < ConstFreezePoint ) then + call SoilWaterSupercoolNiu06(noahmp, LoopInd, SoilSupercoolWater(LoopInd),TemperatureSoilSnow(LoopInd)) + SoilSupercoolWater(LoopInd) = SoilSupercoolWater(LoopInd) * ThicknessSnowSoilLayer(LoopInd) * 1000.0 + endif + endif + if ( OptSoilSupercoolWater == 2 ) then + if ( TemperatureSoilSnow(LoopInd) < ConstFreezePoint ) then + call SoilWaterSupercoolKoren99(noahmp, LoopInd, SoilSupercoolWater(LoopInd), & + TemperatureSoilSnow(LoopInd), SoilMoisture(LoopInd), SoilLiqWater(LoopInd)) + SoilSupercoolWater(LoopInd) = SoilSupercoolWater(LoopInd) * ThicknessSnowSoilLayer(LoopInd) * 1000.0 + endif + endif + enddo + endif + +!PK call mpas_log_write('noahmp input NumSoilLayer=$i' , intArgs=(/NumSoilLayer/)) +!PK call mpas_log_write('noahmp input NumSnowLayerNeg=$i', intArgs=(/NumSnowLayerNeg/)) +!PK call mpas_log_write('noahmp input NumSnowLayerMax=$i', intArgs=(/NumSnowLayerMax/)) +!PK call mpas_log_write('noahmp input max MassWatIceTmp=$r', realArgs=(/maxval(MassWatIceTmp)/)) +!PK call mpas_log_write('noahmp input min MassWatIceTmp=$r', realArgs=(/minval(MassWatIceTmp)/)) +!PK call mpas_log_write('noahmp input max MassWatLiqTmp=$r', realArgs=(/maxval(MassWatLiqTmp)/)) +!PK call mpas_log_write('noahmp input min MassWatLiqTmp=$r', realArgs=(/minval(MassWatLiqTmp)/)) + +!PK call mpas_log_write('noahmp input max tslb=$r', realArgs=(/maxval(TemperatureSoilSnow)/)) +!PK call mpas_log_write('noahmp input min tslb=$r', realArgs=(/minval(TemperatureSoilSnow)/)) + + !--- determine melting or freezing state + do LoopInd = NumSnowLayerNeg+1, NumSoilLayer + if ( (MassWatIceTmp(LoopInd) > 0.0) .and. (TemperatureSoilSnow(LoopInd) >= ConstFreezePoint) ) then + IndexPhaseChange(LoopInd) = 1 ! melting + TemperatureRes (LoopInd) = TemperatureSoilSnow(LoopInd) + TemperatureRes (LoopInd) = ConstFreezePoint + endif + if ( (MassWatLiqTmp(LoopInd) > SoilSupercoolWater(LoopInd)) .and. & + (TemperatureSoilSnow(LoopInd) < ConstFreezePoint) ) then + IndexPhaseChange(LoopInd) = 2 ! freezing + TemperatureRes (LoopInd) = ConstFreezePoint + endif + ! If snow exists, but its thickness is not enough to create a layer + if ( (NumSnowLayerNeg == 0) .and. (SnowWaterEquiv > 0.0) .and. (LoopInd == 1) ) then + if ( TemperatureSoilSnow(LoopInd) >= ConstFreezePoint ) then + IndexPhaseChange(LoopInd) = 1 + TemperatureRes (LoopInd) = ConstFreezePoint + endif + endif + enddo + + + !--- Calculate the energy surplus and loss for melting and freezing + + do LoopInd = NumSnowLayerNeg+1, NumSoilLayer + if ( IndexPhaseChange(LoopInd) > 0 ) then + EnergyRes(LoopInd) = (TemperatureSoilSnow(LoopInd)-ConstFreezePoint) / PhaseChgFacSoilSnow(LoopInd) + TemperatureSoilSnow(LoopInd) = TemperatureRes (LoopInd) + endif + if ( (IndexPhaseChange(LoopInd) == 1) .and. (EnergyRes(LoopInd) < 0.0) ) then + EnergyRes(LoopInd) = 0.0 + IndexPhaseChange(LoopInd) = 0 + endif + if ( (IndexPhaseChange(LoopInd) == 2) .and. (EnergyRes(LoopInd) > 0.0) ) then + EnergyRes(LoopInd) = 0.0 + IndexPhaseChange(LoopInd) = 0 + endif + WaterPhaseChg(LoopInd) = EnergyRes(LoopInd) * MainTimeStep / ConstLatHeatFusion + enddo + +!PK call mpas_log_write('noahmp output max tslb=$r', realArgs=(/maxval(TemperatureSoilSnow)/)) +!PK call mpas_log_write('noahmp output min tslb=$r', realArgs=(/minval(TemperatureSoilSnow)/)) + + !--- The rate of melting for snow without a layer, needs more work. + if ( (NumSnowLayerNeg == 0) .and. (SnowWaterEquiv > 0.0) .and. (WaterPhaseChg(1) > 0.0) ) then + SnowWaterPrev = SnowWaterEquiv + SnowWaterEquiv = max(0.0, SnowWaterPrev-WaterPhaseChg(1)) + SnowWaterRatio = SnowWaterEquiv / SnowWaterPrev + SnowDepth = max(0.0, SnowWaterRatio*SnowDepth ) + SnowDepth = min(max(SnowDepth,SnowWaterEquiv/500.0), SnowWaterEquiv/50.0) ! limit adjustment to a reasonable density + EnergyResLeft = EnergyRes(1) - ConstLatHeatFusion * (SnowWaterPrev - SnowWaterEquiv) / MainTimeStep + if ( EnergyResLeft > 0.0 ) then + WaterPhaseChg(1) = EnergyResLeft * MainTimeStep / ConstLatHeatFusion + EnergyRes(1) = EnergyResLeft + else + WaterPhaseChg(1) = 0.0 + EnergyRes(1) = 0.0 + endif + MeltGroundSnow = max(0.0, (SnowWaterPrev-SnowWaterEquiv)) / MainTimeStep + HeatLhTotPhsChg = ConstLatHeatFusion * MeltGroundSnow + PondSfcThinSnwMelt = SnowWaterPrev - SnowWaterEquiv + endif + + ! The rate of melting and freezing for multi-layer snow and soil + do LoopInd = NumSnowLayerNeg+1, NumSoilLayer + if ( (IndexPhaseChange(LoopInd) > 0) .and. (abs(EnergyRes(LoopInd)) > 0.0) ) then + EnergyResLeft = 0.0 + if ( WaterPhaseChg(LoopInd) > 0.0 ) then + MassWatIceTmp(LoopInd) = max(0.0, MassWatIceInit(LoopInd)-WaterPhaseChg(LoopInd)) + EnergyResLeft = EnergyRes(LoopInd) - ConstLatHeatFusion * & + (MassWatIceInit(LoopInd) - MassWatIceTmp(LoopInd)) / MainTimeStep + elseif ( WaterPhaseChg(LoopInd) < 0.0 ) then + if ( LoopInd <= 0 ) then ! snow layer + MassWatIceTmp(LoopInd) = min(MassWatTotInit(LoopInd), MassWatIceInit(LoopInd)-WaterPhaseChg(LoopInd)) + else ! soil layer + if ( MassWatTotInit(LoopInd) < SoilSupercoolWater(LoopInd) ) then + MassWatIceTmp(LoopInd) = 0.0 + else + MassWatIceTmp(LoopInd) = min(MassWatTotInit(LoopInd)-SoilSupercoolWater(LoopInd), & + MassWatIceInit(LoopInd)-WaterPhaseChg(LoopInd)) + MassWatIceTmp(LoopInd) = max(MassWatIceTmp(LoopInd), 0.0) + endif + endif + EnergyResLeft = EnergyRes(LoopInd) - ConstLatHeatFusion * (MassWatIceInit(LoopInd) - & + MassWatIceTmp(LoopInd)) / MainTimeStep + endif + MassWatLiqTmp(LoopInd) = max(0.0, MassWatTotInit(LoopInd)-MassWatIceTmp(LoopInd)) ! update liquid water mass + + ! update soil/snow temperature and energy surplus/loss + if ( abs(EnergyResLeft) > 0.0 ) then + TemperatureSoilSnow(LoopInd) = TemperatureSoilSnow(LoopInd) + PhaseChgFacSoilSnow(LoopInd) * EnergyResLeft + if ( LoopInd <= 0 ) then ! snow + if ( (MassWatLiqTmp(LoopInd)*MassWatIceTmp(LoopInd)) > 0.0 ) & + TemperatureSoilSnow(LoopInd) = ConstFreezePoint + if ( MassWatIceTmp(LoopInd) == 0.0 ) then ! BARLAGE + TemperatureSoilSnow(LoopInd) = ConstFreezePoint + EnergyRes(LoopInd+1) = EnergyRes(LoopInd+1) + EnergyResLeft + WaterPhaseChg(LoopInd+1) = EnergyRes(LoopInd+1) * MainTimeStep / ConstLatHeatFusion + endif + endif + endif + HeatLhTotPhsChg = HeatLhTotPhsChg + ConstLatHeatFusion * & + (MassWatIceInit(LoopInd) - MassWatIceTmp(LoopInd)) / MainTimeStep + ! snow melting rate + if ( LoopInd < 1 ) then + MeltGroundSnow = MeltGroundSnow + max(0.0, (MassWatIceInit(LoopInd)-MassWatIceTmp(LoopInd))) / MainTimeStep + endif + endif + enddo + + !--- update snow and soil ice and liquid content + do LoopInd = NumSnowLayerNeg+1, 0 ! snow + SnowLiqWater(LoopInd) = MassWatLiqTmp(LoopInd) + SnowIce(LoopInd) = MassWatIceTmp(LoopInd) + enddo + do LoopInd = 1, NumSoilLayer ! soil + SoilLiqWater(LoopInd) = MassWatLiqTmp(LoopInd) / (1000.0 * ThicknessSnowSoilLayer(LoopInd)) + SoilMoisture(LoopInd) = (MassWatLiqTmp(LoopInd)+MassWatIceTmp(LoopInd)) / (1000.0*ThicknessSnowSoilLayer(LoopInd)) + enddo + + ! deallocate local arrays to avoid memory leaks + deallocate(EnergyRes ) + deallocate(WaterPhaseChg ) + deallocate(MassWatTotInit) + deallocate(MassWatIceInit) + deallocate(MassWatLiqInit) + deallocate(MassWatIceTmp ) + deallocate(MassWatLiqTmp ) + + end associate + + end subroutine SoilSnowWaterPhaseChange + +end module SoilSnowWaterPhaseChangeMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SoilThermalPropertyMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SoilThermalPropertyMod.F90 new file mode 100644 index 000000000..dd38333c0 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SoilThermalPropertyMod.F90 @@ -0,0 +1,112 @@ +module SoilThermalPropertyMod + +!!! Compute soil thermal conductivity based on Peters-Lidard et al. (1998) + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine SoilThermalProperty(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: TDFCND +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! If the soil has any moisture content compute a partial sum/product +! otherwise use a constant value which works well with most soils +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: LoopInd ! loop index + real(kind=kind_noahmp) :: KerstenFac ! Kersten number + real(kind=kind_noahmp) :: SoilGamFac ! temporary soil GAMMD factor + real(kind=kind_noahmp) :: ThermConductSoilDry ! thermal conductivity for dry soil + real(kind=kind_noahmp) :: ThermConductSoilSat ! thermal conductivity for saturated soil + real(kind=kind_noahmp) :: ThermConductSolid ! thermal conductivity for the solids + real(kind=kind_noahmp) :: SoilSatRatio ! saturation ratio + real(kind=kind_noahmp) :: SoilWatFracSat ! saturated soil water fraction + real(kind=kind_noahmp) :: SoilWatFrac ! soil water fraction + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilIceTmp ! temporal soil ice + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + SoilMoistureSat => noahmp%water%param%SoilMoistureSat ,& ! in, saturated value of soil moisture [m3/m3] + SoilHeatCapacity => noahmp%energy%param%SoilHeatCapacity ,& ! in, soil volumetric specific heat [J/m3/K] + SoilQuartzFrac => noahmp%energy%param%SoilQuartzFrac ,& ! in, soil quartz content + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! in, total soil moisture [m3/m3] + SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! in, soil water content [m3/m3] + HeatCapacVolSoil => noahmp%energy%state%HeatCapacVolSoil ,& ! out, soil layer volumetric specific heat [J/m3/K] + ThermConductSoil => noahmp%energy%state%ThermConductSoil & ! out, soil layer thermal conductivity [W/m/K] + ) +! ---------------------------------------------------------------------- + + ! initiazliation + if (.not. allocated(SoilIceTmp)) allocate(SoilIceTmp(1:NumSoilLayer)) + SoilIceTmp(:) = 0.0 + + do LoopInd = 1, NumSoilLayer + + ! ==== soil heat capacity + SoilIceTmp(LoopInd) = SoilMoisture(LoopInd) - SoilLiqWater(LoopInd) + HeatCapacVolSoil(LoopInd) = SoilLiqWater(LoopInd) * ConstHeatCapacWater + & + (1.0 - SoilMoistureSat(LoopInd)) * SoilHeatCapacity + & + (SoilMoistureSat(LoopInd) - SoilMoisture(LoopInd)) * ConstHeatCapacAir + & + SoilIceTmp(LoopInd) * ConstHeatCapacIce + + ! ==== soil thermal conductivity + SoilSatRatio = SoilMoisture(LoopInd) / SoilMoistureSat(LoopInd) ! SATURATION RATIO + + ! UNFROZEN FRACTION (FROM 1., i.e., 100%LIQUID, TO 0. (100% FROZEN)) + ThermConductSolid = (ConstThermConductQuartz ** SoilQuartzFrac(LoopInd)) * & + (ConstThermConductSoilOth ** (1.0 - SoilQuartzFrac(LoopInd))) + + ! UNFROZEN VOLUME FOR SATURATION (POROSITY*SoilWatFrac) + SoilWatFrac = 1.0 ! Prevent divide by zero (suggested by D. Mocko) + if ( SoilMoisture(LoopInd) > 0.0 ) SoilWatFrac = SoilLiqWater(LoopInd) / SoilMoisture(LoopInd) + SoilWatFracSat = SoilWatFrac * SoilMoistureSat(LoopInd) + + ! SATURATED THERMAL CONDUCTIVITY + ThermConductSoilSat = ThermConductSolid ** (1.0-SoilMoistureSat(LoopInd)) * & + ConstThermConductIce ** (SoilMoistureSat(LoopInd)-SoilWatFracSat) * & + ConstThermConductWater ** (SoilWatFracSat) + + ! DRY THERMAL CONDUCTIVITY IN W.M-1.K-1 + SoilGamFac = (1.0 - SoilMoistureSat(LoopInd)) * 2700.0 + ThermConductSoilDry = (0.135 * SoilGamFac + 64.7) / (2700.0 - 0.947 * SoilGamFac) + + ! THE KERSTEN NUMBER KerstenFac + if ( (SoilLiqWater(LoopInd)+0.0005) < SoilMoisture(LoopInd) ) then ! FROZEN + KerstenFac = SoilSatRatio + else ! UNFROZEN + ! 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 ( SoilSatRatio > 0.1 ) then + KerstenFac = log10(SoilSatRatio) + 1.0 + else + KerstenFac = 0.0 + endif + endif + + ! THERMAL CONDUCTIVITY + ThermConductSoil(LoopInd) = KerstenFac*(ThermConductSoilSat-ThermConductSoilDry) + ThermConductSoilDry + + enddo ! LoopInd + + ! deallocate local arrays to avoid memory leaks + deallocate(SoilIceTmp) + + end associate + + end subroutine SoilThermalProperty + +end module SoilThermalPropertyMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SoilWaterDiffusionRichardsMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SoilWaterDiffusionRichardsMod.F90 new file mode 100644 index 000000000..ebeaf64bf --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SoilWaterDiffusionRichardsMod.F90 @@ -0,0 +1,180 @@ +module SoilWaterDiffusionRichardsMod + +!!! Solve Richards equation for soil water movement/diffusion +!!! Compute 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. + + use Machine + use NoahmpVarType + use ConstantDefineMod + use SoilHydraulicPropertyMod + + implicit none + +contains + + subroutine SoilWaterDiffusionRichards(noahmp, MatLeft1, MatLeft2, MatLeft3, MatRight) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: SRT +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! in & out variables + type(noahmp_type) , intent(inout) :: noahmp + real(kind=kind_noahmp), allocatable, dimension(:), intent(inout) :: MatRight ! right-hand side term of the matrix + real(kind=kind_noahmp), allocatable, dimension(:), intent(inout) :: MatLeft1 ! left-hand side term of the matrix + real(kind=kind_noahmp), allocatable, dimension(:), intent(inout) :: MatLeft2 ! left-hand side term of the matrix + real(kind=kind_noahmp), allocatable, dimension(:), intent(inout) :: MatLeft3 ! left-hand side term of the matrix + +! local variable + integer :: LoopInd ! loop index + real(kind=kind_noahmp) :: DepthSnowSoilTmp ! temporary snow/soil layer depth [m] + real(kind=kind_noahmp) :: SoilMoistTmpToWT ! temporary soil moisture between bottom of the soil and water table + real(kind=kind_noahmp) :: SoilMoistBotTmp ! temporary soil moisture below bottom to calculate flux + real(kind=kind_noahmp), allocatable, dimension(:) :: DepthSnowSoilInv ! inverse of snow/soil layer depth [1/m] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilThickTmp ! temporary soil thickness + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilWaterGrad ! temporary soil moisture vertical gradient + real(kind=kind_noahmp), allocatable, dimension(:) :: WaterExcess ! temporary excess water flux + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilMoistureTmp ! temporary soil moisture + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth [m] of layer-bottom from soil surface + OptSoilPermeabilityFrozen => noahmp%config%nmlist%OptSoilPermeabilityFrozen ,& ! in, options for frozen soil permeability + OptRunoffSubsurface => noahmp%config%nmlist%OptRunoffSubsurface ,& ! in, options for drainage and subsurface runoff + SoilDrainSlope => noahmp%water%param%SoilDrainSlope ,& ! in, slope index for soil drainage + InfilRateSfc => noahmp%water%flux%InfilRateSfc ,& ! in, infiltration rate at surface [m/s] + EvapSoilSfcLiqMean => noahmp%water%flux%EvapSoilSfcLiqMean ,& ! in, mean evaporation from soil surface [m/s] + TranspWatLossSoilMean => noahmp%water%flux%TranspWatLossSoilMean ,& ! in, mean transpiration water loss from soil layers [m/s] + SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! in, soil water content [m3/m3] + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! in, total soil moisture [m3/m3] + WaterTableDepth => noahmp%water%state%WaterTableDepth ,& ! in, water table depth [m] + SoilImpervFrac => noahmp%water%state%SoilImpervFrac ,& ! in, fraction of imperviousness due to frozen soil + SoilImpervFracMax => noahmp%water%state%SoilImpervFracMax ,& ! in, maximum soil imperviousness fraction + SoilIceMax => noahmp%water%state%SoilIceMax ,& ! in, maximum soil ice content [m3/m3] + SoilMoistureToWT => noahmp%water%state%SoilMoistureToWT ,& ! in, soil moisture between bottom of the soil and the water table + SoilWatConductivity => noahmp%water%state%SoilWatConductivity ,& ! out, soil hydraulic conductivity [m/s] + SoilWatDiffusivity => noahmp%water%state%SoilWatDiffusivity ,& ! out, soil water diffusivity [m2/s] + DrainSoilBot => noahmp%water%flux%DrainSoilBot & ! out, soil bottom drainage [m/s] + ) +! ---------------------------------------------------------------------- + + ! initialization + if (.not. allocated(DepthSnowSoilInv)) allocate(DepthSnowSoilInv(1:NumSoilLayer)) + if (.not. allocated(SoilThickTmp) ) allocate(SoilThickTmp (1:NumSoilLayer)) + if (.not. allocated(SoilWaterGrad) ) allocate(SoilWaterGrad (1:NumSoilLayer)) + if (.not. allocated(WaterExcess) ) allocate(WaterExcess (1:NumSoilLayer)) + if (.not. allocated(SoilMoistureTmp) ) allocate(SoilMoistureTmp (1:NumSoilLayer)) + MatRight(:) = 0.0 + MatLeft1(:) = 0.0 + MatLeft2(:) = 0.0 + MatLeft3(:) = 0.0 + DepthSnowSoilInv(:) = 0.0 + SoilThickTmp(:) = 0.0 + SoilWaterGrad(:) = 0.0 + WaterExcess(:) = 0.0 + SoilMoistureTmp(:) = 0.0 + + ! compute soil hydraulic conductivity and diffusivity + if ( OptSoilPermeabilityFrozen == 1 ) then + do LoopInd = 1, NumSoilLayer + call SoilDiffusivityConductivityOpt1(noahmp,SoilWatDiffusivity(LoopInd),SoilWatConductivity(LoopInd),& + SoilMoisture(LoopInd),SoilImpervFrac(LoopInd),LoopInd) + SoilMoistureTmp(LoopInd) = SoilMoisture(LoopInd) + enddo + if ( OptRunoffSubsurface == 5 ) SoilMoistTmpToWT = SoilMoistureToWT + endif + + if ( OptSoilPermeabilityFrozen == 2 ) then + do LoopInd = 1, NumSoilLayer + call SoilDiffusivityConductivityOpt2(noahmp,SoilWatDiffusivity(LoopInd),SoilWatConductivity(LoopInd),& + SoilLiqWater(LoopInd),SoilIceMax,LoopInd) + SoilMoistureTmp(LoopInd) = SoilLiqWater(LoopInd) + enddo + if ( OptRunoffSubsurface == 5 ) & + SoilMoistTmpToWT = SoilMoistureToWT * SoilLiqWater(NumSoilLayer) / SoilMoisture(NumSoilLayer) !same liquid fraction as in the bottom layer + endif + + ! compute gradient and flux of soil water diffusion terms + do LoopInd = 1, NumSoilLayer + if ( LoopInd == 1 ) then + SoilThickTmp(LoopInd) = - DepthSoilLayer(LoopInd) + DepthSnowSoilTmp = - DepthSoilLayer(LoopInd+1) + DepthSnowSoilInv(LoopInd) = 2.0 / DepthSnowSoilTmp + SoilWaterGrad(LoopInd) = 2.0 * (SoilMoistureTmp(LoopInd)-SoilMoistureTmp(LoopInd+1)) / DepthSnowSoilTmp + WaterExcess(LoopInd) = SoilWatDiffusivity(LoopInd)*SoilWaterGrad(LoopInd) + SoilWatConductivity(LoopInd) - & + InfilRateSfc + TranspWatLossSoilMean(LoopInd) + EvapSoilSfcLiqMean + else if ( LoopInd < NumSoilLayer ) then + SoilThickTmp(LoopInd) = (DepthSoilLayer(LoopInd-1) - DepthSoilLayer(LoopInd)) + DepthSnowSoilTmp = (DepthSoilLayer(LoopInd-1) - DepthSoilLayer(LoopInd+1)) + DepthSnowSoilInv(LoopInd) = 2.0 / DepthSnowSoilTmp + SoilWaterGrad(LoopInd) = 2.0 * (SoilMoistureTmp(LoopInd) - SoilMoistureTmp(LoopInd+1)) / DepthSnowSoilTmp + WaterExcess(LoopInd) = SoilWatDiffusivity(LoopInd)*SoilWaterGrad(LoopInd) + SoilWatConductivity(LoopInd) - & + SoilWatDiffusivity(LoopInd-1)*SoilWaterGrad(LoopInd-1) - SoilWatConductivity(LoopInd-1) + & + TranspWatLossSoilMean(LoopInd) + else + SoilThickTmp(LoopInd) = (DepthSoilLayer(LoopInd-1) - DepthSoilLayer(LoopInd)) + if ( (OptRunoffSubsurface == 1) .or. (OptRunoffSubsurface == 2) ) then + DrainSoilBot = 0.0 + endif + if ( (OptRunoffSubsurface == 3) .or. (OptRunoffSubsurface == 6) .or. & + (OptRunoffSubsurface == 7) .or. (OptRunoffSubsurface == 8) ) then + DrainSoilBot = SoilDrainSlope * SoilWatConductivity(LoopInd) + endif + if ( OptRunoffSubsurface == 4 ) then + DrainSoilBot = (1.0 - SoilImpervFracMax) * SoilWatConductivity(LoopInd) + endif + if ( OptRunoffSubsurface == 5 ) then ! gmm new m-m&f water table dynamics formulation + DepthSnowSoilTmp = 2.0 * SoilThickTmp(LoopInd) + if ( WaterTableDepth < (DepthSoilLayer(NumSoilLayer)-SoilThickTmp(NumSoilLayer)) ) then + ! gmm interpolate from below, midway to the water table, + ! to the middle of the auxiliary layer below the soil bottom + SoilMoistBotTmp = SoilMoistureTmp(LoopInd) - (SoilMoistureTmp(LoopInd)-SoilMoistTmpToWT) * & + SoilThickTmp(LoopInd)*2.0 / (SoilThickTmp(LoopInd)+DepthSoilLayer(LoopInd)-WaterTableDepth) + else + SoilMoistBotTmp = SoilMoistTmpToWT + endif + SoilWaterGrad(LoopInd) = 2.0 * (SoilMoistureTmp(LoopInd) - SoilMoistBotTmp) / DepthSnowSoilTmp + DrainSoilBot = SoilWatDiffusivity(LoopInd) * SoilWaterGrad(LoopInd) + SoilWatConductivity(LoopInd) + endif + WaterExcess(LoopInd) = -(SoilWatDiffusivity(LoopInd-1)*SoilWaterGrad(LoopInd-1)) - SoilWatConductivity(LoopInd-1) + & + TranspWatLossSoilMean(LoopInd) + DrainSoilBot + endif + enddo + + ! prepare the matrix coefficients for the tri-diagonal matrix + do LoopInd = 1, NumSoilLayer + if ( LoopInd == 1 ) then + MatLeft1(LoopInd) = 0.0 + MatLeft2(LoopInd) = SoilWatDiffusivity(LoopInd ) * DepthSnowSoilInv(LoopInd ) / SoilThickTmp(LoopInd) + MatLeft3(LoopInd) = - MatLeft2(LoopInd) + else if ( LoopInd < NumSoilLayer ) then + MatLeft1(LoopInd) = - SoilWatDiffusivity(LoopInd-1) * DepthSnowSoilInv(LoopInd-1) / SoilThickTmp(LoopInd) + MatLeft3(LoopInd) = - SoilWatDiffusivity(LoopInd ) * DepthSnowSoilInv(LoopInd ) / SoilThickTmp(LoopInd) + MatLeft2(LoopInd) = - (MatLeft1(LoopInd) + MatLeft3(LoopInd)) + else + MatLeft1(LoopInd) = - SoilWatDiffusivity(LoopInd-1) * DepthSnowSoilInv(LoopInd-1) / SoilThickTmp(LoopInd) + MatLeft3(LoopInd) = 0.0 + MatLeft2(LoopInd) = - (MatLeft1(LoopInd) + MatLeft3(LoopInd)) + endif + MatRight(LoopInd) = WaterExcess(LoopInd) / (-SoilThickTmp(LoopInd)) + enddo + + ! deallocate local arrays to avoid memory leaks + deallocate(DepthSnowSoilInv) + deallocate(SoilThickTmp ) + deallocate(SoilWaterGrad ) + deallocate(WaterExcess ) + deallocate(SoilMoistureTmp ) + + end associate + + end subroutine SoilWaterDiffusionRichards + +end module SoilWaterDiffusionRichardsMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SoilWaterInfilGreenAmptMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SoilWaterInfilGreenAmptMod.F90 new file mode 100644 index 000000000..c61793459 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SoilWaterInfilGreenAmptMod.F90 @@ -0,0 +1,94 @@ +module SoilWaterInfilGreenAmptMod + +!!! Compute soil surface infiltration rate based on Green-Ampt equation +!!! We use its three parameter version of the smith-parlage equation, where gamma = 0, Eq 6.25 = Green-Ampt. +!!! Reference: Smith, R.E. (2002) Infiltration Theory for Hydrologic Applications, Water Resources Monograph + + use Machine + use NoahmpVarType + use ConstantDefineMod + use SoilHydraulicPropertyMod, only : SoilDiffusivityConductivityOpt2 + + implicit none + +contains + + subroutine SoilWaterInfilGreenAmpt(noahmp, IndInfilMax, InfilSfcAcc, InfilSfcTmp) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: GREEN_AMPT_INFIL +! Original code: Prasanth Valayamkunnath +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! in & out variabls + type(noahmp_type) , intent(inout) :: noahmp + integer , intent(in) :: IndInfilMax ! check for maximum infiltration at SoilMoistureWilt + real(kind=kind_noahmp), intent(inout) :: InfilSfcAcc ! accumulated infiltration rate [m/s] + real(kind=kind_noahmp), intent(out) :: InfilSfcTmp ! surface infiltration rate [m/s] + +! local variable + integer :: IndSoil ! soil layer index + real(kind=kind_noahmp) :: SoilWatDiffusivity ! soil water diffusivity [m2/s] + real(kind=kind_noahmp) :: SoilWatConductivity ! soil water conductivity[m/s] + real(kind=kind_noahmp) :: InfilFacTmp ! temporary infiltrability variable + +! -------------------------------------------------------------------- + associate( & + DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth [m] of layer-bottom from soil surface + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! in, total soil moisture [m3/m3] + SoilIce => noahmp%water%state%SoilIce ,& ! in, soil ice content [m3/m3] + SoilSfcInflowMean => noahmp%water%flux%SoilSfcInflowMean ,& ! in, mean water input on soil surface [m/s] + SoilMoistureSat => noahmp%water%param%SoilMoistureSat ,& ! in, saturated value of soil moisture [m3/m3] + SoilMoistureWilt => noahmp%water%param%SoilMoistureWilt ,& ! in, wilting point soil moisture [m3/m3] + SoilWatConductivitySat => noahmp%water%param%SoilWatConductivitySat ,& ! in, saturated soil hydraulic conductivity [m/s] + InfilCapillaryDynVic => noahmp%water%param%InfilCapillaryDynVic & ! in, DVIC Mean Capillary Drive [m] for infiltration models + ) +! ---------------------------------------------------------------------- + + IndSoil = 1 + if ( IndInfilMax == 1 ) then + + ! estimate initial soil hydraulic conductivty (Ki in the equation) (m/s) + call SoilDiffusivityConductivityOpt2(noahmp, SoilWatDiffusivity, SoilWatConductivity, & + SoilMoistureWilt(IndSoil), 0.0, IndSoil) + + ! Maximum infiltrability based on the Eq. 6.25. (m/s) + InfilFacTmp = InfilCapillaryDynVic * (SoilMoistureSat(IndSoil) - SoilMoistureWilt(IndSoil)) * & + (-1.0) * DepthSoilLayer(IndSoil) + InfilSfcTmp = SoilWatConductivitySat(IndSoil) + & + ((InfilFacTmp/1.0e-05) * (SoilWatConductivitySat(IndSoil) - SoilWatConductivity)) + + !maximum infiltration rate at surface + if ( InfilSfcTmp < 0.0 ) InfilSfcTmp = SoilWatConductivity + + else + + ! estimate initial soil hydraulic conductivty (Ki in the equation) (m/s) + call SoilDiffusivityConductivityOpt2(noahmp, SoilWatDiffusivity, SoilWatConductivity, & + SoilMoisture(IndSoil), SoilIce(IndSoil), IndSoil) + + ! Maximum infiltrability based on the Eq. 6.25. (m/s) + InfilFacTmp = InfilCapillaryDynVic * max(0.0, (SoilMoistureSat(IndSoil) - SoilMoisture(IndSoil))) * & + (-1.0) * DepthSoilLayer(IndSoil) + InfilSfcTmp = SoilWatConductivitySat(IndSoil) + & + ((InfilFacTmp/InfilSfcAcc) * (SoilWatConductivitySat(IndSoil) - SoilWatConductivity)) + + ! infiltration rate at surface + if ( SoilWatConductivitySat(IndSoil) < SoilSfcInflowMean ) then + InfilSfcTmp = min(SoilSfcInflowMean, InfilSfcTmp) + else + InfilSfcTmp = SoilSfcInflowMean + endif + ! accumulated infiltration function + InfilSfcAcc = InfilSfcAcc + InfilSfcTmp + + endif + + end associate + + end subroutine SoilWaterInfilGreenAmpt + +end module SoilWaterInfilGreenAmptMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SoilWaterInfilPhilipMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SoilWaterInfilPhilipMod.F90 new file mode 100644 index 000000000..9008f1caa --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SoilWaterInfilPhilipMod.F90 @@ -0,0 +1,104 @@ +module SoilWaterInfilPhilipMod + +!!! Compute soil surface infiltration rate based on Philip's two parameter equation +!!! Reference: Valiantzas (2010): New linearized two-parameter infiltration equation +!!! for direct determination of conductivity and sorptivity, J. Hydrology. + + use Machine + use NoahmpVarType + use ConstantDefineMod + use SoilHydraulicPropertyMod, only : SoilDiffusivityConductivityOpt2 + + implicit none + +contains + + subroutine SoilWaterInfilPhilip(noahmp, TimeStep, IndInfilMax, InfilSfcAcc, InfilSfcTmp) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: PHILIP_INFIL +! Original code: Prasanth Valayamkunnath +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! in & out variabls + type(noahmp_type) , intent(inout) :: noahmp + integer , intent(in) :: IndInfilMax ! check for maximum infiltration at SoilMoistureWilt + real(kind=kind_noahmp), intent(in) :: TimeStep ! timestep (may not be the same as model timestep) + real(kind=kind_noahmp), intent(inout) :: InfilSfcAcc ! accumulated infiltration rate [m/s] + real(kind=kind_noahmp), intent(out) :: InfilSfcTmp ! surface infiltration rate [m/s] + +! local variable + integer :: IndSoil ! soil layer index + real(kind=kind_noahmp) :: SoilWatDiffusivity ! soil water diffusivity [m2/s] + real(kind=kind_noahmp) :: SoilWatConductivity ! soil water conductivity [m/s] + real(kind=kind_noahmp) :: SoilSorptivity ! sorptivity [m s^-1/2] + real(kind=kind_noahmp) :: SoilWatConductTmp ! intial hydraulic conductivity [m/s] + +! -------------------------------------------------------------------- + associate( & + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! in, total soil moisture [m3/m3] + SoilIce => noahmp%water%state%SoilIce ,& ! in, soil ice content [m3/m3] + SoilSfcInflowMean => noahmp%water%flux%SoilSfcInflowMean ,& ! in, mean water input on soil surface [m/s] + SoilMoistureSat => noahmp%water%param%SoilMoistureSat ,& ! in, saturated value of soil moisture [m3/m3] + SoilMoistureWilt => noahmp%water%param%SoilMoistureWilt ,& ! in, wilting point soil moisture [m3/m3] + SoilWatDiffusivitySat => noahmp%water%param%SoilWatDiffusivitySat ,& ! in, saturated soil hydraulic diffusivity [m2/s] + SoilWatConductivitySat => noahmp%water%param%SoilWatConductivitySat & ! in, saturated soil hydraulic conductivity [m/s] + ) +! ---------------------------------------------------------------------- + + IndSoil = 1 + if ( IndInfilMax == 1) then + + ! estimate initial soil hydraulic conductivty and diffusivity (Ki, D(theta) in the equation) + call SoilDiffusivityConductivityOpt2(noahmp, SoilWatDiffusivity, SoilWatConductivity, & + SoilMoistureWilt(IndSoil), 0.0, IndSoil) + + ! Sorptivity based on Eq. 10b from Kutílek, Miroslav, and Jana Valentová (1986) + ! Sorptivity approximations. Transport in Porous Media 1.1, 57-62. + SoilSorptivity = sqrt(2.0 * (SoilMoistureSat(IndSoil) - SoilMoistureWilt(IndSoil)) * & + (SoilWatDiffusivitySat(IndSoil) - SoilWatDiffusivity)) + + ! Parameter A in Eq. 9 of Valiantzas (2010) is given by + SoilWatConductTmp = min(SoilWatConductivity, (2.0/3.0)*SoilWatConductivitySat(IndSoil)) + SoilWatConductTmp = max(SoilWatConductTmp, (1.0/3.0)*SoilWatConductivitySat(IndSoil)) + + ! Maximun infiltration rate + InfilSfcTmp = (1.0/2.0) * SoilSorptivity * (TimeStep**(-1.0/2.0)) + SoilWatConductTmp + if ( InfilSfcTmp < 0.0) InfilSfcTmp = SoilWatConductivity + + else + + ! estimate initial soil hydraulic conductivty and diffusivity (Ki, D(theta) in the equation) + call SoilDiffusivityConductivityOpt2(noahmp, SoilWatDiffusivity, SoilWatConductivity, & + SoilMoisture(IndSoil), SoilIce(IndSoil), IndSoil) + + ! Sorptivity based on Eq. 10b from Kutílek, Miroslav, and Jana Valentová (1986) + ! Sorptivity approximations. Transport in Porous Media 1.1, 57-62. + SoilSorptivity = sqrt(2.0 * max(0.0, (SoilMoistureSat(IndSoil)-SoilMoisture(IndSoil))) * & + (SoilWatDiffusivitySat(IndSoil) - SoilWatDiffusivity)) + ! Parameter A in Eq. 9 of Valiantzas (2010) is given by + SoilWatConductTmp = min(SoilWatConductivity, (2.0/3.0)*SoilWatConductivitySat(IndSoil)) + SoilWatConductTmp = max(SoilWatConductTmp, (1.0/3.0)*SoilWatConductivitySat(IndSoil)) + + ! Maximun infiltration rate + InfilSfcTmp = (1.0/2.0) * SoilSorptivity * (TimeStep**(-1.0/2.0)) + SoilWatConductTmp + + ! infiltration rate at surface + if ( SoilWatConductivitySat(IndSoil) < SoilSfcInflowMean ) then + InfilSfcTmp = min(SoilSfcInflowMean, InfilSfcTmp) + else + InfilSfcTmp = SoilSfcInflowMean + endif + ! accumulated infiltration function + InfilSfcAcc = InfilSfcAcc + InfilSfcTmp + + endif + + end associate + + end subroutine SoilWaterInfilPhilip + +end module SoilWaterInfilPhilipMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SoilWaterInfilSmithParlangeMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SoilWaterInfilSmithParlangeMod.F90 new file mode 100644 index 000000000..5d87dfe95 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SoilWaterInfilSmithParlangeMod.F90 @@ -0,0 +1,108 @@ +module SoilWaterInfilSmithParlangeMod + +!!! Compute soil surface infiltration rate based on Smith-Parlange equation +!!! Reference: Smith, R.E. (2002), Infiltration Theory for Hydrologic Applications + + use Machine + use NoahmpVarType + use ConstantDefineMod + use SoilHydraulicPropertyMod, only : SoilDiffusivityConductivityOpt2 + + implicit none + +contains + + subroutine SoilWaterInfilSmithParlange(noahmp, IndInfilMax, InfilSfcAcc, InfilSfcTmp) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: SMITH_PARLANGE_INFIL +! Original code: Prasanth Valayamkunnath +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! in & out variabls + type(noahmp_type) , intent(inout) :: noahmp + integer , intent(in) :: IndInfilMax ! check for maximum infiltration at SoilMoistureWilt + real(kind=kind_noahmp), intent(inout) :: InfilSfcAcc ! accumulated infiltration rate [m/s] + real(kind=kind_noahmp), intent(out) :: InfilSfcTmp ! surface infiltration rate [m/s] + +! local variables + integer :: IndSoil ! soil layer index + real(kind=kind_noahmp) :: SoilWatDiffusivity ! soil water diffusivity [m2/s] + real(kind=kind_noahmp) :: SoilWatConductivity ! soil water conductivity [m/s] + real(kind=kind_noahmp) :: InfilFacTmp ! temporary infiltrability variable + real(kind=kind_noahmp) :: WeighFac ! smith-parlang weighing parameter + +! -------------------------------------------------------------------- + associate( & + DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth [m] of layer-bottom from soil surface + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! in, total soil moisture [m3/m3] + SoilIce => noahmp%water%state%SoilIce ,& ! in, soil ice content [m3/m3] + SoilSfcInflowMean => noahmp%water%flux%SoilSfcInflowMean ,& ! in, mean water input on soil surface [m/s] + SoilMoistureSat => noahmp%water%param%SoilMoistureSat ,& ! in, saturated value of soil moisture [m3/m3] + SoilMoistureWilt => noahmp%water%param%SoilMoistureWilt ,& ! in, wilting point soil moisture [m3/m3] + SoilWatConductivitySat => noahmp%water%param%SoilWatConductivitySat ,& ! in, saturated soil hydraulic conductivity [m/s] + InfilCapillaryDynVic => noahmp%water%param%InfilCapillaryDynVic & ! in, DVIC Mean Capillary Drive [m] for infiltration models + ) +! ---------------------------------------------------------------------- + + ! smith-parlang weighing parameter, Gamma + WeighFac = 0.82 + IndSoil = 1 + + ! check whether we are estimating infiltration for current SoilMoisture or SoilMoistureWilt + if ( IndInfilMax == 1 ) then ! not active for now as the maximum infiltration is estimated based on table values + + ! estimate initial soil hydraulic conductivty (Ki in the equation) (m/s) + call SoilDiffusivityConductivityOpt2(noahmp, SoilWatDiffusivity, SoilWatConductivity, & + SoilMoistureWilt(IndSoil), 0.0, IndSoil) + + ! Maximum infiltrability based on the Eq. 6.25. (m/s) + InfilFacTmp = InfilCapillaryDynVic * (SoilMoistureSat(IndSoil) - SoilMoistureWilt(IndSoil)) * & + (-1.0) * DepthSoilLayer(IndSoil) + InfilSfcTmp = SoilWatConductivitySat(IndSoil) + (WeighFac*(SoilWatConductivitySat(IndSoil)-SoilWatConductivity) / & + (exp(WeighFac*1.0e-05/InfilFacTmp) - 1.0)) + + ! infiltration rate at surface + if ( SoilWatConductivitySat(IndSoil) < SoilSfcInflowMean ) then + InfilSfcTmp = min(SoilSfcInflowMean, InfilSfcTmp) + else + InfilSfcTmp = SoilSfcInflowMean + endif + if ( InfilSfcTmp < 0.0 ) InfilSfcTmp = SoilWatConductivity + + else + + ! estimate initial soil hydraulic conductivty (Ki in the equation) (m/s) + call SoilDiffusivityConductivityOpt2(noahmp, SoilWatDiffusivity, SoilWatConductivity, & + SoilMoisture(IndSoil), SoilIce(IndSoil), IndSoil) + + ! Maximum infiltrability based on the Eq. 6.25. (m/s) + InfilFacTmp = InfilCapillaryDynVic * max(0.0, (SoilMoistureSat(IndSoil) - SoilMoisture(IndSoil))) * & + (-1.0) * DepthSoilLayer(IndSoil) + if ( InfilFacTmp == 0.0 ) then ! infiltration at surface == saturated hydraulic conductivity + InfilSfcTmp = SoilWatConductivity + else + InfilSfcTmp = SoilWatConductivitySat(IndSoil) + (WeighFac*(SoilWatConductivitySat(IndSoil)-SoilWatConductivity) / & + (exp(WeighFac*InfilSfcAcc/InfilFacTmp) - 1.0)) + endif + + ! infiltration rate at surface + if ( SoilWatConductivitySat(IndSoil) < SoilSfcInflowMean ) then + InfilSfcTmp = min(SoilSfcInflowMean, InfilSfcTmp) + else + InfilSfcTmp = SoilSfcInflowMean + endif + + ! accumulated infiltration function + InfilSfcAcc = InfilSfcAcc + InfilSfcTmp + + endif + + end associate + + end subroutine SoilWaterInfilSmithParlange + +end module SoilWaterInfilSmithParlangeMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SoilWaterMainMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SoilWaterMainMod.F90 new file mode 100644 index 000000000..a03a983b7 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SoilWaterMainMod.F90 @@ -0,0 +1,270 @@ +module SoilWaterMainMod + +!!! Main soil water module including all soil water processes & update soil moisture +!!! surface runoff, infiltration, soil water diffusion, subsurface runoff, tile drainage + + use Machine + use NoahmpVarType + use ConstantDefineMod + use RunoffSurfaceTopModelGrdMod, only : RunoffSurfaceTopModelGrd + use RunoffSurfaceTopModelEquiMod, only : RunoffSurfaceTopModelEqui + use RunoffSurfaceFreeDrainMod, only : RunoffSurfaceFreeDrain + use RunoffSurfaceBatsMod, only : RunoffSurfaceBATS + use RunoffSurfaceTopModelMmfMod, only : RunoffSurfaceTopModelMMF + use RunoffSurfaceVicMod, only : RunoffSurfaceVIC + use RunoffSurfaceXinAnJiangMod, only : RunoffSurfaceXinAnJiang + use RunoffSurfaceDynamicVicMod, only : RunoffSurfaceDynamicVic + use RunoffSubSurfaceEquiWaterTableMod, only : RunoffSubSurfaceEquiWaterTable + use RunoffSubSurfaceGroundWaterMod, only : RunoffSubSurfaceGroundWater + use RunoffSubSurfaceDrainageMod, only : RunoffSubSurfaceDrainage + use RunoffSubSurfaceShallowMmfMod, only : RunoffSubSurfaceShallowWaterMMF + use SoilWaterDiffusionRichardsMod, only : SoilWaterDiffusionRichards + use SoilMoistureSolverMod, only : SoilMoistureSolver + use TileDrainageSimpleMod, only : TileDrainageSimple + use TileDrainageHooghoudtMod, only : TileDrainageHooghoudt + + implicit none + +contains + + subroutine SoilWaterMain(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: SOILWATER +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variables + integer :: LoopInd1, LoopInd2 ! loop index + integer :: IndIter ! iteration index + integer :: NumIterSoilWat ! iteration times soil moisture + real(kind=kind_noahmp) :: TimeStepFine ! fine time step [s] + real(kind=kind_noahmp) :: SoilSatExcAcc ! accumulation of soil saturation excess [m] + real(kind=kind_noahmp) :: SoilWatConductAcc ! sum of SoilWatConductivity*ThicknessSnowSoilLayer + real(kind=kind_noahmp) :: WaterRemove ! water mass removal [mm] + real(kind=kind_noahmp) :: SoilWatRem ! temporary remaining soil water [mm] + real(kind=kind_noahmp) :: SoilWaterMin ! minimum soil water [mm] + real(kind=kind_noahmp) :: DrainSoilBotAcc ! accumulated drainage water [mm] at fine time step + real(kind=kind_noahmp) :: RunoffSurfaceAcc ! accumulated surface runoff [mm] at fine time step + real(kind=kind_noahmp) :: InfilSfcAcc ! accumulated infiltration rate [m/s] + real(kind=kind_noahmp), parameter :: SoilImpPara = 4.0 ! soil impervious fraction parameter + real(kind=kind_noahmp), allocatable, dimension(:) :: MatRight ! right-hand side term of the matrix + real(kind=kind_noahmp), allocatable, dimension(:) :: MatLeft1 ! left-hand side term + real(kind=kind_noahmp), allocatable, dimension(:) :: MatLeft2 ! left-hand side term + real(kind=kind_noahmp), allocatable, dimension(:) :: MatLeft3 ! left-hand side term + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilLiqTmp ! temporary soil liquid water [mm] + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + SoilTimeStep => noahmp%config%domain%SoilTimeStep ,& ! in, noahmp soil time step [s] + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! in, thickness of snow/soil layers [m] + FlagUrban => noahmp%config%domain%FlagUrban ,& ! in, logical flag for urban grid + OptRunoffSurface => noahmp%config%nmlist%OptRunoffSurface ,& ! in, options for surface runoff + OptRunoffSubsurface => noahmp%config%nmlist%OptRunoffSubsurface ,& ! in, options for subsurface runoff + OptTileDrainage => noahmp%config%nmlist%OptTileDrainage ,& ! in, options for tile drainage + SoilIce => noahmp%water%state%SoilIce ,& ! in, soil ice content [m3/m3] + TileDrainFrac => noahmp%water%state%TileDrainFrac ,& ! in, tile drainage map (fraction) + SoilSfcInflowMean => noahmp%water%flux%SoilSfcInflowMean ,& ! in, mean water input on soil surface [m/s] + SoilMoistureSat => noahmp%water%param%SoilMoistureSat ,& ! in, saturated value of soil moisture [m3/m3] + SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! inout, soil water content [m3/m3] + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! inout, total soil water content [m3/m3] + RechargeGwDeepWT => noahmp%water%state%RechargeGwDeepWT ,& ! inout, recharge to or from the water table when deep [m] + DrainSoilBot => noahmp%water%flux%DrainSoilBot ,& ! out, soil bottom drainage [m/s] + RunoffSurface => noahmp%water%flux%RunoffSurface ,& ! out, surface runoff [mm per soil timestep] + RunoffSubsurface => noahmp%water%flux%RunoffSubsurface ,& ! out, subsurface runoff [mm per soil timestep] + InfilRateSfc => noahmp%water%flux%InfilRateSfc ,& ! out, infiltration rate at surface [m/s] + TileDrain => noahmp%water%flux%TileDrain ,& ! out, tile drainage [mm per soil timestep] + SoilImpervFracMax => noahmp%water%state%SoilImpervFracMax ,& ! out, maximum soil imperviousness fraction + SoilWatConductivity => noahmp%water%state%SoilWatConductivity ,& ! out, soil hydraulic conductivity [m/s] + SoilEffPorosity => noahmp%water%state%SoilEffPorosity ,& ! out, soil effective porosity [m3/m3] + SoilImpervFrac => noahmp%water%state%SoilImpervFrac ,& ! out, impervious fraction due to frozen soil + SoilIceFrac => noahmp%water%state%SoilIceFrac ,& ! out, ice fraction in frozen soil + SoilSaturationExcess => noahmp%water%state%SoilSaturationExcess ,& ! out, saturation excess of the total soil [m] + SoilIceMax => noahmp%water%state%SoilIceMax ,& ! out, maximum soil ice content [m3/m3] + SoilLiqWaterMin => noahmp%water%state%SoilLiqWaterMin & ! out, minimum soil liquid water content [m3/m3] + ) +! ---------------------------------------------------------------------- + + ! initialization + if (.not. allocated(MatRight) ) allocate(MatRight (1:NumSoilLayer)) + if (.not. allocated(MatLeft1) ) allocate(MatLeft1 (1:NumSoilLayer)) + if (.not. allocated(MatLeft2) ) allocate(MatLeft2 (1:NumSoilLayer)) + if (.not. allocated(MatLeft3) ) allocate(MatLeft3 (1:NumSoilLayer)) + if (.not. allocated(SoilLiqTmp)) allocate(SoilLiqTmp(1:NumSoilLayer)) + MatRight = 0.0 + MatLeft1 = 0.0 + MatLeft2 = 0.0 + MatLeft3 = 0.0 + SoilLiqTmp = 0.0 + RunoffSurface = 0.0 + RunoffSubsurface = 0.0 + InfilRateSfc = 0.0 + SoilSatExcAcc = 0.0 + InfilSfcAcc = 1.0e-06 + + ! for the case when snowmelt water is too large + do LoopInd1 = 1, NumSoilLayer + SoilEffPorosity(LoopInd1) = max(1.0e-4, (SoilMoistureSat(LoopInd1) - SoilIce(LoopInd1))) + SoilSatExcAcc = SoilSatExcAcc + max(0.0, SoilLiqWater(LoopInd1) - SoilEffPorosity(LoopInd1)) * & + ThicknessSnowSoilLayer(LoopInd1) + SoilLiqWater(LoopInd1) = min(SoilEffPorosity(LoopInd1), SoilLiqWater(LoopInd1)) + enddo + + ! impermeable fraction due to frozen soil + do LoopInd1 = 1, NumSoilLayer + SoilIceFrac(LoopInd1) = min(1.0, SoilIce(LoopInd1) / SoilMoistureSat(LoopInd1)) + SoilImpervFrac(LoopInd1) = max(0.0, exp(-SoilImpPara*(1.0-SoilIceFrac(LoopInd1))) - exp(-SoilImpPara)) / & + (1.0 - exp(-SoilImpPara)) + enddo + + ! maximum soil ice content and minimum liquid water of all layers + SoilIceMax = 0.0 + SoilImpervFracMax = 0.0 + SoilLiqWaterMin = SoilMoistureSat(1) + do LoopInd1 = 1, NumSoilLayer + if ( SoilIce(LoopInd1) > SoilIceMax ) SoilIceMax = SoilIce(LoopInd1) + if ( SoilImpervFrac(LoopInd1) > SoilImpervFracMax ) SoilImpervFracMax = SoilImpervFrac(LoopInd1) + if ( SoilLiqWater(LoopInd1) < SoilLiqWaterMin ) SoilLiqWaterMin = SoilLiqWater(LoopInd1) + enddo + + ! subsurface runoff for runoff scheme option 2 + if ( OptRunoffSubsurface == 2 ) call RunoffSubSurfaceEquiWaterTable(noahmp) + + ! jref impermable surface at urban + if ( FlagUrban .eqv. .true. ) SoilImpervFrac(1) = 0.95 + + ! surface runoff and infiltration rate using different schemes + if ( OptRunoffSurface == 1 ) call RunoffSurfaceTopModelGrd(noahmp) + if ( OptRunoffSurface == 2 ) call RunoffSurfaceTopModelEqui(noahmp) + if ( OptRunoffSurface == 3 ) call RunoffSurfaceFreeDrain(noahmp,SoilTimeStep) + if ( OptRunoffSurface == 4 ) call RunoffSurfaceBATS(noahmp) + if ( OptRunoffSurface == 5 ) call RunoffSurfaceTopModelMMF(noahmp) + if ( OptRunoffSurface == 6 ) call RunoffSurfaceVIC(noahmp,SoilTimeStep) + if ( OptRunoffSurface == 7 ) call RunoffSurfaceXinAnJiang(noahmp,SoilTimeStep) + if ( OptRunoffSurface == 8 ) call RunoffSurfaceDynamicVic(noahmp,SoilTimeStep,InfilSfcAcc) + + ! determine iteration times to solve soil water diffusion and moisture + NumIterSoilWat = 3 + if ( (InfilRateSfc*SoilTimeStep) > (ThicknessSnowSoilLayer(1)*SoilMoistureSat(1)) ) then + NumIterSoilWat = NumIterSoilWat*2 + endif + TimeStepFine = SoilTimeStep / NumIterSoilWat + + ! solve soil moisture + InfilSfcAcc = 1.0e-06 + DrainSoilBotAcc = 0.0 + RunoffSurfaceAcc = 0.0 + + do IndIter = 1, NumIterSoilWat + if ( SoilSfcInflowMean > 0.0 ) then + if ( OptRunoffSurface == 3 ) call RunoffSurfaceFreeDrain(noahmp,TimeStepFine) + if ( OptRunoffSurface == 6 ) call RunoffSurfaceVIC(noahmp,TimeStepFine) + if ( OptRunoffSurface == 7 ) call RunoffSurfaceXinAnJiang(noahmp,TimeStepFine) + if ( OptRunoffSurface == 8 ) call RunoffSurfaceDynamicVic(noahmp,TimeStepFine,InfilSfcAcc) + endif + call SoilWaterDiffusionRichards(noahmp, MatLeft1, MatLeft2, MatLeft3, MatRight) + call SoilMoistureSolver(noahmp, TimeStepFine, MatLeft1, MatLeft2, MatLeft3, MatRight) + SoilSatExcAcc = SoilSatExcAcc + SoilSaturationExcess + DrainSoilBotAcc = DrainSoilBotAcc + DrainSoilBot + RunoffSurfaceAcc = RunoffSurfaceAcc + RunoffSurface + enddo + + DrainSoilBot = DrainSoilBotAcc / NumIterSoilWat + RunoffSurface = RunoffSurfaceAcc / NumIterSoilWat + RunoffSurface = RunoffSurface * 1000.0 + SoilSatExcAcc * 1000.0 / SoilTimeStep ! m/s -> mm/s + DrainSoilBot = DrainSoilBot * 1000.0 ! m/s -> mm/s + + ! compute tile drainage ! pvk + if ( (OptTileDrainage == 1) .and. (TileDrainFrac > 0.3) .and. (OptRunoffSurface == 3) ) then + call TileDrainageSimple(noahmp) ! simple tile drainage + endif + if ( (OptTileDrainage == 2) .and. (TileDrainFrac > 0.1) .and. (OptRunoffSurface == 3) ) then + call TileDrainageHooghoudt(noahmp) ! Hooghoudt tile drain + END IF + + ! removal of soil water due to subsurface runoff (option 2) + if ( OptRunoffSubsurface == 2 ) then + SoilWatConductAcc = 0.0 + do LoopInd1 = 1, NumSoilLayer + SoilWatConductAcc = SoilWatConductAcc + SoilWatConductivity(LoopInd1) * ThicknessSnowSoilLayer(LoopInd1) + enddo + do LoopInd1 = 1, NumSoilLayer + WaterRemove = RunoffSubsurface * SoilTimeStep * & + (SoilWatConductivity(LoopInd1)*ThicknessSnowSoilLayer(LoopInd1)) / SoilWatConductAcc + SoilLiqWater(LoopInd1) = SoilLiqWater(LoopInd1) - WaterRemove / (ThicknessSnowSoilLayer(LoopInd1)*1000.0) + enddo + endif + + ! Limit SoilLiqTmp to be greater than or equal to watmin. + ! Get water needed to bring SoilLiqTmp equal SoilWaterMin from lower layer. + if ( OptRunoffSubsurface /= 1 ) then + do LoopInd2 = 1, NumSoilLayer + SoilLiqTmp(LoopInd2) = SoilLiqWater(LoopInd2) * ThicknessSnowSoilLayer(LoopInd2) * 1000.0 + enddo + + SoilWaterMin = 0.01 ! mm + do LoopInd2 = 1, NumSoilLayer-1 + if ( SoilLiqTmp(LoopInd2) < 0.0 ) then + SoilWatRem = SoilWaterMin - SoilLiqTmp(LoopInd2) + else + SoilWatRem = 0.0 + endif + SoilLiqTmp(LoopInd2 ) = SoilLiqTmp(LoopInd2 ) + SoilWatRem + SoilLiqTmp(LoopInd2+1) = SoilLiqTmp(LoopInd2+1) - SoilWatRem + enddo + LoopInd2 = NumSoilLayer + if ( SoilLiqTmp(LoopInd2) < SoilWaterMin ) then + SoilWatRem = SoilWaterMin - SoilLiqTmp(LoopInd2) + else + SoilWatRem = 0.0 + endif + SoilLiqTmp(LoopInd2) = SoilLiqTmp(LoopInd2) + SoilWatRem + RunoffSubsurface = RunoffSubsurface - SoilWatRem/SoilTimeStep + + if ( OptRunoffSubsurface == 5 ) RechargeGwDeepWT = RechargeGwDeepWT - SoilWatRem * 1.0e-3 + + do LoopInd2 = 1, NumSoilLayer + SoilLiqWater(LoopInd2) = SoilLiqTmp(LoopInd2) / (ThicknessSnowSoilLayer(LoopInd2)*1000.0) + enddo + endif ! OptRunoffSubsurface /= 1 + + ! compute groundwater and subsurface runoff + if ( OptRunoffSubsurface == 1 ) call RunoffSubSurfaceGroundWater(noahmp) + + ! compute subsurface runoff based on drainage rate + if ( (OptRunoffSubsurface == 3) .or. (OptRunoffSubsurface == 4) .or. (OptRunoffSubsurface == 6) .or. & + (OptRunoffSubsurface == 7) .or. (OptRunoffSubsurface == 8) ) then + call RunoffSubSurfaceDrainage(noahmp) + endif + + ! update soil moisture + do LoopInd2 = 1, NumSoilLayer + SoilMoisture(LoopInd2) = SoilLiqWater(LoopInd2) + SoilIce(LoopInd2) + enddo + + ! compute subsurface runoff and shallow water table for MMF scheme + if ( OptRunoffSubsurface == 5 ) call RunoffSubSurfaceShallowWaterMMF(noahmp) + + ! accumulated water flux over soil timestep [mm] + RunoffSurface = RunoffSurface * SoilTimeStep + RunoffSubsurface = RunoffSubsurface * SoilTimeStep + TileDrain = TileDrain * SoilTimeStep + + ! deallocate local arrays to avoid memory leaks + deallocate(MatRight ) + deallocate(MatLeft1 ) + deallocate(MatLeft2 ) + deallocate(MatLeft3 ) + deallocate(SoilLiqTmp) + + end associate + + end subroutine SoilWaterMain + +end module SoilWaterMainMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SoilWaterSupercoolKoren99Mod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SoilWaterSupercoolKoren99Mod.F90 new file mode 100644 index 000000000..49f3dedbb --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SoilWaterSupercoolKoren99Mod.F90 @@ -0,0 +1,127 @@ +module SoilWaterSupercoolKoren99Mod + +!!! Calculate amount of supercooled liquid soil water content if soil temperature < freezing point +!!! This uses Newton-type iteration to solve the nonlinear implicit equation +!!! Reference: Eqn.17 in Koren et al. 1999 JGR VOL 104(D16), 19569-19585 +!!! New version (June 2001): much faster and more accurate Newton iteration achieved by first +!!! taking log of Eqn above -- less than 4 (typically 1 or 2) iterations achieves convergence. +!!! Explicit 1-step solution option for special case of parameter CK=0, which reduces the +!!! original implicit equation to a simpler explicit form, known as "Flerchinger Eqn". Improved +!!! handling of solution in the limit of freezing point temperature. + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine SoilWaterSupercoolKoren99(noahmp, IndSoil, SoilWatSupercool, & + SoilTemperature, SoilMoisture, SoilLiqWater) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: FRH2O +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! in & out variables + type(noahmp_type) , intent(inout) :: noahmp + integer , intent(in ) :: IndSoil ! soil layer index + real(kind=kind_noahmp), intent(in ) :: SoilLiqWater ! soil liquid water content [m3/m3] + real(kind=kind_noahmp), intent(in ) :: SoilMoisture ! total soil moisture content [m3/m3] + real(kind=kind_noahmp), intent(in ) :: SoilTemperature ! soil temperature [K] + real(kind=kind_noahmp), intent(out ) :: SoilWatSupercool ! soil supercooled liquid water content [m3/m3] + +! local variable + integer :: NumIter ! number of iteration + integer :: IndCnt ! counting index + real(kind=kind_noahmp) :: SoilExpB ! temporary soil B parameter + real(kind=kind_noahmp) :: Denom ! temporary denominator variable + real(kind=kind_noahmp) :: DF ! temporary nominator variable + real(kind=kind_noahmp) :: SoilIceChg ! soil ice content change + real(kind=kind_noahmp) :: FlerFac ! factor in Flerchinger solution + real(kind=kind_noahmp) :: SoilIce ! soil ice content + real(kind=kind_noahmp) :: SoilIceTmp ! temporary soil ice content + real(kind=kind_noahmp), parameter :: CK = 8.0 ! parameter + real(kind=kind_noahmp), parameter :: SoilExpBMax = 5.5 ! limit of B soil parameter + real(kind=kind_noahmp), parameter :: ErrorThr = 0.005 ! error threshold + +! -------------------------------------------------------------------- + associate( & + SoilExpCoeffB => noahmp%water%param%SoilExpCoeffB ,& ! in, soil B parameter + SoilMatPotentialSat => noahmp%water%param%SoilMatPotentialSat ,& ! in, saturated soil matric potential [m] + SoilMoistureSat => noahmp%water%param%SoilMoistureSat & ! in, saturated value of soil moisture [m3/m3] + ) +! ---------------------------------------------------------------------- + + ! limit on parameter B: B < 5.5 (use parameter SoilExpBMax) + ! simulations showed if B > 5.5 unfrozen water content is + ! non-realistically high at very low temperatures + SoilExpB = SoilExpCoeffB(IndSoil) + + ! initializing iterations counter and interative solution flag + if ( SoilExpCoeffB(IndSoil) > SoilExpBMax ) SoilExpB = SoilExpBMax + NumIter = 0 + + ! if soil temperature not largely below freezing point, SoilLiqWater = SoilMoisture + IndCnt = 0 + if ( SoilTemperature > (ConstFreezePoint-1.0e-3) ) then + SoilWatSupercool = SoilMoisture + else ! frozen soil case + + !--- Option 1: iterated solution in Koren et al. 1999 JGR Eqn.17 + ! initial guess for SoilIce (frozen content) + if ( CK /= 0.0 ) then + SoilIce = SoilMoisture - SoilLiqWater + if ( SoilIce > (SoilMoisture-0.02) ) SoilIce = SoilMoisture - 0.02 ! keep within bounds + ! start the iterations + if ( SoilIce < 0.0 ) SoilIce = 0.0 +1001 Continue + if ( .not. ((NumIter < 10) .and. (IndCnt == 0)) ) goto 1002 + NumIter = NumIter +1 + DF = alog((SoilMatPotentialSat(IndSoil)*ConstGravityAcc/ConstLatHeatFusion) * & + ((1.0 + CK*SoilIce)**2.0) * (SoilMoistureSat(IndSoil)/(SoilMoisture - SoilIce))**SoilExpB) - & + alog(-(SoilTemperature - ConstFreezePoint) / SoilTemperature) + Denom = 2.0 * CK / (1.0 + CK * SoilIce) + SoilExpB / (SoilMoisture - SoilIce) + SoilIceTmp = SoilIce - DF / Denom + ! bounds useful for mathematical solution + if ( SoilIceTmp > (SoilMoisture-0.02) ) SoilIceTmp = SoilMoisture - 0.02 + if ( SoilIceTmp < 0.0 ) SoilIceTmp = 0.0 + SoilIceChg = abs(SoilIceTmp - SoilIce) ! mathematical solution bounds applied + ! if more than 10 iterations, use explicit method (CK=0 approx.) + ! when SoilIceChg <= ErrorThr, no more interations required. + SoilIce = SoilIceTmp + if ( SoilIceChg <= ErrorThr ) then + IndCnt = IndCnt +1 + endif + ! end of iteration + ! bounds applied within do-block are valid for physical solution + goto 1001 +1002 continue + SoilWatSupercool = SoilMoisture - SoilIce + endif + !--- End Option 1 + + !--- Option 2: explicit solution for Flerchinger Eq. i.e., CK=0 + ! in Koren et al. 1999 JGR Eqn. 17 + ! apply physical bounds to Flerchinger solution + if ( IndCnt == 0 ) then + print*, 'Flerchinger used in NEW version. Iterations=', NumIter + FlerFac = (((ConstLatHeatFusion / (ConstGravityAcc * (-SoilMatPotentialSat(IndSoil)))) * & + ((SoilTemperature-ConstFreezePoint) / SoilTemperature))**(-1.0/SoilExpB)) * SoilMoistureSat(IndSoil) + if ( FlerFac < 0.02 ) FlerFac = 0.02 + SoilWatSupercool = min(FlerFac, SoilMoisture) + endif + !--- End Option 2 + + endif + + end associate + + end subroutine SoilWaterSupercoolKoren99 + +end module SoilWaterSupercoolKoren99Mod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SoilWaterSupercoolNiu06Mod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SoilWaterSupercoolNiu06Mod.F90 new file mode 100644 index 000000000..770d97916 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SoilWaterSupercoolNiu06Mod.F90 @@ -0,0 +1,48 @@ +module SoilWaterSupercoolNiu06Mod + +!!! Calculate amount of supercooled liquid soil water content if soil temperature < freezing point +!!! This solution does not use iteration (Niu and Yang, 2006 JHM). + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine SoilWaterSupercoolNiu06(noahmp, IndSoil, SoilWatSupercool, SoilTemperature) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: embedded in PHASECHANGE +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! in & out variables + type(noahmp_type) , intent(inout) :: noahmp + integer , intent(in ) :: IndSoil ! soil layer index + real(kind=kind_noahmp), intent(in ) :: SoilTemperature ! soil temperature [K] + real(kind=kind_noahmp), intent(out ) :: SoilWatSupercool ! soil supercooled liquid water content [m3/m3] + +! local variable + real(kind=kind_noahmp) :: SoilWatPotFrz ! frozen water potential [mm] + +! ----------------------------------------------------------------------------- + associate( & + SoilExpCoeffB => noahmp%water%param%SoilExpCoeffB ,& ! in, soil B parameter + SoilMatPotentialSat => noahmp%water%param%SoilMatPotentialSat ,& ! in, saturated soil matric potential [m] + SoilMoistureSat => noahmp%water%param%SoilMoistureSat & ! in, saturated value of soil moisture [m3/m3] + ) +! ----------------------------------------------------------------------------- + + SoilWatPotFrz = ConstLatHeatFusion * (ConstFreezePoint - SoilTemperature) / (ConstGravityAcc * SoilTemperature) + SoilWatSupercool = SoilMoistureSat(IndSoil) * (SoilWatPotFrz / SoilMatPotentialSat(IndSoil))**(-1.0/SoilExpCoeffB(IndSoil)) + + end associate + + end subroutine SoilWaterSupercoolNiu06 + +end module SoilWaterSupercoolNiu06Mod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SoilWaterTranspirationMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SoilWaterTranspirationMod.F90 new file mode 100644 index 000000000..d5ef583af --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SoilWaterTranspirationMod.F90 @@ -0,0 +1,91 @@ +module SoilWaterTranspirationMod + +!!! compute soil water transpiration factor that will be used for +!!! stomata resistance and evapotranspiration calculations + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine SoilWaterTranspiration(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: None (embedded in ENERGY subroutine) +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + +! in & out variables + type(noahmp_type), intent(inout) :: noahmp + +! local variables + integer :: IndSoil ! loop index + real(kind=kind_noahmp) :: SoilWetFac ! temporary variable + real(kind=kind_noahmp) :: MinThr ! minimum threshold to prevent divided by zero + +! -------------------------------------------------------------------- + associate( & + SurfaceType => noahmp%config%domain%SurfaceType ,& ! in, surface type 1-soil; 2-lake + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! in, thickness of snow/soil layers [m] + DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth [m] of layer-bottom from soil surface + OptSoilWaterTranspiration => noahmp%config%nmlist%OptSoilWaterTranspiration ,& ! in, option for soil moisture factor for stomatal resistance & ET + NumSoilLayerRoot => noahmp%water%param%NumSoilLayerRoot ,& ! in, number of soil layers with root present + SoilMoistureWilt => noahmp%water%param%SoilMoistureWilt ,& ! in, wilting point soil moisture [m3/m3] + SoilMoistureFieldCap => noahmp%water%param%SoilMoistureFieldCap ,& ! in, reference soil moisture (field capacity) [m3/m3] + SoilMatPotentialWilt => noahmp%water%param%SoilMatPotentialWilt ,& ! in, soil metric potential for wilting point [m] + SoilMatPotentialSat => noahmp%water%param%SoilMatPotentialSat ,& ! in, saturated soil matric potential [m] + SoilMoistureSat => noahmp%water%param%SoilMoistureSat ,& ! in, saturated value of soil moisture [m3/m3] + SoilExpCoeffB => noahmp%water%param%SoilExpCoeffB ,& ! in, soil B parameter + SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! in, soil water content [m3/m3] + SoilTranspFac => noahmp%water%state%SoilTranspFac ,& ! out, soil water transpiration factor (0 to 1) + SoilTranspFacAcc => noahmp%water%state%SoilTranspFacAcc ,& ! out, accumulated soil water transpiration factor (0 to 1) + SoilMatPotential => noahmp%water%state%SoilMatPotential & ! out, soil matrix potential [m] + ) +! ---------------------------------------------------------------------- + + ! soil moisture factor controlling stomatal resistance and evapotranspiration + MinThr = 1.0e-6 + SoilTranspFacAcc = 0.0 + + ! only for soil point + if ( SurfaceType ==1 ) then + do IndSoil = 1, NumSoilLayerRoot + if ( OptSoilWaterTranspiration == 1 ) then ! Noah + SoilWetFac = (SoilLiqWater(IndSoil) - SoilMoistureWilt(IndSoil)) / & + (SoilMoistureFieldCap(IndSoil) - SoilMoistureWilt(IndSoil)) + endif + if ( OptSoilWaterTranspiration == 2 ) then ! CLM + SoilMatPotential(IndSoil) = max(SoilMatPotentialWilt, -SoilMatPotentialSat(IndSoil) * & + (max(0.01,SoilLiqWater(IndSoil))/SoilMoistureSat(IndSoil)) ** & + (-SoilExpCoeffB(IndSoil))) + SoilWetFac = (1.0 - SoilMatPotential(IndSoil)/SoilMatPotentialWilt) / & + (1.0 + SoilMatPotentialSat(IndSoil)/SoilMatPotentialWilt) + endif + if ( OptSoilWaterTranspiration == 3 ) then ! SSiB + SoilMatPotential(IndSoil) = max(SoilMatPotentialWilt, -SoilMatPotentialSat(IndSoil) * & + (max(0.01,SoilLiqWater(IndSoil))/SoilMoistureSat(IndSoil)) ** & + (-SoilExpCoeffB(IndSoil))) + SoilWetFac = 1.0 - exp(-5.8*(log(SoilMatPotentialWilt/SoilMatPotential(IndSoil)))) + endif + SoilWetFac = min(1.0, max(0.0,SoilWetFac)) + + SoilTranspFac(IndSoil) = max(MinThr, ThicknessSnowSoilLayer(IndSoil) / & + (-DepthSoilLayer(NumSoilLayerRoot)) * SoilWetFac) + SoilTranspFacAcc = SoilTranspFacAcc + SoilTranspFac(IndSoil) + enddo + + SoilTranspFacAcc = max(MinThr, SoilTranspFacAcc) + SoilTranspFac(1:NumSoilLayerRoot) = SoilTranspFac(1:NumSoilLayerRoot) / SoilTranspFacAcc + endif + + end associate + + end subroutine SoilWaterTranspiration + +end module SoilWaterTranspirationMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SurfaceAlbedoGlacierMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SurfaceAlbedoGlacierMod.F90 new file mode 100644 index 000000000..515a22357 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SurfaceAlbedoGlacierMod.F90 @@ -0,0 +1,79 @@ +module SurfaceAlbedoGlacierMod + +!!! Compute glacier surface albedo + + use Machine + use NoahmpVarType + use ConstantDefineMod + use SnowAgingBatsMod, only : SnowAgingBats + use SnowAlbedoBatsMod, only : SnowAlbedoBats + use SnowAlbedoClassMod, only : SnowAlbedoClass + use GroundAlbedoGlacierMod, only : GroundAlbedoGlacier + + implicit none + +contains + + subroutine SurfaceAlbedoGlacier(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: RADIATION_GLACIER +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: IndBand ! solar band index + +! -------------------------------------------------------------------- + associate( & + NumSwRadBand => noahmp%config%domain%NumSwRadBand ,& ! in, number of solar radiation wave bands + CosSolarZenithAngle => noahmp%config%domain%CosSolarZenithAngle ,& ! in, cosine solar zenith angle + OptSnowAlbedo => noahmp%config%nmlist%OptSnowAlbedo ,& ! in, options for ground snow surface albedo + AlbedoGrdDir => noahmp%energy%state%AlbedoGrdDir ,& ! out, ground albedo (direct beam: vis, nir) + AlbedoGrdDif => noahmp%energy%state%AlbedoGrdDif ,& ! out, ground albedo (diffuse: vis, nir) + AlbedoSnowDir => noahmp%energy%state%AlbedoSnowDir ,& ! out, snow albedo for direct(1=vis, 2=nir) + AlbedoSnowDif => noahmp%energy%state%AlbedoSnowDif ,& ! out, snow albedo for diffuse(1=vis, 2=nir) + AlbedoSfcDir => noahmp%energy%state%AlbedoSfcDir ,& ! out, surface albedo (direct) + AlbedoSfcDif => noahmp%energy%state%AlbedoSfcDif & ! out, surface albedo (diffuse) + ) +! ---------------------------------------------------------------------- + + ! initialization + do IndBand = 1, NumSwRadBand + AlbedoSfcDir (IndBand) = 0.0 + AlbedoSfcDif (IndBand) = 0.0 + AlbedoGrdDir (IndBand) = 0.0 + AlbedoGrdDif (IndBand) = 0.0 + AlbedoSnowDir(IndBand) = 0.0 + AlbedoSnowDif(IndBand) = 0.0 + enddo + + ! solar radiation process is only done if there is light + if ( CosSolarZenithAngle > 0 ) then + + ! snow aging + call SnowAgingBats(noahmp) + + ! snow albedo + if ( OptSnowAlbedo == 1 ) call SnowAlbedoBats(noahmp) + if ( OptSnowAlbedo == 2 ) call SnowAlbedoClass(noahmp) + + ! ground albedo + call GroundAlbedoGlacier(noahmp) + + ! surface albedo + AlbedoSfcDir = AlbedoGrdDir + AlbedoSfcDif = AlbedoGrdDif + + endif ! CosSolarZenithAngle > 0 + + end associate + + end subroutine SurfaceAlbedoGlacier + +end module SurfaceAlbedoGlacierMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SurfaceAlbedoMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SurfaceAlbedoMod.F90 new file mode 100644 index 000000000..d8e4bf109 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SurfaceAlbedoMod.F90 @@ -0,0 +1,159 @@ +module SurfaceAlbedoMod + +!!! Compute total surface albedo and vegetation radiative fluxes +!!! per unit incoming direct and diffuse radiation and sunlit fraction of canopy + + use Machine + use NoahmpVarType + use ConstantDefineMod + use SnowAgingBatsMod, only : SnowAgingBats + use SnowAlbedoBatsMod, only : SnowAlbedoBats + use SnowAlbedoClassMod, only : SnowAlbedoClass + use GroundAlbedoMod, only : GroundAlbedo + use CanopyRadiationTwoStreamMod, only : CanopyRadiationTwoStream + + implicit none + +contains + + subroutine SurfaceAlbedo(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: ALBEDO +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: IndBand ! waveband indices + integer :: IndDif ! direct beam: IndDif=0; diffuse: IndDif=1 + real(kind=kind_noahmp) :: LeafWgt ! fraction of LeafAreaIndex+StemAreaIndex that is LeafAreaIndex + real(kind=kind_noahmp) :: StemWgt ! fraction of LeafAreaIndex+StemAreaIndex that is StemAreaIndex + real(kind=kind_noahmp) :: MinThr ! prevents overflow for division by zero + real(kind=kind_noahmp) :: LightExtDir ! optical depth direct beam per unit leaf + stem area + +! -------------------------------------------------------------------- + associate( & + NumSwRadBand => noahmp%config%domain%NumSwRadBand ,& ! in, number of solar radiation wave bands + CosSolarZenithAngle => noahmp%config%domain%CosSolarZenithAngle ,& ! in, cosine solar zenith angle + OptSnowAlbedo => noahmp%config%nmlist%OptSnowAlbedo ,& ! in, options for ground snow surface albedo + ReflectanceLeaf => noahmp%energy%param%ReflectanceLeaf ,& ! in, leaf reflectance: 1=vis, 2=nir + ReflectanceStem => noahmp%energy%param%ReflectanceStem ,& ! in, stem reflectance: 1=vis, 2=nir + TransmittanceLeaf => noahmp%energy%param%TransmittanceLeaf ,& ! in, leaf transmittance: 1=vis, 2=nir + TransmittanceStem => noahmp%energy%param%TransmittanceStem ,& ! in, stem transmittance: 1=vis, 2=nir + LeafAreaIndEff => noahmp%energy%state%LeafAreaIndEff ,& ! in, leaf area index, after burying by snow + StemAreaIndEff => noahmp%energy%state%StemAreaIndEff ,& ! in, stem area index, after burying by snow + AlbedoGrdDir => noahmp%energy%state%AlbedoGrdDir ,& ! out, ground albedo (direct beam: vis, nir) + AlbedoGrdDif => noahmp%energy%state%AlbedoGrdDif ,& ! out, ground albedo (diffuse: vis, nir) + AlbedoSnowDir => noahmp%energy%state%AlbedoSnowDir ,& ! out, snow albedo for direct(1=vis, 2=nir) + AlbedoSnowDif => noahmp%energy%state%AlbedoSnowDif ,& ! out, snow albedo for diffuse(1=vis, 2=nir) + AlbedoSfcDir => noahmp%energy%state%AlbedoSfcDir ,& ! out, surface albedo (direct) + AlbedoSfcDif => noahmp%energy%state%AlbedoSfcDif ,& ! out, surface albedo (diffuse) + CanopySunlitFrac => noahmp%energy%state%CanopySunlitFrac ,& ! out, sunlit fraction of canopy + CanopyShadeFrac => noahmp%energy%state%CanopyShadeFrac ,& ! out, shaded fraction of canopy + LeafAreaIndSunlit => noahmp%energy%state%LeafAreaIndSunlit ,& ! out, sunlit leaf area + LeafAreaIndShade => noahmp%energy%state%LeafAreaIndShade ,& ! out, shaded leaf area + GapBtwCanopy => noahmp%energy%state%GapBtwCanopy ,& ! out, between canopy gap fraction for beam + GapInCanopy => noahmp%energy%state%GapInCanopy ,& ! out, within canopy gap fraction for beam + ReflectanceVeg => noahmp%energy%state%ReflectanceVeg ,& ! out, leaf/stem reflectance weighted by fraction LAI and SAI + TransmittanceVeg => noahmp%energy%state%TransmittanceVeg ,& ! out, leaf/stem transmittance weighted by fraction LAI and SAI + VegAreaIndEff => noahmp%energy%state%VegAreaIndEff ,& ! out, one-sided leaf+stem area index [m2/m2] + VegAreaProjDir => noahmp%energy%state%VegAreaProjDir ,& ! out, projected leaf+stem area in solar direction + RadSwAbsVegDir => noahmp%energy%flux%RadSwAbsVegDir ,& ! out, flux abs by veg (per unit direct flux) + RadSwAbsVegDif => noahmp%energy%flux%RadSwAbsVegDif ,& ! out, flux abs by veg (per unit diffuse flux) + RadSwDirTranGrdDir => noahmp%energy%flux%RadSwDirTranGrdDir ,& ! out, down direct flux below veg (per unit dir flux) + RadSwDifTranGrdDir => noahmp%energy%flux%RadSwDifTranGrdDir ,& ! out, down diffuse flux below veg (per unit dir flux) + RadSwDifTranGrdDif => noahmp%energy%flux%RadSwDifTranGrdDif ,& ! out, down diffuse flux below veg (per unit dif flux) + RadSwDirTranGrdDif => noahmp%energy%flux%RadSwDirTranGrdDif ,& ! out, down direct flux below veg per unit dif flux (= 0) + RadSwReflVegDir => noahmp%energy%flux%RadSwReflVegDir ,& ! out, flux reflected by veg layer (per unit direct flux) + RadSwReflVegDif => noahmp%energy%flux%RadSwReflVegDif ,& ! out, flux reflected by veg layer (per unit diffuse flux) + RadSwReflGrdDir => noahmp%energy%flux%RadSwReflGrdDir ,& ! out, flux reflected by ground (per unit direct flux) + RadSwReflGrdDif => noahmp%energy%flux%RadSwReflGrdDif & ! out, flux reflected by ground (per unit diffuse flux) + ) +! ---------------------------------------------------------------------- + + ! initialization + MinThr = 1.0e-06 + GapBtwCanopy = 0.0 + GapInCanopy = 0.0 + VegAreaProjDir = 0.0 + ReflectanceVeg = 0.0 + TransmittanceVeg = 0.0 + CanopySunlitFrac = 0.0 + do IndBand = 1, NumSwRadBand + AlbedoSfcDir (IndBand) = 0.0 + AlbedoSfcDif (IndBand) = 0.0 + AlbedoGrdDir (IndBand) = 0.0 + AlbedoGrdDif (IndBand) = 0.0 + AlbedoSnowDir (IndBand) = 0.0 + AlbedoSnowDif (IndBand) = 0.0 + RadSwAbsVegDir (IndBand) = 0.0 + RadSwAbsVegDif (IndBand) = 0.0 + RadSwDirTranGrdDir(IndBand) = 0.0 + RadSwDirTranGrdDif(IndBand) = 0.0 + RadSwDifTranGrdDir(IndBand) = 0.0 + RadSwDifTranGrdDif(IndBand) = 0.0 + RadSwReflVegDir (IndBand) = 0.0 + RadSwReflVegDif (IndBand) = 0.0 + RadSwReflGrdDir (IndBand) = 0.0 + RadSwReflGrdDif (IndBand) = 0.0 + enddo + VegAreaIndEff = LeafAreaIndEff + StemAreaIndEff + + ! solar radiation process is only done if there is light + if ( CosSolarZenithAngle > 0 ) then + + ! weight reflectance/transmittance by LeafAreaIndex and StemAreaIndex + LeafWgt = LeafAreaIndEff / max(VegAreaIndEff, MinThr) + StemWgt = StemAreaIndEff / max(VegAreaIndEff, MinThr) + do IndBand = 1, NumSwRadBand + ReflectanceVeg(IndBand) = max(ReflectanceLeaf(IndBand)*LeafWgt+ReflectanceStem(IndBand)*StemWgt, MinThr) + TransmittanceVeg(IndBand) = max(TransmittanceLeaf(IndBand)*LeafWgt+TransmittanceStem(IndBand)*StemWgt, MinThr) + enddo + + ! snow aging + call SnowAgingBats(noahmp) + + ! snow albedos + if ( OptSnowAlbedo == 1 ) call SnowAlbedoBats(noahmp) + if ( OptSnowAlbedo == 2 ) call SnowAlbedoClass(noahmp) + + ! ground surface albedo + call GroundAlbedo(noahmp) + + ! loop over shortwave bands to calculate surface albedos and solar + ! fluxes for unit incoming direct (IndDif=0) and diffuse flux (IndDif=1) + do IndBand = 1, NumSwRadBand + IndDif = 0 ! direct + call CanopyRadiationTwoStream(noahmp, IndBand, IndDif) + IndDif = 1 ! diffuse + call CanopyRadiationTwoStream(noahmp, IndBand, IndDif) + enddo + + ! sunlit fraction of canopy. set CanopySunlitFrac = 0 if CanopySunlitFrac < 0.01. + LightExtDir = VegAreaProjDir / CosSolarZenithAngle * sqrt(1.0-ReflectanceVeg(1)-TransmittanceVeg(1)) + CanopySunlitFrac = (1.0 - exp(-LightExtDir*VegAreaIndEff)) / max(LightExtDir*VegAreaIndEff, MinThr) + LightExtDir = CanopySunlitFrac + if ( LightExtDir < 0.01 ) then + LeafWgt = 0.0 + else + LeafWgt = LightExtDir + endif + CanopySunlitFrac = LeafWgt + + endif ! CosSolarZenithAngle > 0 + + ! shaded canopy fraction + CanopyShadeFrac = 1.0 - CanopySunlitFrac + LeafAreaIndSunlit = LeafAreaIndEff * CanopySunlitFrac + LeafAreaIndShade = LeafAreaIndEff * CanopyShadeFrac + + end associate + + end subroutine SurfaceAlbedo + +end module SurfaceAlbedoMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SurfaceEmissivityGlacierMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SurfaceEmissivityGlacierMod.F90 new file mode 100644 index 000000000..374f99950 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SurfaceEmissivityGlacierMod.F90 @@ -0,0 +1,46 @@ +module SurfaceEmissivityGlacierMod + +!!! Compute glacier surface longwave emissivity + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine SurfaceEmissivityGlacier(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: None (embedded in ENERGY_GLACIER subroutine) +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + +! in & out variables + type(noahmp_type), intent(inout) :: noahmp + +! -------------------------------------------------------------------- + associate( & + EmissivitySnow => noahmp%energy%param%EmissivitySnow ,& ! in, snow emissivity + EmissivityIceSfc => noahmp%energy%param%EmissivityIceSfc ,& ! in, emissivity ice surface + SnowCoverFrac => noahmp%water%state%SnowCoverFrac ,& ! in, snow cover fraction + EmissivityGrd => noahmp%energy%state%EmissivityGrd ,& ! out, ground emissivity + EmissivitySfc => noahmp%energy%state%EmissivitySfc & ! out, surface emissivity + ) +! ---------------------------------------------------------------------- + + ! ground emissivity + EmissivityGrd = EmissivityIceSfc * (1.0 - SnowCoverFrac) + EmissivitySnow * SnowCoverFrac + + ! surface emissivity + EmissivitySfc = EmissivityGrd + + end associate + + end subroutine SurfaceEmissivityGlacier + +end module SurfaceEmissivityGlacierMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SurfaceEmissivityMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SurfaceEmissivityMod.F90 new file mode 100644 index 000000000..1701a760b --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SurfaceEmissivityMod.F90 @@ -0,0 +1,61 @@ +module SurfaceEmissivityMod + +!!! Compute ground, vegetation, and total surface longwave emissivity + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine SurfaceEmissivity(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: None (embedded in ENERGY subroutine) +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + +! in & out variables + type(noahmp_type), intent(inout) :: noahmp + +! -------------------------------------------------------------------- + associate( & + IndicatorIceSfc => noahmp%config%domain%IndicatorIceSfc ,& ! in, indicator for ice point: 1->seaice; -1->land ice; 0->soil + SurfaceType => noahmp%config%domain%SurfaceType ,& ! in, surface type 1-soil; 2-lake + EmissivitySnow => noahmp%energy%param%EmissivitySnow ,& ! in, snow emissivity + EmissivitySoilLake => noahmp%energy%param%EmissivitySoilLake ,& ! in, emissivity soil surface + EmissivityIceSfc => noahmp%energy%param%EmissivityIceSfc ,& ! in, emissivity ice surface + SnowCoverFrac => noahmp%water%state%SnowCoverFrac ,& ! in, snow cover fraction + LeafAreaIndEff => noahmp%energy%state%LeafAreaIndEff ,& ! in, leaf area index, after burying by snow + StemAreaIndEff => noahmp%energy%state%StemAreaIndEff ,& ! in, stem area index, after burying by snow + VegFrac => noahmp%energy%state%VegFrac ,& ! in, greeness vegetation fraction + EmissivityVeg => noahmp%energy%state%EmissivityVeg ,& ! out, vegetation emissivity + EmissivityGrd => noahmp%energy%state%EmissivityGrd ,& ! out, ground emissivity + EmissivitySfc => noahmp%energy%state%EmissivitySfc & ! out, surface emissivity + ) +! ---------------------------------------------------------------------- + + ! vegetation emissivity + EmissivityVeg = 1.0 - exp(-(LeafAreaIndEff + StemAreaIndEff) / 1.0) + + ! ground emissivity + if ( IndicatorIceSfc == 1 ) then + EmissivityGrd = EmissivityIceSfc * (1.0-SnowCoverFrac) + EmissivitySnow * SnowCoverFrac + else + EmissivityGrd = EmissivitySoilLake(SurfaceType) * (1.0-SnowCoverFrac) + EmissivitySnow * SnowCoverFrac + endif + + ! net surface emissivity + EmissivitySfc = VegFrac * (EmissivityGrd*(1-EmissivityVeg) + EmissivityVeg + & + EmissivityVeg*(1-EmissivityVeg)*(1-EmissivityGrd)) + (1-VegFrac) * EmissivityGrd + + end associate + + end subroutine SurfaceEmissivity + +end module SurfaceEmissivityMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SurfaceEnergyFluxBareGroundMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SurfaceEnergyFluxBareGroundMod.F90 new file mode 100644 index 000000000..795af0443 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SurfaceEnergyFluxBareGroundMod.F90 @@ -0,0 +1,227 @@ +module SurfaceEnergyFluxBareGroundMod + +!!! Compute surface energy fluxes and budget for bare ground +!!! Use newton-raphson iteration to solve for ground temperatures +!!! Surface energy balance (bare soil): +!!! Ground level: -RadSwAbsGrd - HeatPrecipAdvBareGrd + RadLwNetBareGrd + HeatSensibleBareGrd + HeatLatentBareGrd + HeatGroundBareGrd = 0 + + use Machine + use NoahmpVarType + use ConstantDefineMod + use VaporPressureSaturationMod, only : VaporPressureSaturation + use ResistanceBareGroundMostMod, only : ResistanceBareGroundMOST + use ResistanceBareGroundChen97Mod, only : ResistanceBareGroundChen97 + + implicit none + +contains + + subroutine SurfaceEnergyFluxBareGround(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: BARE_FLUX +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type) , intent(inout) :: noahmp + +! local variable + integer :: IndIter ! iteration index + integer :: MoStabParaSgn ! number of times MoStabParaBare changes sign + integer, parameter :: NumIter = 5 ! number of iterations for surface temperature + real(kind=kind_noahmp) :: TemperatureGrdChg ! change in ground temperature, last iteration [K] + real(kind=kind_noahmp) :: LwRadCoeff ! coefficients for LW radiation as function of ts**4 + real(kind=kind_noahmp) :: ShCoeff ! coefficients for sensible heat as function of ts + real(kind=kind_noahmp) :: LhCoeff ! coefficients for latent heat as function of ts + real(kind=kind_noahmp) :: GrdHeatCoeff ! coefficients for ground heat as function of ts + real(kind=kind_noahmp) :: ExchCoeffShTmp ! temporary sensible heat exchange coefficient [m/s] + real(kind=kind_noahmp) :: ExchCoeffMomTmp ! temporary momentum heat exchange coefficient [m/s] + real(kind=kind_noahmp) :: MoistureFluxSfc ! moisture flux + real(kind=kind_noahmp) :: VapPresSatWatTmp ! saturated vapor pressure for water [Pa] + real(kind=kind_noahmp) :: VapPresSatIceTmp ! saturated vapor pressure for ice [Pa] + real(kind=kind_noahmp) :: VapPresSatWatTmpD ! saturated vapor pressure gradient with ground temp. [Pa/K] for water + real(kind=kind_noahmp) :: VapPresSatIceTmpD ! saturated vapor pressure gradient with ground temp. [Pa/K] for ice + real(kind=kind_noahmp) :: FluxTotCoeff ! temporary total coefficients for all energy flux + real(kind=kind_noahmp) :: EnergyResTmp ! temporary energy residual + real(kind=kind_noahmp) :: HeatSensibleTmp ! temporary sensible heat flux [W/m2] + real(kind=kind_noahmp) :: TempTmp ! temporary temperature + real(kind=kind_noahmp) :: TempUnitConv ! Kelvin to degree Celsius with limit -50 to +50 +! local statement function + TempUnitConv(TempTmp) = min(50.0, max(-50.0, (TempTmp-ConstFreezePoint))) + +! -------------------------------------------------------------------- + associate( & + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! in, actual number of snow layers (negative) + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! in, thickness of snow/soil layers [m] + FlagUrban => noahmp%config%domain%FlagUrban ,& ! in, logical flag for urban grid + OptSurfaceDrag => noahmp%config%nmlist%OptSurfaceDrag ,& ! in, options for surface layer drag/exchange coefficient + OptSnowSoilTempTime => noahmp%config%nmlist%OptSnowSoilTempTime ,& ! in, options for snow/soil temperature time scheme (only layer 1) + RadLwDownRefHeight => noahmp%forcing%RadLwDownRefHeight ,& ! in, downward longwave radiation [W/m2] at reference height + WindEastwardRefHeight => noahmp%forcing%WindEastwardRefHeight ,& ! in, wind speed [m/s] in eastward direction at reference height + WindNorthwardRefHeight => noahmp%forcing%WindNorthwardRefHeight ,& ! in, wind speed [m/s] in northward direction at reference height + TemperatureAirRefHeight => noahmp%forcing%TemperatureAirRefHeight ,& ! in, air temperature [K] at reference height + PressureAirRefHeight => noahmp%forcing%PressureAirRefHeight ,& ! in, air pressure [Pa] at surface reference height + ZilitinkevichCoeff => noahmp%energy%param%ZilitinkevichCoeff ,& ! in, Zilitinkevich Coefficient for exchange coefficient calculation + SnowDepth => noahmp%water%state%SnowDepth ,& ! in, snow depth [m] + SnowCoverFrac => noahmp%water%state%SnowCoverFrac ,& ! in, snow cover fraction + RadSwAbsGrd => noahmp%energy%flux%RadSwAbsGrd ,& ! in, solar radiation absorbed by ground [W/m2] + HeatPrecipAdvBareGrd => noahmp%energy%flux%HeatPrecipAdvBareGrd ,& ! in, precipitation advected heat - bare ground net [W/m2] + WindSpdRefHeight => noahmp%energy%state%WindSpdRefHeight ,& ! in, wind speed [m/s] at reference height + PressureVaporRefHeight => noahmp%energy%state%PressureVaporRefHeight ,& ! in, vapor pressure air [Pa] at reference height + SpecHumidityRefHeight => noahmp%forcing%SpecHumidityRefHeight ,& ! in, specific humidity [kg/kg] at reference height + DensityAirRefHeight => noahmp%energy%state%DensityAirRefHeight ,& ! in, density air [kg/m3] + RelHumidityGrd => noahmp%energy%state%RelHumidityGrd ,& ! in, raltive humidity in surface soil/snow air space + EmissivityGrd => noahmp%energy%state%EmissivityGrd ,& ! in, ground emissivity + TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow ,& ! in, snow and soil layer temperature [K] + ThermConductSoilSnow => noahmp%energy%state%ThermConductSoilSnow ,& ! in, thermal conductivity [W/m/K] for all soil & snow + ResistanceGrdEvap => noahmp%energy%state%ResistanceGrdEvap ,& ! in, ground surface resistance [s/m] to evaporation + RoughLenMomGrd => noahmp%energy%state%RoughLenMomGrd ,& ! in, roughness length, momentum, ground [m] + LatHeatVapGrd => noahmp%energy%state%LatHeatVapGrd ,& ! in, latent heat of vaporization/subli [J/kg], ground + PsychConstGrd => noahmp%energy%state%PsychConstGrd ,& ! in, psychrometric constant [Pa/K], ground + SpecHumiditySfc => noahmp%energy%state%SpecHumiditySfc ,& ! inout, specific humidity [kg/kg] at bare surface + TemperatureGrdBare => noahmp%energy%state%TemperatureGrdBare ,& ! inout, bare ground temperature (K) + ExchCoeffMomBare => noahmp%energy%state%ExchCoeffMomBare ,& ! inout, momentum exchange coeff [m/s)], above ZeroPlaneDisp, bare ground + ExchCoeffShBare => noahmp%energy%state%ExchCoeffShBare ,& ! inout, heat exchange coeff [m/s], above ZeroPlaneDisp, bare ground + WindStressEwBare => noahmp%energy%state%WindStressEwBare ,& ! out, wind stress: east-west [N/m2] bare ground + WindStressNsBare => noahmp%energy%state%WindStressNsBare ,& ! out, wind stress: north-south [N/m2] bare ground + TemperatureAir2mBare => noahmp%energy%state%TemperatureAir2mBare ,& ! out, 2 m height air temperature [K] bare ground + SpecHumidity2mBare => noahmp%energy%state%SpecHumidity2mBare ,& ! out, bare ground 2-m specific humidity [kg/kg] + ExchCoeffSh2mBare => noahmp%energy%state%ExchCoeffSh2mBare ,& ! out, bare ground 2-m sensible heat exchange coefficient [m/s] + FrictionVelBare => noahmp%energy%state%FrictionVelBare ,& ! out, friction velocity [m/s], vegetated + RoughLenShBareGrd => noahmp%energy%state%RoughLenShBareGrd ,& ! out, roughness length [m], sensible heat, bare ground + ResistanceLhBareGrd => noahmp%energy%state%ResistanceLhBareGrd ,& ! out, aerodynamic resistance for water vapor [s/m], bare ground + ResistanceShBareGrd => noahmp%energy%state%ResistanceShBareGrd ,& ! out, aerodynamic resistance for sensible heat [s/m], bare ground + ResistanceMomBareGrd => noahmp%energy%state%ResistanceMomBareGrd ,& ! out, aerodynamic resistance for momentum [s/m], bare ground + VapPresSatGrdBare => noahmp%energy%state%VapPresSatGrdBare ,& ! out, bare ground saturation vapor pressure [Pa] + VapPresSatGrdBareTempD => noahmp%energy%state%VapPresSatGrdBareTempD ,& ! out, bare ground d(VapPresSat)/dt [Pa/K] + MoStabParaBare => noahmp%energy%state%MoStabParaBare ,& ! out, Monin-Obukhov stability (z/L), above ZeroPlaneDisp, bare ground + MoStabCorrShBare2m => noahmp%energy%state%MoStabCorrShBare2m ,& ! out, M-O sen heat stability correction, 2m, bare ground + RadLwNetBareGrd => noahmp%energy%flux%RadLwNetBareGrd ,& ! out, net longwave rad [W/m2] bare ground (+ to atm) + HeatSensibleBareGrd => noahmp%energy%flux%HeatSensibleBareGrd ,& ! out, sensible heat flux [W/m2] bare ground (+ to atm) + HeatLatentBareGrd => noahmp%energy%flux%HeatLatentBareGrd ,& ! out, latent heat flux [W/m2] bare ground (+ to atm) + HeatGroundBareGrd => noahmp%energy%flux%HeatGroundBareGrd & ! out, bare ground heat flux [W/m2] (+ to soil/snow) + ) +! ---------------------------------------------------------------------- + + ! initialization (including variables that do not depend on stability iteration) + TemperatureGrdChg = 0.0 + MoStabParaBare = 0.0 + MoStabParaSgn = 0 + MoStabCorrShBare2m = 0.0 + MoistureFluxSfc = 0.0 + FrictionVelBare = 0.1 + HeatSensibleTmp = 0.0 + LwRadCoeff = EmissivityGrd * ConstStefanBoltzmann + GrdHeatCoeff = 2.0*ThermConductSoilSnow(NumSnowLayerNeg+1)/ThicknessSnowSoilLayer(NumSnowLayerNeg+1) + + ! begin stability iteration for ground temperature and flux + loop3: do IndIter = 1, NumIter + + ! ground roughness length + if ( IndIter == 1 ) then + RoughLenShBareGrd = RoughLenMomGrd + else + RoughLenShBareGrd = RoughLenMomGrd !* exp(-ZilitinkevichCoeff*0.4*258.2*sqrt(FrictionVelBare*RoughLenMomGrd)) + endif + + ! aerodyn resistances between reference heigths and d+z0v + if ( OptSurfaceDrag == 1 ) call ResistanceBareGroundMOST(noahmp, IndIter, HeatSensibleTmp, MoStabParaSgn) + if ( OptSurfaceDrag == 2 ) call ResistanceBareGroundChen97(noahmp, IndIter) + + ! conductance variables for diagnostics + ExchCoeffMomTmp = 1.0 / ResistanceMomBareGrd + ExchCoeffShTmp = 1.0 / ResistanceShBareGrd + + ! ES and d(ES)/dt evaluated at ground temperatue + TempTmp = TempUnitConv(TemperatureGrdBare) + call VaporPressureSaturation(TempTmp, VapPresSatWatTmp, VapPresSatIceTmp, VapPresSatWatTmpD, VapPresSatIceTmpD) + if ( TempTmp > 0.0 ) then + VapPresSatGrdBare = VapPresSatWatTmp + VapPresSatGrdBareTempD = VapPresSatWatTmpD + else + VapPresSatGrdBare = VapPresSatIceTmp + VapPresSatGrdBareTempD = VapPresSatIceTmpD + endif + + ! ground fluxes and temperature change + ShCoeff = DensityAirRefHeight * ConstHeatCapacAir / ResistanceShBareGrd + LhCoeff = DensityAirRefHeight * ConstHeatCapacAir / PsychConstGrd / (ResistanceGrdEvap+ResistanceLhBareGrd) + RadLwNetBareGrd = LwRadCoeff * TemperatureGrdBare**4 - EmissivityGrd * RadLwDownRefHeight + HeatSensibleBareGrd = ShCoeff * (TemperatureGrdBare - TemperatureAirRefHeight) + HeatLatentBareGrd = LhCoeff * (VapPresSatGrdBare*RelHumidityGrd - PressureVaporRefHeight) + HeatGroundBareGrd = GrdHeatCoeff * (TemperatureGrdBare - TemperatureSoilSnow(NumSnowLayerNeg+1)) + EnergyResTmp = RadSwAbsGrd - RadLwNetBareGrd - HeatSensibleBareGrd - HeatLatentBareGrd - & + HeatGroundBareGrd + HeatPrecipAdvBareGrd + FluxTotCoeff = 4.0*LwRadCoeff*TemperatureGrdBare**3 + ShCoeff + LhCoeff*VapPresSatGrdBareTempD + GrdHeatCoeff + TemperatureGrdChg = EnergyResTmp / FluxTotCoeff + RadLwNetBareGrd = RadLwNetBareGrd + 4.0 * LwRadCoeff * TemperatureGrdBare**3 * TemperatureGrdChg + HeatSensibleBareGrd = HeatSensibleBareGrd + ShCoeff * TemperatureGrdChg + HeatLatentBareGrd = HeatLatentBareGrd + LhCoeff * VapPresSatGrdBareTempD * TemperatureGrdChg + HeatGroundBareGrd = HeatGroundBareGrd + GrdHeatCoeff * TemperatureGrdChg + TemperatureGrdBare = TemperatureGrdBare + TemperatureGrdChg + + ! for computing M-O length + HeatSensibleTmp = ShCoeff * (TemperatureGrdBare - TemperatureAirRefHeight) + + ! update specific humidity + TempTmp = TempUnitConv(TemperatureGrdBare) + call VaporPressureSaturation(TempTmp, VapPresSatWatTmp, VapPresSatIceTmp, VapPresSatWatTmpD, VapPresSatIceTmpD) + if ( TempTmp > 0.0 ) then + VapPresSatGrdBare = VapPresSatWatTmp + else + VapPresSatGrdBare = VapPresSatIceTmp + endif + SpecHumiditySfc = 0.622 * (VapPresSatGrdBare*RelHumidityGrd) / & + (PressureAirRefHeight - 0.378 * (VapPresSatGrdBare*RelHumidityGrd)) + MoistureFluxSfc = (SpecHumiditySfc - SpecHumidityRefHeight) * LhCoeff * PsychConstGrd / ConstHeatCapacAir + + enddo loop3 ! end stability iteration + + ! if snow on ground and TemperatureGrdBare > freezing point: reset TemperatureGrdBare = freezing point. reevaluate ground fluxes. + if ( (OptSnowSoilTempTime == 1) .or. (OptSnowSoilTempTime == 3) ) then + if ( (SnowDepth > 0.05) .and. (TemperatureGrdBare > ConstFreezePoint) ) then + if ( OptSnowSoilTempTime == 1 ) & + TemperatureGrdBare = ConstFreezePoint + if ( OptSnowSoilTempTime == 3 ) & + TemperatureGrdBare = (1.0-SnowCoverFrac) * TemperatureGrdBare + SnowCoverFrac * ConstFreezePoint ! MB: allow TemperatureGrd>0C during melt v3.7 + + RadLwNetBareGrd = LwRadCoeff * TemperatureGrdBare**4 - EmissivityGrd * RadLwDownRefHeight + HeatSensibleBareGrd = ShCoeff * (TemperatureGrdBare - TemperatureAirRefHeight) + HeatLatentBareGrd = LhCoeff * (VapPresSatGrdBare*RelHumidityGrd - PressureVaporRefHeight) + HeatGroundBareGrd = RadSwAbsGrd + HeatPrecipAdvBareGrd - & + (RadLwNetBareGrd + HeatSensibleBareGrd + HeatLatentBareGrd) + endif + endif + + ! wind stresses + WindStressEwBare = -DensityAirRefHeight * ExchCoeffMomBare * WindSpdRefHeight * WindEastwardRefHeight + WindStressNsBare = -DensityAirRefHeight * ExchCoeffMomBare * WindSpdRefHeight * WindNorthwardRefHeight + + ! 2m air temperature + if ( (OptSurfaceDrag == 1) .or. (OptSurfaceDrag == 2) ) then + !ExchCoeffSh2mBare = FrictionVelBare * ConstVonKarman / log((2.0+RoughLenShBareGrd)/RoughLenShBareGrd) + ExchCoeffSh2mBare = FrictionVelBare * ConstVonKarman / & + (log((2.0+RoughLenShBareGrd)/RoughLenShBareGrd) - MoStabCorrShBare2m) + if ( ExchCoeffSh2mBare < 1.0e-5 ) then + TemperatureAir2mBare = TemperatureGrdBare + SpecHumidity2mBare = SpecHumiditySfc + else + TemperatureAir2mBare = TemperatureGrdBare - HeatSensibleBareGrd / & + (DensityAirRefHeight*ConstHeatCapacAir) * 1.0 / ExchCoeffSh2mBare + SpecHumidity2mBare = SpecHumiditySfc - HeatLatentBareGrd / & + (LatHeatVapGrd*DensityAirRefHeight) * (1.0/ExchCoeffSh2mBare + ResistanceGrdEvap) + endif + if ( FlagUrban .eqv. .true. ) SpecHumidity2mBare = SpecHumiditySfc + endif + + ! update ExchCoeffShBare + ExchCoeffShBare = ExchCoeffShTmp + + end associate + + end subroutine SurfaceEnergyFluxBareGround + +end module SurfaceEnergyFluxBareGroundMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SurfaceEnergyFluxGlacierMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SurfaceEnergyFluxGlacierMod.F90 new file mode 100644 index 000000000..96dfd84a5 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SurfaceEnergyFluxGlacierMod.F90 @@ -0,0 +1,231 @@ +module SurfaceEnergyFluxGlacierMod + +!!! Compute surface energy fluxes and budget for bare ground (glacier) +!!! Use newton-raphson iteration to solve for ground temperatures +!!! Surface energy balance (bare soil): +!!! Ground level: -RadSwAbsGrd - HeatPrecipAdvBareGrd + RadLwNetBareGrd + HeatSensibleBareGrd + HeatLatentBareGrd + HeatGroundBareGrd = 0 + + use Machine + use NoahmpVarType + use ConstantDefineMod + use VaporPressureSaturationMod, only : VaporPressureSaturation + use ResistanceBareGroundMostMod, only : ResistanceBareGroundMOST + + implicit none + +contains + + subroutine SurfaceEnergyFluxGlacier(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: GLACIER_FLUX +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type) , intent(inout) :: noahmp + +! local variables + integer :: IndIter ! iteration index + integer :: MoStabParaSgn ! number of times MoStabParaBare changes sign + integer, parameter :: NumIter = 5 ! number of iterations for surface temperature + real(kind=kind_noahmp) :: TemperatureGrdChg ! change in ground temperature [K], last iteration + real(kind=kind_noahmp) :: LwRadCoeff ! coefficients for longwave radiation as function of ts**4 + real(kind=kind_noahmp) :: ShCoeff ! coefficients for sensible heat as function of ts + real(kind=kind_noahmp) :: LhCoeff ! coefficients for latent heat as function of ts + real(kind=kind_noahmp) :: GrdHeatCoeff ! coefficients for st as function of ts + real(kind=kind_noahmp) :: ExchCoeffShTmp ! temporary sensible heat exchange coefficient [m/s] + real(kind=kind_noahmp) :: ExchCoeffMomTmp ! temporary momentum heat exchange coefficient [m/s] + real(kind=kind_noahmp) :: MoistureFluxSfc ! moisture flux + real(kind=kind_noahmp) :: VapPresSatWatTmp ! saturated vapor pressure for water + real(kind=kind_noahmp) :: VapPresSatIceTmp ! saturated vapor pressure for ice + real(kind=kind_noahmp) :: VapPresSatWatTmpD ! saturated vapor pressure gradient with ground temp. [Pa/K] for water + real(kind=kind_noahmp) :: VapPresSatIceTmpD ! saturated vapor pressure gradient with ground temp. [Pa/K] for ice + real(kind=kind_noahmp) :: FluxTotCoeff ! temporary total coefficients for all energy flux + real(kind=kind_noahmp) :: EnergyResTmp ! temporary energy residual + real(kind=kind_noahmp) :: HeatSensibleTmp ! temporary sensible heat flux [W/m2] + real(kind=kind_noahmp) :: TempTmp ! temporary temperature + real(kind=kind_noahmp) :: TempUnitConv ! Kelvin to degree Celsius with limit -50 to +50 + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilIceTmp ! temporary glacier ice content [m3/m3] +! local statement function + TempUnitConv(TempTmp) = min(50.0, max(-50.0, (TempTmp-ConstFreezePoint))) + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of glacier/soil layers + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! in, actual number of snow layers (negative) + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! in, thickness of snow/soil layers [m] + OptSnowSoilTempTime => noahmp%config%nmlist%OptSnowSoilTempTime ,& ! in, options for snow/soil temperature time scheme (only layer 1) + OptGlacierTreatment => noahmp%config%nmlist%OptGlacierTreatment ,& ! in, options for glacier treatment + RadLwDownRefHeight => noahmp%forcing%RadLwDownRefHeight ,& ! in, downward longwave radiation [W/m2] at reference height + WindEastwardRefHeight => noahmp%forcing%WindEastwardRefHeight ,& ! in, wind speed [m/s] in eastward direction at reference height + WindNorthwardRefHeight => noahmp%forcing%WindNorthwardRefHeight ,& ! in, wind speed [m/s] in northward direction at reference height + TemperatureAirRefHeight => noahmp%forcing%TemperatureAirRefHeight ,& ! in, air temperature [K] at reference height + PressureAirRefHeight => noahmp%forcing%PressureAirRefHeight ,& ! in, air pressure [Pa] at reference height + SnowDepth => noahmp%water%state%SnowDepth ,& ! in, snow depth [m] + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! in, total glacier/soil water content [m3/m3] + SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! in, glacier/soil water content [m3/m3] + RadSwAbsGrd => noahmp%energy%flux%RadSwAbsGrd ,& ! in, solar radiation absorbed by ground [W/m2] + HeatPrecipAdvBareGrd => noahmp%energy%flux%HeatPrecipAdvBareGrd ,& ! in, precipitation advected heat - bare ground net [W/m2] + WindSpdRefHeight => noahmp%energy%state%WindSpdRefHeight ,& ! in, wind speed [m/s] at reference height + PressureVaporRefHeight => noahmp%energy%state%PressureVaporRefHeight ,& ! in, vapor pressure air [Pa] at reference height + SpecHumidityRefHeight => noahmp%forcing%SpecHumidityRefHeight ,& ! in, specific humidity [kg/kg] at reference height + DensityAirRefHeight => noahmp%energy%state%DensityAirRefHeight ,& ! in, density air [kg/m3] + RelHumidityGrd => noahmp%energy%state%RelHumidityGrd ,& ! in, raltive humidity in surface soil/snow air space + EmissivityGrd => noahmp%energy%state%EmissivityGrd ,& ! in, ground emissivity + TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow ,& ! in, snow and soil layer temperature [K] + ThermConductSoilSnow => noahmp%energy%state%ThermConductSoilSnow ,& ! in, thermal conductivity [W/m/K] for all soil & snow + ResistanceGrdEvap => noahmp%energy%state%ResistanceGrdEvap ,& ! in, ground surface resistance [s/m] to evaporation + RoughLenMomGrd => noahmp%energy%state%RoughLenMomGrd ,& ! in, roughness length, momentum, ground [m] + LatHeatVapGrd => noahmp%energy%state%LatHeatVapGrd ,& ! in, latent heat of vaporization/subli [J/kg], ground + PsychConstGrd => noahmp%energy%state%PsychConstGrd ,& ! in, psychrometric constant [Pa/K], ground + SpecHumiditySfc => noahmp%energy%state%SpecHumiditySfc ,& ! inout, specific humidity at surface + TemperatureGrdBare => noahmp%energy%state%TemperatureGrdBare ,& ! inout, bare ground temperature [K] + ExchCoeffMomBare => noahmp%energy%state%ExchCoeffMomBare ,& ! inout, momentum exchange coeff [m/s], above ZeroPlaneDisp, bare ground + ExchCoeffShBare => noahmp%energy%state%ExchCoeffShBare ,& ! inout, heat exchange coeff [m/s], above ZeroPlaneDisp, bare ground + WindStressEwBare => noahmp%energy%state%WindStressEwBare ,& ! out, wind stress: east-west [N/m2] bare ground + WindStressNsBare => noahmp%energy%state%WindStressNsBare ,& ! out, wind stress: north-south [N/m2] bare ground + TemperatureAir2mBare => noahmp%energy%state%TemperatureAir2mBare ,& ! out, 2 m height air temperature [K] bare ground + SpecHumidity2mBare => noahmp%energy%state%SpecHumidity2mBare ,& ! out, bare ground 2-m specific humidity [kg/kg] + ExchCoeffSh2mBare => noahmp%energy%state%ExchCoeffSh2mBare ,& ! out, bare ground 2-m sensible heat exchange coefficient [m/s] + FrictionVelBare => noahmp%energy%state%FrictionVelBare ,& ! out, friction velocity [m/s], vegetated + RoughLenShBareGrd => noahmp%energy%state%RoughLenShBareGrd ,& ! out, roughness length [m], sensible heat, bare ground + ResistanceLhBareGrd => noahmp%energy%state%ResistanceLhBareGrd ,& ! out, aerodynamic resistance for water vapor [s/m], bare ground + ResistanceShBareGrd => noahmp%energy%state%ResistanceShBareGrd ,& ! out, aerodynamic resistance for sensible heat [s/m], bare ground + ResistanceMomBareGrd => noahmp%energy%state%ResistanceMomBareGrd ,& ! out, aerodynamic resistance for momentum [s/m], bare ground + VapPresSatGrdBare => noahmp%energy%state%VapPresSatGrdBare ,& ! out, bare ground saturation vapor pressure at TemperatureGrd [Pa] + VapPresSatGrdBareTempD => noahmp%energy%state%VapPresSatGrdBareTempD ,& ! out, bare ground d(VapPresSatGrdBare)/dt at TemperatureGrd [Pa/K] + MoStabParaBare => noahmp%energy%state%MoStabParaBare ,& ! out, Monin-Obukhov stability (z/L), above ZeroPlaneDisp, bare ground + MoStabCorrShBare2m => noahmp%energy%state%MoStabCorrShBare2m ,& ! out, M-O sen heat stability correction, 2m, bare ground + RadLwNetBareGrd => noahmp%energy%flux%RadLwNetBareGrd ,& ! out, net longwave rad [W/m2] bare ground (+ to atm) + HeatSensibleBareGrd => noahmp%energy%flux%HeatSensibleBareGrd ,& ! out, sensible heat flux [W/m2] bare ground (+ to atm) + HeatLatentBareGrd => noahmp%energy%flux%HeatLatentBareGrd ,& ! out, latent heat flux [W/m2] bare ground (+ to atm) + HeatGroundBareGrd => noahmp%energy%flux%HeatGroundBareGrd & ! out, bare ground heat flux [W/m2] (+ to soil/snow) + ) +! ---------------------------------------------------------------------- + + ! initialization (including variables that do not depend on stability iteration) + if (.not. allocated(SoilIceTmp)) allocate(SoilIceTmp(1:NumSoilLayer)) + SoilIceTmp = 0.0 + TemperatureGrdChg = 0.0 + MoStabParaBare = 0.0 + MoStabParaSgn = 0 + MoStabCorrShBare2m = 0.0 + HeatSensibleTmp = 0.0 + MoistureFluxSfc = 0.0 + FrictionVelBare = 0.1 + LwRadCoeff = EmissivityGrd * ConstStefanBoltzmann + GrdHeatCoeff = 2.0*ThermConductSoilSnow(NumSnowLayerNeg+1)/ThicknessSnowSoilLayer(NumSnowLayerNeg+1) + + ! begin stability iteration for ground temperature and flux + loop3: do IndIter = 1, NumIter + + ! ground roughness length + RoughLenShBareGrd = RoughLenMomGrd + + ! aerodyn resistances between heights reference height and d+z0v + call ResistanceBareGroundMOST(noahmp, IndIter, HeatSensibleTmp, MoStabParaSgn) + + ! conductance variables for diagnostics + ExchCoeffMomTmp = 1.0 / ResistanceMomBareGrd + ExchCoeffShTmp = 1.0 / ResistanceShBareGrd + + ! ES and d(ES)/dt evaluated at TemperatureGrd + TempTmp = TempUnitConv(TemperatureGrdBare) + call VaporPressureSaturation(TempTmp, VapPresSatWatTmp, VapPresSatIceTmp, VapPresSatWatTmpD, VapPresSatIceTmpD) + if ( TempTmp > 0.0 ) then + VapPresSatGrdBare = VapPresSatWatTmp + VapPresSatGrdBareTempD = VapPresSatWatTmpD + else + VapPresSatGrdBare = VapPresSatIceTmp + VapPresSatGrdBareTempD = VapPresSatIceTmpD + endif + + ! ground fluxes and temperature change + ShCoeff = DensityAirRefHeight * ConstHeatCapacAir / ResistanceShBareGrd + if ( (SnowDepth > 0.0) .or. (OptGlacierTreatment == 1) ) then + LhCoeff = DensityAirRefHeight * ConstHeatCapacAir / PsychConstGrd / (ResistanceGrdEvap+ResistanceLhBareGrd) + else + LhCoeff = 0.0 ! don't allow any sublimation of glacier in OptGlacierTreatment=2 + endif + RadLwNetBareGrd = LwRadCoeff * TemperatureGrdBare**4 - EmissivityGrd * RadLwDownRefHeight + HeatSensibleBareGrd = ShCoeff * (TemperatureGrdBare - TemperatureAirRefHeight) + HeatLatentBareGrd = LhCoeff * (VapPresSatGrdBare*RelHumidityGrd - PressureVaporRefHeight) + HeatGroundBareGrd = GrdHeatCoeff * (TemperatureGrdBare - TemperatureSoilSnow(NumSnowLayerNeg+1)) + EnergyResTmp = RadSwAbsGrd - RadLwNetBareGrd - HeatSensibleBareGrd - & + HeatLatentBareGrd - HeatGroundBareGrd + HeatPrecipAdvBareGrd + FluxTotCoeff = 4.0*LwRadCoeff*TemperatureGrdBare**3 + ShCoeff + LhCoeff*VapPresSatGrdBareTempD + GrdHeatCoeff + TemperatureGrdChg = EnergyResTmp / FluxTotCoeff + RadLwNetBareGrd = RadLwNetBareGrd + 4.0 * LwRadCoeff * TemperatureGrdBare**3 * TemperatureGrdChg + HeatSensibleBareGrd = HeatSensibleBareGrd + ShCoeff * TemperatureGrdChg + HeatLatentBareGrd = HeatLatentBareGrd + LhCoeff * VapPresSatGrdBareTempD * TemperatureGrdChg + HeatGroundBareGrd = HeatGroundBareGrd + GrdHeatCoeff * TemperatureGrdChg + TemperatureGrdBare = TemperatureGrdBare + TemperatureGrdChg ! update ground temperature + + ! for computing M-O length + HeatSensibleTmp = ShCoeff * (TemperatureGrdBare - TemperatureAirRefHeight) + + ! update specific humidity + TempTmp = TempUnitConv(TemperatureGrdBare) + call VaporPressureSaturation(TempTmp, VapPresSatWatTmp, VapPresSatIceTmp, VapPresSatWatTmpD, VapPresSatIceTmpD) + if ( TempTmp > 0.0 ) then + VapPresSatGrdBare = VapPresSatWatTmp + else + VapPresSatGrdBare = VapPresSatIceTmp + endif + SpecHumiditySfc = 0.622 * (VapPresSatGrdBare*RelHumidityGrd) / & + (PressureAirRefHeight - 0.378 * (VapPresSatGrdBare*RelHumidityGrd)) + MoistureFluxSfc = (SpecHumiditySfc - SpecHumidityRefHeight) * LhCoeff * PsychConstGrd / ConstHeatCapacAir + + enddo loop3 ! end stability iteration + + ! if snow on ground and TemperatureGrdBare > freezing point: reset TemperatureGrdBare = freezing point. reevaluate ground fluxes. + SoilIceTmp = SoilMoisture - SoilLiqWater + if ( (OptSnowSoilTempTime == 1) .or. (OptSnowSoilTempTime == 3) ) then + if ( (maxval(SoilIceTmp) > 0.0 .or. SnowDepth > 0.05) .and. & + (TemperatureGrdBare > ConstFreezePoint) .and. (OptGlacierTreatment == 1) ) then + TemperatureGrdBare = ConstFreezePoint + TempTmp = TempUnitConv(TemperatureGrdBare) ! MB: recalculate VapPresSatGrdBare + call VaporPressureSaturation(TempTmp, VapPresSatWatTmp, VapPresSatIceTmp, VapPresSatWatTmpD, VapPresSatIceTmpD) + VapPresSatGrdBare = VapPresSatIceTmp + SpecHumiditySfc = 0.622 * (VapPresSatGrdBare*RelHumidityGrd) / & + (PressureAirRefHeight - 0.378 * (VapPresSatGrdBare*RelHumidityGrd)) + MoistureFluxSfc = (SpecHumiditySfc - SpecHumidityRefHeight) * LhCoeff * PsychConstGrd / ConstHeatCapacAir + RadLwNetBareGrd = LwRadCoeff * TemperatureGrdBare**4 - EmissivityGrd * RadLwDownRefHeight + HeatSensibleBareGrd = ShCoeff * (TemperatureGrdBare - TemperatureAirRefHeight) + HeatLatentBareGrd = LhCoeff * (VapPresSatGrdBare*RelHumidityGrd - PressureVaporRefHeight) + HeatGroundBareGrd = RadSwAbsGrd + HeatPrecipAdvBareGrd - & + (RadLwNetBareGrd + HeatSensibleBareGrd + HeatLatentBareGrd) + endif + endif + + ! wind stresses + WindStressEwBare = -DensityAirRefHeight * ExchCoeffMomBare * WindSpdRefHeight * WindEastwardRefHeight + WindStressNsBare = -DensityAirRefHeight * ExchCoeffMomBare * WindSpdRefHeight * WindNorthwardRefHeight + + ! 2m air temperature + ExchCoeffSh2mBare = FrictionVelBare * ConstVonKarman / & + (log((2.0+RoughLenShBareGrd)/RoughLenShBareGrd) - MoStabCorrShBare2m) + if ( ExchCoeffSh2mBare < 1.0e-5 ) then + TemperatureAir2mBare = TemperatureGrdBare + SpecHumidity2mBare = SpecHumiditySfc + else + TemperatureAir2mBare = TemperatureGrdBare - HeatSensibleBareGrd / & + (DensityAirRefHeight*ConstHeatCapacAir) * 1.0 / ExchCoeffSh2mBare + SpecHumidity2mBare = SpecHumiditySfc - HeatLatentBareGrd / & + (LatHeatVapGrd*DensityAirRefHeight) * (1.0/ExchCoeffSh2mBare + ResistanceGrdEvap) + endif + + ! update ExchCoeffShBare + ExchCoeffShBare = ExchCoeffShTmp + + ! deallocate local arrays to avoid memory leaks + deallocate(SoilIceTmp) + + end associate + + end subroutine SurfaceEnergyFluxGlacier + +end module SurfaceEnergyFluxGlacierMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SurfaceEnergyFluxVegetatedMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SurfaceEnergyFluxVegetatedMod.F90 new file mode 100644 index 000000000..1283553ad --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SurfaceEnergyFluxVegetatedMod.F90 @@ -0,0 +1,428 @@ +module SurfaceEnergyFluxVegetatedMod + +!!! Compute surface energy fluxes and budget for vegetated surface +!!! Use newton-raphson iteration to solve for vegetation and ground temperatures +!!! Surface energy balance: +!!! Canopy level: -RadSwAbsVeg - HeatPrecipAdvCanopy + RadLwNetCanopy + HeatSensibleCanopy + HeatLatentCanEvap + HeatLatentCanTransp + HeatCanStorageChg = 0 +!!! Ground level: -RadSwAbsGrd - HeatPrecipAdvVegGrd + RadLwNetVegGrd + HeatSensibleVegGrd + HeatLatentVegGrd + HeatGroundVegGrd = 0 + + use Machine + use NoahmpVarType + use ConstantDefineMod + use VaporPressureSaturationMod, only : VaporPressureSaturation + use ResistanceAboveCanopyMostMod, only : ResistanceAboveCanopyMOST + use ResistanceAboveCanopyChen97Mod, only : ResistanceAboveCanopyChen97 + use ResistanceLeafToGroundMod, only : ResistanceLeafToGround + use ResistanceCanopyStomataBallBerryMod, only : ResistanceCanopyStomataBallBerry + use ResistanceCanopyStomataJarvisMod, only : ResistanceCanopyStomataJarvis + + implicit none + +contains + + subroutine SurfaceEnergyFluxVegetated(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: VEGE_FLUX +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type) , intent(inout) :: noahmp + +! local variable + integer :: IndIter ! iteration index + integer :: LastIter ! Last iteration + integer :: MoStabParaSgn ! number of times MoStabParaAbvCan changes sign + integer :: IndexShade ! index for sunlit/shaded (0=sunlit;1=shaded) + integer, parameter :: NumIterC = 20 ! number of iterations for surface temperature (5~20) + integer, parameter :: NumIterG = 5 ! number of iterations for ground temperature (3~5) + real(kind=kind_noahmp) :: ExchCoeffShAbvCanTmp ! sensible heat conductance, canopy air to reference height air [m/s] + real(kind=kind_noahmp) :: TemperatureCanChg ! change in tv, last iteration [K] + real(kind=kind_noahmp) :: TemperatureGrdChg ! change in tg, last iteration [K] + real(kind=kind_noahmp) :: LwCoeffAir ! coefficients for longwave emission as function of ts**4 + real(kind=kind_noahmp) :: LwCoeffCan ! coefficients for longwave emission as function of ts**4 + real(kind=kind_noahmp) :: ShCoeff ! coefficients for sensible heat as function of ts + real(kind=kind_noahmp) :: LhCoeff ! coefficients for latent heat as function of ts + real(kind=kind_noahmp) :: GrdHeatCoeff ! coefficients for ground heat as function of ts + real(kind=kind_noahmp) :: TranspHeatCoeff ! coefficients for transpiration heat as function of ts + real(kind=kind_noahmp) :: TempShGhTmp ! partial temperature by sensible and ground heat + real(kind=kind_noahmp) :: ExchCoeffShFrac ! exchange coefficient fraction for sensible heat + real(kind=kind_noahmp) :: VapPresLhTot ! vapor pressure related to total latent heat + real(kind=kind_noahmp) :: ExchCoeffEtFrac ! exchange coefficient fraction for evapotranspiration heat + real(kind=kind_noahmp) :: VapPresSatWatTmp ! saturated vapor pressure for water + real(kind=kind_noahmp) :: VapPresSatIceTmp ! saturated vapor pressure for ice + real(kind=kind_noahmp) :: VapPresSatWatTmpD ! saturated vapor pressure gradient with ground temp. [Pa/K] for water + real(kind=kind_noahmp) :: VapPresSatIceTmpD ! saturated vapor pressure gradient with ground temp. [Pa/K] for ice + real(kind=kind_noahmp) :: FluxTotCoeff ! temporary total coefficients for all energy flux + real(kind=kind_noahmp) :: EnergyResTmp ! temporary energy residual + real(kind=kind_noahmp) :: ExchCoeffShLeafTmp ! sensible heat conductance, leaf surface to canopy air [m/s] + real(kind=kind_noahmp) :: ExchCoeffTot ! sum of conductances [m/s] + real(kind=kind_noahmp) :: ShCanTmp ! temporary sensible heat flux [W/m2] + real(kind=kind_noahmp) :: ShGrdTmp ! temporary sensible heat flux [W/m2] + real(kind=kind_noahmp) :: MoistureFluxSfc ! moisture flux + real(kind=kind_noahmp) :: VegAreaIndTmp ! total leaf area index + stem area index,effective + real(kind=kind_noahmp) :: LeafAreaIndSunEff ! sunlit leaf area index, one-sided [m2/m2],effective + real(kind=kind_noahmp) :: LeafAreaIndShdEff ! shaded leaf area index, one-sided [m2/m2],effective + real(kind=kind_noahmp) :: TempTmp ! temporary temperature + real(kind=kind_noahmp) :: TempUnitConv ! Kelvin to degree Celsius with limit -50 to +50 + real(kind=kind_noahmp) :: HeatCapacCan ! canopy heat capacity [J/m2/K] +! local statement function + TempUnitConv(TempTmp) = min(50.0, max(-50.0, (TempTmp - ConstFreezePoint))) + +! -------------------------------------------------------------------- + associate( & + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, main noahmp timestep [s] + GridIndexI => noahmp%config%domain%GridIndexI ,& ! in, grid index in x-direction + GridIndexJ => noahmp%config%domain%GridIndexJ ,& ! in, grid index in y-direction + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! in, actual number of snow layers (negative) + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! in, thickness of snow/soil layers [m] + OptSurfaceDrag => noahmp%config%nmlist%OptSurfaceDrag ,& ! in, options for surface layer drag/exchange coefficient + OptStomataResistance => noahmp%config%nmlist%OptStomataResistance ,& ! in, options for canopy stomatal resistance + OptSnowSoilTempTime => noahmp%config%nmlist%OptSnowSoilTempTime ,& ! in, options for snow/soil temperature time scheme (only layer 1) + WindEastwardRefHeight => noahmp%forcing%WindEastwardRefHeight ,& ! in, wind speed [m/s] in eastward direction at reference height + WindNorthwardRefHeight => noahmp%forcing%WindNorthwardRefHeight ,& ! in, wind speed [m/s] in northward direction at reference height + RadLwDownRefHeight => noahmp%forcing%RadLwDownRefHeight ,& ! in, downward longwave radiation [W/m2] at reference height + TemperatureAirRefHeight => noahmp%forcing%TemperatureAirRefHeight ,& ! in, air temperature [K] at reference height + PressureAirRefHeight => noahmp%forcing%PressureAirRefHeight ,& ! in, air pressure [Pa] at reference height + PressureAirSurface => noahmp%forcing%PressureAirSurface ,& ! in, air pressure [Pa] at surface-atmos interface + SnowDepth => noahmp%water%state%SnowDepth ,& ! in, snow depth [m] + SnowCoverFrac => noahmp%water%state%SnowCoverFrac ,& ! in, snow cover fraction + CanopyWetFrac => noahmp%water%state%CanopyWetFrac ,& ! in, wetted or snowed fraction of the canopy + CanopyLiqWater => noahmp%water%state%CanopyLiqWater ,& ! in, canopy intercepted liquid water [mm] + CanopyIce => noahmp%water%state%CanopyIce ,& ! in, canopy intercepted ice [mm] + HeightCanopyTop => noahmp%energy%param%HeightCanopyTop ,& ! in, top of canopy [m] + ZilitinkevichCoeff => noahmp%energy%param%ZilitinkevichCoeff ,& ! in, Zilitinkevich Coefficient for exchange coefficient calculation + HeatCapacCanFac => noahmp%energy%param%HeatCapacCanFac ,& ! in, canopy biomass heat capacity parameter [m] + RadSwAbsVeg => noahmp%energy%flux%RadSwAbsVeg ,& ! in, solar radiation absorbed by vegetation [W/m2] + RadSwAbsGrd => noahmp%energy%flux%RadSwAbsGrd ,& ! in, solar radiation absorbed by ground [W/m2] + HeatPrecipAdvCanopy => noahmp%energy%flux%HeatPrecipAdvCanopy ,& ! in, precipitation advected heat - vegetation net [W/m2] + HeatPrecipAdvVegGrd => noahmp%energy%flux%HeatPrecipAdvVegGrd ,& ! in, precipitation advected heat - under canopy net [W/m2] + RefHeightAboveGrd => noahmp%energy%state%RefHeightAboveGrd ,& ! in, surface reference height [m] + VegFrac => noahmp%energy%state%VegFrac ,& ! in, greeness vegetation fraction + WindSpdRefHeight => noahmp%energy%state%WindSpdRefHeight ,& ! in, wind speed [m/s] at reference height + PressureVaporRefHeight => noahmp%energy%state%PressureVaporRefHeight ,& ! in, vapor pressure air [Pa] at reference height + SpecHumidityRefHeight => noahmp%forcing%SpecHumidityRefHeight ,& ! in, specific humidity [kg/kg] at reference height + DensityAirRefHeight => noahmp%energy%state%DensityAirRefHeight ,& ! in, density air [kg/m3] + VegAreaIndEff => noahmp%energy%state%VegAreaIndEff ,& ! in, one-sided leaf+stem area index [m2/m2] + LeafAreaIndSunlit => noahmp%energy%state%LeafAreaIndSunlit ,& ! in, sunlit leaf area index, one-sided [m2/m2] + LeafAreaIndShade => noahmp%energy%state%LeafAreaIndShade ,& ! in, shaded leaf area index, one-sided [m2/m2] + ZeroPlaneDispSfc => noahmp%energy%state%ZeroPlaneDispSfc ,& ! in, zero plane displacement [m] + RoughLenMomSfc => noahmp%energy%state%RoughLenMomSfc ,& ! in, roughness length [m], momentum, surface + RoughLenMomGrd => noahmp%energy%state%RoughLenMomGrd ,& ! in, roughness length [m], momentum, ground + EmissivityVeg => noahmp%energy%state%EmissivityVeg ,& ! in, vegetation emissivity + EmissivityGrd => noahmp%energy%state%EmissivityGrd ,& ! in, ground emissivity + TemperatureSoilSnow => noahmp%energy%state%TemperatureSoilSnow ,& ! in, snow and soil layer temperature [K] + ThermConductSoilSnow => noahmp%energy%state%ThermConductSoilSnow ,& ! in, thermal conductivity [W/m/K] for all soil & snow + ResistanceGrdEvap => noahmp%energy%state%ResistanceGrdEvap ,& ! in, ground surface resistance [s/m] to evaporation + PsychConstCanopy => noahmp%energy%state%PsychConstCanopy ,& ! in, psychrometric constant [Pa/K], canopy + LatHeatVapCanopy => noahmp%energy%state%LatHeatVapCanopy ,& ! in, latent heat of vaporization/subli [J/kg], canopy + PsychConstGrd => noahmp%energy%state%PsychConstGrd ,& ! in, psychrometric constant [Pa/K], ground + RelHumidityGrd => noahmp%energy%state%RelHumidityGrd ,& ! in, raltive humidity in surface soil/snow air space + SpecHumiditySfc => noahmp%energy%state%SpecHumiditySfc ,& ! inout, specific humidity at vegetated surface + PressureVaporCanAir => noahmp%energy%state%PressureVaporCanAir ,& ! inout, canopy air vapor pressure [Pa] + TemperatureCanopyAir => noahmp%energy%state%TemperatureCanopyAir ,& ! inout, canopy air temperature [K] + TemperatureCanopy => noahmp%energy%state%TemperatureCanopy ,& ! inout, vegetation temperature [K] + TemperatureGrdVeg => noahmp%energy%state%TemperatureGrdVeg ,& ! inout, vegetated ground (below-canopy) temperature [K] + ExchCoeffMomAbvCan => noahmp%energy%state%ExchCoeffMomAbvCan ,& ! inout, momentum exchange coeff [m/s], above ZeroPlaneDisp, vegetated + ExchCoeffShAbvCan => noahmp%energy%state%ExchCoeffShAbvCan ,& ! inout, heat exchange coeff [m/s], above ZeroPlaneDisp, vegetated + WindStressEwVeg => noahmp%energy%state%WindStressEwVeg ,& ! out, wind stress: east-west [N/m2] above canopy + WindStressNsVeg => noahmp%energy%state%WindStressNsVeg ,& ! out, wind stress: north-south [N/m2] above canopy + TemperatureAir2mVeg => noahmp%energy%state%TemperatureAir2mVeg ,& ! out, 2 m height air temperature [K], vegetated + ExchCoeffShLeaf => noahmp%energy%state%ExchCoeffShLeaf ,& ! out, sensible heat exchange coeff [m/s],leaf surface to canopy air + ExchCoeffShUndCan => noahmp%energy%state%ExchCoeffShUndCan ,& ! out, under canopy sensible heat exchange coefficient [m/s] + ExchCoeffSh2mVeg => noahmp%energy%state%ExchCoeffSh2mVeg ,& ! out, 2m sensible heat exchange coefficient [m/s] + SpecHumidity2mVeg => noahmp%energy%state%SpecHumidity2mVeg ,& ! out, specific humidity [kg/kg] at 2m vegetated + ResistanceStomataSunlit => noahmp%energy%state%ResistanceStomataSunlit ,& ! out, sunlit leaf stomatal resistance [s/m] + ResistanceStomataShade => noahmp%energy%state%ResistanceStomataShade ,& ! out, shaded leaf stomatal resistance [s/m] + FrictionVelVeg => noahmp%energy%state%FrictionVelVeg ,& ! out, friction velocity [m/s], vegetated + RoughLenShCanopy => noahmp%energy%state%RoughLenShCanopy ,& ! out, roughness length [m], sensible heat, vegetated + RoughLenShVegGrd => noahmp%energy%state%RoughLenShVegGrd ,& ! out, roughness length [m], sensible heat ground, below canopy + ResistanceLeafBoundary => noahmp%energy%state%ResistanceLeafBoundary ,& ! out, bulk leaf boundary layer resistance [s/m] + ResistanceShAbvCan => noahmp%energy%state%ResistanceShAbvCan ,& ! out, aerodynamic resistance for sensible heat [s/m], above canopy + ResistanceLhAbvCan => noahmp%energy%state%ResistanceLhAbvCan ,& ! out, aerodynamic resistance for water vapor [s/m], above canopy + ResistanceShUndCan => noahmp%energy%state%ResistanceShUndCan ,& ! out, ground aerodynamic resistance for sensible heat [s/m] + ResistanceLhUndCan => noahmp%energy%state%ResistanceLhUndCan ,& ! out, ground aerodynamic resistance for water vapor [s/m] + ExchCoeffLhAbvCan => noahmp%energy%state%ExchCoeffLhAbvCan ,& ! out, latent heat conductance, canopy air to reference height [m/s] + ExchCoeffLhTransp => noahmp%energy%state%ExchCoeffLhTransp ,& ! out, transpiration conductance, leaf to canopy air [m/s] + ExchCoeffLhEvap => noahmp%energy%state%ExchCoeffLhEvap ,& ! out, evaporation conductance, leaf to canopy air [m/s] + ExchCoeffLhUndCan => noahmp%energy%state%ExchCoeffLhUndCan ,& ! out, latent heat conductance, ground to canopy air [m/s] + VapPresSatCanopy => noahmp%energy%state%VapPresSatCanopy ,& ! out, saturation vapor pressure at TemperatureCanopy [Pa] + VapPresSatGrdVeg => noahmp%energy%state%VapPresSatGrdVeg ,& ! out, saturation vapor pressure at TemperatureGrd [Pa] + VapPresSatCanTempD => noahmp%energy%state%VapPresSatCanTempD ,& ! out, d(VapPresSatCanopy)/dt at TemperatureCanopy [Pa/K] + VapPresSatGrdVegTempD => noahmp%energy%state%VapPresSatGrdVegTempD ,& ! out, d(VapPresSatGrdVeg)/dt at TemperatureGrd [Pa/K] + CanopyHeight => noahmp%energy%state%CanopyHeight ,& ! out, canopy height [m] + WindSpdCanopyTop => noahmp%energy%state%WindSpdCanopyTop ,& ! out, wind speed at top of canopy [m/s] + MoStabParaAbvCan => noahmp%energy%state%MoStabParaAbvCan ,& ! out, Monin-Obukhov stability (z/L), above ZeroPlaneDispSfc, vegetated + MoStabCorrShVeg2m => noahmp%energy%state%MoStabCorrShVeg2m ,& ! out, M-O sen heat stability correction, 2m, vegetated + RadLwNetCanopy => noahmp%energy%flux%RadLwNetCanopy ,& ! out, canopy net longwave radiation [W/m2] (+ to atm) + HeatSensibleCanopy => noahmp%energy%flux%HeatSensibleCanopy ,& ! out, canopy sensible heat flux [W/m2] (+ to atm) + HeatLatentCanEvap => noahmp%energy%flux%HeatLatentCanEvap ,& ! out, canopy evaporation heat flux [W/m2] (+ to atm) + RadLwNetVegGrd => noahmp%energy%flux%RadLwNetVegGrd ,& ! out, ground net longwave radiation [W/m2] (+ to atm) + HeatSensibleVegGrd => noahmp%energy%flux%HeatSensibleVegGrd ,& ! out, vegetated ground sensible heat flux [W/m2] (+ to atm) + HeatLatentVegGrd => noahmp%energy%flux%HeatLatentVegGrd ,& ! out, ground evaporation heat flux [W/m2] (+ to atm) + HeatLatentCanTransp => noahmp%energy%flux%HeatLatentCanTransp ,& ! out, canopy transpiration heat flux [W/m2] (+ to atm) + HeatCanStorageChg => noahmp%energy%flux%HeatCanStorageChg ,& ! out, canopy heat storage change [W/m2] + HeatGroundVegGrd => noahmp%energy%flux%HeatGroundVegGrd & ! out, vegetated ground heat [W/m2] (+ to soil/snow) + ) +! ---------------------------------------------------------------------- + + ! initialization (including variables that do not depend on stability iteration) + LastIter = 0 + FrictionVelVeg = 0.1 + TemperatureCanChg = 0.0 + TemperatureGrdChg = 0.0 + MoStabParaAbvCan = 0.0 + MoStabParaSgn = 0 + MoStabCorrShVeg2m = 0.0 + ShGrdTmp = 0.0 + ShCanTmp = 0.0 + MoistureFluxSfc = 0.0 + ! limit LeafAreaIndex + VegAreaIndTmp = min(6.0, VegAreaIndEff) + LeafAreaIndSunEff = min(6.0, LeafAreaIndSunlit) + LeafAreaIndShdEff = min(6.0, LeafAreaIndShade) + + ! saturation vapor pressure at ground temperature + TempTmp = TempUnitConv(TemperatureGrdVeg) + call VaporPressureSaturation(TempTmp, VapPresSatWatTmp, VapPresSatIceTmp, VapPresSatWatTmpD, VapPresSatIceTmpD) + if ( TempTmp > 0.0 ) then + VapPresSatGrdVeg = VapPresSatWatTmp + else + VapPresSatGrdVeg = VapPresSatIceTmp + endif + + ! canopy height + CanopyHeight = HeightCanopyTop + ! wind speed at canopy height + !WindSpdCanopyTop = WindSpdRefHeight * log(CanopyHeight/RoughLenMomSfc) / log(RefHeightAboveGrd/RoughLenMomSfc) + WindSpdCanopyTop = WindSpdRefHeight * log((CanopyHeight - ZeroPlaneDispSfc + RoughLenMomSfc)/RoughLenMomSfc) / & + log(RefHeightAboveGrd/RoughLenMomSfc) ! MB: add ZeroPlaneDispSfc v3.7 + if ( (CanopyHeight-ZeroPlaneDispSfc) <= 0.0 ) then + print*, "CRITICAL PROBLEM: CanopyHeight <= ZeroPlaneDispSfc" + print*, "GridIndexI,GridIndexJ = ", GridIndexI, GridIndexJ + print*, "CanopyHeight = " , CanopyHeight + print*, "ZeroPlaneDispSfc = " , ZeroPlaneDispSfc + print*, "SnowDepth = " , SnowDepth + stop "Error: ZeroPlaneDisp problem in NoahMP LSM" + endif + + ! prepare for longwave rad. + LwCoeffAir = -EmissivityVeg * (1.0 + (1.0-EmissivityVeg)*(1.0-EmissivityGrd)) * RadLwDownRefHeight - & + EmissivityVeg * EmissivityGrd * ConstStefanBoltzmann * TemperatureGrdVeg**4 + LwCoeffCan = (2.0 - EmissivityVeg * (1.0-EmissivityGrd)) * EmissivityVeg * ConstStefanBoltzmann + + ! begin stability iteration for canopy temperature and flux + loop1: do IndIter = 1, NumIterC + + ! ground and surface roughness length + if ( IndIter == 1 ) then + RoughLenShCanopy = RoughLenMomSfc + RoughLenShVegGrd = RoughLenMomGrd + else + RoughLenShCanopy = RoughLenMomSfc !* exp(-ZilitinkevichCoeff*0.4*258.2*sqrt(FrictionVelVeg*RoughLenMomSfc)) + RoughLenShVegGrd = RoughLenMomGrd !* exp(-ZilitinkevichCoeff*0.4*258.2*sqrt(FrictionVelVeg*RoughLenMomGrd)) + endif + + ! aerodyn resistances between RefHeightAboveGrd and d+z0v + if ( OptSurfaceDrag == 1 ) call ResistanceAboveCanopyMOST(noahmp, IndIter, ShCanTmp, MoStabParaSgn) + if ( OptSurfaceDrag == 2 ) call ResistanceAboveCanopyChen97(noahmp, IndIter) + + ! aerodyn resistance between z0g and d+z0v, and leaf boundary layer resistance + call ResistanceLeafToGround(noahmp, IndIter, VegAreaIndTmp, ShGrdTmp) + + ! ES and d(ES)/dt evaluated at TemperatureCanopy + TempTmp = TempUnitConv(TemperatureCanopy) + call VaporPressureSaturation(TempTmp, VapPresSatWatTmp, VapPresSatIceTmp, VapPresSatWatTmpD, VapPresSatIceTmpD) + if ( TempTmp > 0.0 ) then + VapPresSatCanopy = VapPresSatWatTmp + VapPresSatCanTempD = VapPresSatWatTmpD + else + VapPresSatCanopy = VapPresSatIceTmp + VapPresSatCanTempD = VapPresSatIceTmpD + endif + + ! stomatal resistance + if ( IndIter == 1 ) then + if ( OptStomataResistance == 1 ) then ! Ball-Berry + IndexShade = 0 ! sunlit case + call ResistanceCanopyStomataBallBerry(noahmp, IndexShade) + IndexShade = 1 ! shaded case + call ResistanceCanopyStomataBallBerry(noahmp, IndexShade) + endif + if ( OptStomataResistance == 2 ) then ! Jarvis + IndexShade = 0 ! sunlit case + call ResistanceCanopyStomataJarvis(noahmp, IndexShade) + IndexShade = 1 ! shaded case + call ResistanceCanopyStomataJarvis(noahmp, IndexShade) + endif + endif + + ! sensible heat conductance and coeff above veg. + ExchCoeffShAbvCanTmp = 1.0 / ResistanceShAbvCan + ExchCoeffShLeafTmp = 2.0 * VegAreaIndTmp / ResistanceLeafBoundary + GrdHeatCoeff = 1.0 / ResistanceShUndCan + ExchCoeffTot = ExchCoeffShAbvCanTmp + ExchCoeffShLeafTmp + GrdHeatCoeff + TempShGhTmp = (TemperatureAirRefHeight*ExchCoeffShAbvCanTmp + TemperatureGrdVeg*GrdHeatCoeff) / ExchCoeffTot + ExchCoeffShFrac = ExchCoeffShLeafTmp / ExchCoeffTot + ShCoeff = (1.0 - ExchCoeffShFrac) * DensityAirRefHeight * ConstHeatCapacAir * ExchCoeffShLeafTmp + + ! latent heat conductance and coeff above veg. + ExchCoeffLhAbvCan = 1.0 / ResistanceLhAbvCan + ExchCoeffLhEvap = CanopyWetFrac * VegAreaIndTmp / ResistanceLeafBoundary + ExchCoeffLhTransp = (1.0 - CanopyWetFrac) * (LeafAreaIndSunEff/(ResistanceLeafBoundary+ResistanceStomataSunlit) + & + LeafAreaIndShdEff/(ResistanceLeafBoundary+ResistanceStomataShade)) + ExchCoeffLhUndCan = 1.0 / (ResistanceLhUndCan + ResistanceGrdEvap) + ExchCoeffTot = ExchCoeffLhAbvCan + ExchCoeffLhEvap + ExchCoeffLhTransp + ExchCoeffLhUndCan + VapPresLhTot = (PressureVaporRefHeight*ExchCoeffLhAbvCan + VapPresSatGrdVeg*ExchCoeffLhUndCan ) / ExchCoeffTot + ExchCoeffEtFrac = (ExchCoeffLhEvap + ExchCoeffLhTransp) / ExchCoeffTot + LhCoeff = (1.0 - ExchCoeffEtFrac) * ExchCoeffLhEvap * DensityAirRefHeight * & + ConstHeatCapacAir / PsychConstCanopy ! Barlage: change to vegetation v3.6 + TranspHeatCoeff = (1.0 - ExchCoeffEtFrac) * ExchCoeffLhTransp * DensityAirRefHeight * & + ConstHeatCapacAir / PsychConstCanopy + + ! evaluate surface fluxes with current temperature and solve for temperature change + TemperatureCanopyAir = TempShGhTmp + ExchCoeffShFrac * TemperatureCanopy ! canopy air T. + PressureVaporCanAir = VapPresLhTot + ExchCoeffEtFrac * VapPresSatCanopy ! canopy air e + RadLwNetCanopy = VegFrac * (LwCoeffAir + LwCoeffCan * TemperatureCanopy**4) + HeatSensibleCanopy = VegFrac * DensityAirRefHeight * ConstHeatCapacAir * & + ExchCoeffShLeafTmp * (TemperatureCanopy - TemperatureCanopyAir) + HeatLatentCanEvap = VegFrac * DensityAirRefHeight * ConstHeatCapacAir * ExchCoeffLhEvap * & + (VapPresSatCanopy - PressureVaporCanAir) / PsychConstCanopy ! Barlage: change to v in v3.6 + HeatLatentCanTransp = VegFrac * DensityAirRefHeight * ConstHeatCapacAir * ExchCoeffLhTransp * & + (VapPresSatCanopy - PressureVaporCanAir) / PsychConstCanopy + if ( TemperatureCanopy > ConstFreezePoint ) then + HeatLatentCanEvap = min(CanopyLiqWater*LatHeatVapCanopy/MainTimeStep, HeatLatentCanEvap) ! Barlage: add if block for canopy ice in v3.6 + else + HeatLatentCanEvap = min(CanopyIce*LatHeatVapCanopy/MainTimeStep, HeatLatentCanEvap) + endif + ! canopy heat capacity + HeatCapacCan = HeatCapacCanFac*VegAreaIndTmp*ConstHeatCapacWater + CanopyLiqWater*ConstHeatCapacWater/ConstDensityWater + & + CanopyIce*ConstHeatCapacIce/ConstDensityIce ! [J/m2/K] + ! compute vegetation temperature change + EnergyResTmp = RadSwAbsVeg - RadLwNetCanopy - HeatSensibleCanopy - & + HeatLatentCanEvap - HeatLatentCanTransp + HeatPrecipAdvCanopy + FluxTotCoeff = VegFrac * (4.0*LwCoeffCan*TemperatureCanopy**3 + ShCoeff + & + (LhCoeff+TranspHeatCoeff)*VapPresSatCanTempD + HeatCapacCan/MainTimeStep) ! volumetric heat capacity + TemperatureCanChg = EnergyResTmp / FluxTotCoeff + ! update fluxes with temperature change + RadLwNetCanopy = RadLwNetCanopy + VegFrac * 4.0 * LwCoeffCan * TemperatureCanopy**3 * TemperatureCanChg + HeatSensibleCanopy = HeatSensibleCanopy + VegFrac * ShCoeff * TemperatureCanChg + HeatLatentCanEvap = HeatLatentCanEvap + VegFrac * LhCoeff * VapPresSatCanTempD * TemperatureCanChg + HeatLatentCanTransp = HeatLatentCanTransp + VegFrac * TranspHeatCoeff * VapPresSatCanTempD * TemperatureCanChg + HeatCanStorageChg = VegFrac * HeatCapacCan / MainTimeStep * TemperatureCanChg ! canopy heat storage change [W/m2] + ! update vegetation temperature + TemperatureCanopy = TemperatureCanopy + TemperatureCanChg + !TemperatureCanopyAir = TempShGhTmp + ExchCoeffShFrac * TemperatureCanopy ! canopy air T; update here for consistency + + ! for computing M-O length in the next iteration + ShCanTmp = DensityAirRefHeight * ConstHeatCapacAir * (TemperatureCanopyAir-TemperatureAirRefHeight) / ResistanceShAbvCan + ShGrdTmp = DensityAirRefHeight * ConstHeatCapacAir * (TemperatureGrdVeg-TemperatureCanopyAir) / ResistanceShUndCan + + ! consistent specific humidity from canopy air vapor pressure + SpecHumiditySfc = (0.622 * PressureVaporCanAir) / (PressureAirRefHeight - 0.378 * PressureVaporCanAir) + if ( LastIter == 1 ) then + exit loop1 + endif + if ( (IndIter >= 5) .and. (abs(TemperatureCanChg) <= 0.01) .and. (LastIter == 0) ) then + LastIter = 1 + endif + enddo loop1 ! end stability iteration + + ! under-canopy fluxes and ground temperature + LwCoeffAir = -EmissivityGrd * (1.0 - EmissivityVeg) * RadLwDownRefHeight - & + EmissivityGrd * EmissivityVeg * ConstStefanBoltzmann * TemperatureCanopy**4 + LwCoeffCan = EmissivityGrd * ConstStefanBoltzmann + ShCoeff = DensityAirRefHeight * ConstHeatCapacAir / ResistanceShUndCan + LhCoeff = DensityAirRefHeight * ConstHeatCapacAir / (PsychConstGrd * (ResistanceLhUndCan+ResistanceGrdEvap)) ! Barlage: change to ground v3.6 + GrdHeatCoeff = 2.0 * ThermConductSoilSnow(NumSnowLayerNeg+1) / ThicknessSnowSoilLayer(NumSnowLayerNeg+1) + ! begin stability iteration + loop2: do IndIter = 1, NumIterG + TempTmp = TempUnitConv(TemperatureGrdVeg) + call VaporPressureSaturation(TempTmp, VapPresSatWatTmp, VapPresSatIceTmp, VapPresSatWatTmpD, VapPresSatIceTmpD) + if ( TempTmp > 0.0 ) then + VapPresSatGrdVeg = VapPresSatWatTmp + VapPresSatGrdVegTempD = VapPresSatWatTmpD + else + VapPresSatGrdVeg = VapPresSatIceTmp + VapPresSatGrdVegTempD = VapPresSatIceTmpD + endif + RadLwNetVegGrd = LwCoeffCan * TemperatureGrdVeg**4 + LwCoeffAir + HeatSensibleVegGrd = ShCoeff * (TemperatureGrdVeg - TemperatureCanopyAir) + HeatLatentVegGrd = LhCoeff * (VapPresSatGrdVeg*RelHumidityGrd - PressureVaporCanAir) + HeatGroundVegGrd = GrdHeatCoeff * (TemperatureGrdVeg - TemperatureSoilSnow(NumSnowLayerNeg+1)) + EnergyResTmp = RadSwAbsGrd - RadLwNetVegGrd - HeatSensibleVegGrd - & + HeatLatentVegGrd - HeatGroundVegGrd + HeatPrecipAdvVegGrd + FluxTotCoeff = 4.0 * LwCoeffCan * TemperatureGrdVeg**3 + ShCoeff + LhCoeff*VapPresSatGrdVegTempD + GrdHeatCoeff + TemperatureGrdChg = EnergyResTmp / FluxTotCoeff + RadLwNetVegGrd = RadLwNetVegGrd + 4.0 * LwCoeffCan * TemperatureGrdVeg**3 * TemperatureGrdChg + HeatSensibleVegGrd = HeatSensibleVegGrd + ShCoeff * TemperatureGrdChg + HeatLatentVegGrd = HeatLatentVegGrd + LhCoeff * VapPresSatGrdVegTempD * TemperatureGrdChg + HeatGroundVegGrd = HeatGroundVegGrd + GrdHeatCoeff * TemperatureGrdChg + TemperatureGrdVeg = TemperatureGrdVeg + TemperatureGrdChg + enddo loop2 + !TemperatureCanopyAir = (ExchCoeffShAbvCanTmp*TemperatureAirRefHeight + ExchCoeffShLeafTmp*TemperatureCanopy + & + ! GrdHeatCoeff*TemperatureGrdVeg)/(ExchCoeffShAbvCanTmp + ExchCoeffShLeafTmp + GrdHeatCoeff) + + ! if snow on ground and TemperatureGrdVeg > freezing point: reset TemperatureGrdVeg = freezing point. reevaluate ground fluxes. + if ( (OptSnowSoilTempTime == 1) .or. (OptSnowSoilTempTime == 3) ) then + if ( (SnowDepth > 0.05) .and. (TemperatureGrdVeg > ConstFreezePoint) ) then + if ( OptSnowSoilTempTime == 1 ) & + TemperatureGrdVeg = ConstFreezePoint + if ( OptSnowSoilTempTime == 3 ) & + TemperatureGrdVeg = (1.0 - SnowCoverFrac) * TemperatureGrdVeg + SnowCoverFrac * ConstFreezePoint ! MB: allow TemperatureGrdVeg>0C during melt v3.7 + + RadLwNetVegGrd = LwCoeffCan * TemperatureGrdVeg**4 - EmissivityGrd * (1.0-EmissivityVeg) * RadLwDownRefHeight - & + EmissivityGrd * EmissivityVeg * ConstStefanBoltzmann * TemperatureCanopy**4 + HeatSensibleVegGrd = ShCoeff * (TemperatureGrdVeg - TemperatureCanopyAir) + HeatLatentVegGrd = LhCoeff * (VapPresSatGrdVeg*RelHumidityGrd - PressureVaporCanAir) + HeatGroundVegGrd = RadSwAbsGrd + HeatPrecipAdvVegGrd - (RadLwNetVegGrd + HeatSensibleVegGrd + HeatLatentVegGrd) + endif + endif + + ! wind stresses + WindStressEwVeg = -DensityAirRefHeight * ExchCoeffMomAbvCan * WindSpdRefHeight * WindEastwardRefHeight + WindStressNsVeg = -DensityAirRefHeight * ExchCoeffMomAbvCan * WindSpdRefHeight * WindNorthwardRefHeight + + ! consistent vegetation air temperature and vapor pressure + ! since TemperatureGrdVeg is not consistent with the TemperatureCanopyAir/PressureVaporCanAir calculation. + !TemperatureCanopyAir = TemperatureAirRefHeight + (HeatSensibleVegGrd + HeatSensibleCanopy) / & + ! (DensityAirRefHeight*ConstHeatCapacAir*ExchCoeffShAbvCanTmp) + !TemperatureCanopyAir = TemperatureAirRefHeight + (HeatSensibleVegGrd * VegFrac + HeatSensibleCanopy) / & + ! (DensityAirRefHeight*ConstHeatCapacAir*ExchCoeffShAbvCanTmp) ! ground flux need fveg + !PressureVaporCanAir = PressureVaporRefHeight + (HeatLatentCanEvap+VegFrac*(HeatLatentCanTransp+HeatLatentVegGrd)) / & + ! (DensityAirRefHeight*ExchCoeffLhAbvCan*ConstHeatCapacAir/PsychConstGrd) + !MoistureFluxSfc = (SpecHumiditySfc - SpecHumidityRefHeight) * DensityAirRefHeight * ExchCoeffLhAbvCan !*ConstHeatCapacAir/PsychConstGrd + + ! 2m temperature over vegetation ( corrected for low LH exchange coeff values ) + if ( (OptSurfaceDrag == 1) .or. (OptSurfaceDrag == 2) ) then + !ExchCoeffSh2mVeg = FrictionVelVeg * 1.0 / ConstVonKarman * log((2.0+RoughLenShCanopy)/RoughLenShCanopy) + !ExchCoeffSh2mVeg = FrictionVelVeg * ConstVonKarman / log((2.0+RoughLenShCanopy)/RoughLenShCanopy) + ExchCoeffSh2mVeg = FrictionVelVeg * ConstVonKarman / (log((2.0+RoughLenShCanopy)/RoughLenShCanopy) - MoStabCorrShVeg2m) + if ( ExchCoeffSh2mVeg < 1.0e-5 ) then + TemperatureAir2mVeg = TemperatureCanopyAir + !SpecHumidity2mVeg = (PressureVaporCanAir*0.622/(PressureAirRefHeight - 0.378*PressureVaporCanAir)) + SpecHumidity2mVeg = SpecHumiditySfc + else + TemperatureAir2mVeg = TemperatureCanopyAir - (HeatSensibleVegGrd + HeatSensibleCanopy/VegFrac) / & + (DensityAirRefHeight * ConstHeatCapacAir) * 1.0 / ExchCoeffSh2mVeg + !SpecHumidity2mVeg = (PressureVaporCanAir*0.622/(PressureAirRefHeight - 0.378*PressureVaporCanAir)) - & + ! MoistureFluxSfc/(DensityAirRefHeight*FrictionVelVeg)* 1.0/ConstVonKarman * & + ! log((2.0+RoughLenShCanopy)/RoughLenShCanopy) + SpecHumidity2mVeg = SpecHumiditySfc - ((HeatLatentCanEvap+HeatLatentCanTransp)/VegFrac + HeatLatentVegGrd) / & + (LatHeatVapCanopy * DensityAirRefHeight) * 1.0 / ExchCoeffSh2mVeg + endif + endif + + ! update ExchCoeffSh for output + ExchCoeffShAbvCan = ExchCoeffShAbvCanTmp + ExchCoeffShLeaf = ExchCoeffShLeafTmp + ExchCoeffShUndCan = 1.0 / ResistanceShUndCan + + end associate + + end subroutine SurfaceEnergyFluxVegetated + +end module SurfaceEnergyFluxVegetatedMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SurfaceRadiationGlacierMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SurfaceRadiationGlacierMod.F90 new file mode 100644 index 000000000..0d8e2bac7 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SurfaceRadiationGlacierMod.F90 @@ -0,0 +1,65 @@ +module SurfaceRadiationGlacierMod + +!!! Compute glacier surface radiative fluxes (absorption and reflection) + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine SurfaceRadiationGlacier(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: RADIATION_GLACIER +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: IndBand ! waveband indices (1=vis, 2=nir) + real(kind=kind_noahmp) :: RadSwAbsGrdTmp ! ground absorbed solar radiation [W/m2] + real(kind=kind_noahmp) :: RadSwReflGrdTmp ! ground reflected solar radiation [W/m2] + +! ----------------------------------------------------------------- + associate( & + NumSwRadBand => noahmp%config%domain%NumSwRadBand ,& ! in, number of solar radiation wave bands + RadSwDownDir => noahmp%energy%flux%RadSwDownDir ,& ! in, incoming direct solar radiation [W/m2] + RadSwDownDif => noahmp%energy%flux%RadSwDownDif ,& ! in, incoming diffuse solar radiation [W/m2] + AlbedoGrdDir => noahmp%energy%state%AlbedoGrdDir ,& ! in, ground albedo (direct beam: vis, nir) + AlbedoGrdDif => noahmp%energy%state%AlbedoGrdDif ,& ! in, ground albedo (diffuse: vis, nir) + RadSwAbsGrd => noahmp%energy%flux%RadSwAbsGrd ,& ! out, solar radiation absorbed by ground [W/m2] + RadSwAbsSfc => noahmp%energy%flux%RadSwAbsSfc ,& ! out, total absorbed solar radiation [W/m2] + RadSwReflSfc => noahmp%energy%flux%RadSwReflSfc & ! out, total reflected solar radiation [W/m2] + ) +! ---------------------------------------------------------------------- + + ! initialization + RadSwAbsGrd = 0.0 + RadSwAbsSfc = 0.0 + RadSwReflSfc = 0.0 + + do IndBand = 1, NumSwRadBand + ! solar radiation absorbed by glacier surface + RadSwAbsGrdTmp = RadSwDownDir(IndBand) * (1.0 - AlbedoGrdDir(IndBand)) + & + RadSwDownDif(IndBand) * (1.0 - AlbedoGrdDif(IndBand)) + RadSwAbsGrd = RadSwAbsGrd + RadSwAbsGrdTmp + RadSwAbsSfc = RadSwAbsSfc + RadSwAbsGrdTmp + + ! solar radiation reflected by glacier surface + RadSwReflGrdTmp = RadSwDownDir(IndBand) * AlbedoGrdDir(IndBand) + & + RadSwDownDif(IndBand) * AlbedoGrdDif(IndBand) + RadSwReflSfc = RadSwReflSfc + RadSwReflGrdTmp + enddo + + end associate + + end subroutine SurfaceRadiationGlacier + +end module SurfaceRadiationGlacierMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/SurfaceRadiationMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/SurfaceRadiationMod.F90 new file mode 100644 index 000000000..bd9bbb419 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/SurfaceRadiationMod.F90 @@ -0,0 +1,137 @@ +module SurfaceRadiationMod + +!!! Compute surface (ground and vegetation) radiative fluxes (absorption and reflection) + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine SurfaceRadiation(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: SURRAD +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: IndBand ! waveband indices (1=vis, 2=nir) + real(kind=kind_noahmp) :: MinThr ! prevents overflow for division by zero + real(kind=kind_noahmp) :: RadSwAbsGrdTmp ! ground absorbed solar radiation [W/m2] + real(kind=kind_noahmp) :: RadSwReflSfcNir ! surface reflected solar radiation NIR [W/m2] + real(kind=kind_noahmp) :: RadSwReflSfcVis ! surface reflected solar radiation VIS [W/m2] + real(kind=kind_noahmp) :: LeafAreaIndFrac ! leaf area fraction of canopy + real(kind=kind_noahmp) :: RadSwTranGrdDir ! transmitted solar radiation at ground: direct [W/m2] + real(kind=kind_noahmp) :: RadSwTranGrdDif ! transmitted solar radiation at ground: diffuse [W/m2] + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwAbsCanDir ! direct beam absorbed by canopy [W/m2] + real(kind=kind_noahmp), allocatable, dimension(:) :: RadSwAbsCanDif ! diffuse radiation absorbed by canopy [W/m2] + +! -------------------------------------------------------------------- + associate( & + NumSwRadBand => noahmp%config%domain%NumSwRadBand ,& ! in, number of solar radiation wave bands + LeafAreaIndEff => noahmp%energy%state%LeafAreaIndEff ,& ! in, leaf area index, after burying by snow + VegAreaIndEff => noahmp%energy%state%VegAreaIndEff ,& ! in, one-sided leaf+stem area index [m2/m2] + CanopySunlitFrac => noahmp%energy%state%CanopySunlitFrac ,& ! in, sunlit fraction of canopy + CanopyShadeFrac => noahmp%energy%state%CanopyShadeFrac ,& ! in, shaded fraction of canopy + LeafAreaIndSunlit => noahmp%energy%state%LeafAreaIndSunlit ,& ! in, sunlit leaf area + LeafAreaIndShade => noahmp%energy%state%LeafAreaIndShade ,& ! in, shaded leaf area + RadSwDownDir => noahmp%energy%flux%RadSwDownDir ,& ! in, incoming direct solar radiation [W/m2] + RadSwDownDif => noahmp%energy%flux%RadSwDownDif ,& ! in, incoming diffuse solar radiation [W/m2] + RadSwAbsVegDir => noahmp%energy%flux%RadSwAbsVegDir ,& ! in, flux abs by veg (per unit direct flux) + RadSwAbsVegDif => noahmp%energy%flux%RadSwAbsVegDif ,& ! in, flux abs by veg (per unit diffuse flux) + RadSwDirTranGrdDir => noahmp%energy%flux%RadSwDirTranGrdDir ,& ! in, down direct flux below veg (per unit dir flux) + RadSwDifTranGrdDir => noahmp%energy%flux%RadSwDifTranGrdDir ,& ! in, down diffuse flux below veg (per unit dir flux) + RadSwDifTranGrdDif => noahmp%energy%flux%RadSwDifTranGrdDif ,& ! in, down diffuse flux below veg (per unit dif flux) + AlbedoGrdDir => noahmp%energy%state%AlbedoGrdDir ,& ! in, ground albedo (direct beam: vis, nir) + AlbedoGrdDif => noahmp%energy%state%AlbedoGrdDif ,& ! in, ground albedo (diffuse: vis, nir) + AlbedoSfcDir => noahmp%energy%state%AlbedoSfcDir ,& ! in, surface albedo (direct) + AlbedoSfcDif => noahmp%energy%state%AlbedoSfcDif ,& ! in, surface albedo (diffuse) + RadSwReflVegDir => noahmp%energy%flux%RadSwReflVegDir ,& ! in, flux reflected by veg layer (per unit direct flux) + RadSwReflVegDif => noahmp%energy%flux%RadSwReflVegDif ,& ! in, flux reflected by veg layer (per unit diffuse flux) + RadSwReflGrdDir => noahmp%energy%flux%RadSwReflGrdDir ,& ! in, flux reflected by ground (per unit direct flux) + RadSwReflGrdDif => noahmp%energy%flux%RadSwReflGrdDif ,& ! in, flux reflected by ground (per unit diffuse flux) + RadPhotoActAbsSunlit => noahmp%energy%flux%RadPhotoActAbsSunlit ,& ! out, average absorbed par for sunlit leaves [W/m2] + RadPhotoActAbsShade => noahmp%energy%flux%RadPhotoActAbsShade ,& ! out, average absorbed par for shaded leaves [W/m2] + RadSwAbsVeg => noahmp%energy%flux%RadSwAbsVeg ,& ! out, solar radiation absorbed by vegetation [W/m2] + RadSwAbsGrd => noahmp%energy%flux%RadSwAbsGrd ,& ! out, solar radiation absorbed by ground [W/m2] + RadSwAbsSfc => noahmp%energy%flux%RadSwAbsSfc ,& ! out, total absorbed solar radiation [W/m2] + RadSwReflSfc => noahmp%energy%flux%RadSwReflSfc ,& ! out, total reflected solar radiation [W/m2] + RadSwReflVeg => noahmp%energy%flux%RadSwReflVeg ,& ! out, reflected solar radiation by vegetation [W/m2] + RadSwReflGrd => noahmp%energy%flux%RadSwReflGrd & ! out, reflected solar radiation by ground [W/m2] + ) +! ---------------------------------------------------------------------- + + ! initialization + if (.not. allocated(RadSwAbsCanDir)) allocate(RadSwAbsCanDir(1:NumSwRadBand)) + if (.not. allocated(RadSwAbsCanDif)) allocate(RadSwAbsCanDif(1:NumSwRadBand)) + MinThr = 1.0e-6 + RadSwAbsCanDir = 0.0 + RadSwAbsCanDif = 0.0 + RadSwAbsGrd = 0.0 + RadSwAbsVeg = 0.0 + RadSwAbsSfc = 0.0 + RadSwReflSfc = 0.0 + RadSwReflVeg = 0.0 + RadSwReflGrd = 0.0 + RadPhotoActAbsSunlit = 0.0 + RadPhotoActAbsShade = 0.0 + + do IndBand = 1, NumSwRadBand + ! absorbed by canopy + RadSwAbsCanDir(IndBand) = RadSwDownDir(IndBand) * RadSwAbsVegDir(IndBand) + RadSwAbsCanDif(IndBand) = RadSwDownDif(IndBand) * RadSwAbsVegDif(IndBand) + RadSwAbsVeg = RadSwAbsVeg + RadSwAbsCanDir(IndBand) + RadSwAbsCanDif(IndBand) + RadSwAbsSfc = RadSwAbsSfc + RadSwAbsCanDir(IndBand) + RadSwAbsCanDif(IndBand) + ! transmitted solar fluxes incident on ground + RadSwTranGrdDir = RadSwDownDir(IndBand) * RadSwDirTranGrdDir(IndBand) + RadSwTranGrdDif = RadSwDownDir(IndBand) * RadSwDifTranGrdDir(IndBand) + & + RadSwDownDif(IndBand) * RadSwDifTranGrdDif(IndBand) + ! solar radiation absorbed by ground surface + RadSwAbsGrdTmp = RadSwTranGrdDir * (1.0 - AlbedoGrdDir(IndBand)) + & + RadSwTranGrdDif * (1.0 - AlbedoGrdDif(IndBand)) + RadSwAbsGrd = RadSwAbsGrd + RadSwAbsGrdTmp + RadSwAbsSfc = RadSwAbsSfc + RadSwAbsGrdTmp + enddo + + ! partition visible canopy absorption to sunlit and shaded fractions + ! to get average absorbed par for sunlit and shaded leaves + LeafAreaIndFrac = LeafAreaIndEff / max(VegAreaIndEff, MinThr) + if ( CanopySunlitFrac > 0.0 ) then + RadPhotoActAbsSunlit = (RadSwAbsCanDir(1) + CanopySunlitFrac * RadSwAbsCanDif(1)) * & + LeafAreaIndFrac / max(LeafAreaIndSunlit, MinThr) + RadPhotoActAbsShade = (CanopyShadeFrac * RadSwAbsCanDif(1)) * & + LeafAreaIndFrac / max(LeafAreaIndShade, MinThr) + else + RadPhotoActAbsSunlit = 0.0 + RadPhotoActAbsShade = (RadSwAbsCanDir(1) + RadSwAbsCanDif(1)) * & + LeafAreaIndFrac / max(LeafAreaIndShade, MinThr) + endif + + ! reflected solar radiation + RadSwReflSfcVis = AlbedoSfcDir(1) * RadSwDownDir(1) + AlbedoSfcDif(1) * RadSwDownDif(1) + RadSwReflSfcNir = AlbedoSfcDir(2) * RadSwDownDir(2) + AlbedoSfcDif(2) * RadSwDownDif(2) + RadSwReflSfc = RadSwReflSfcVis + RadSwReflSfcNir + + ! reflected solar radiation of veg. and ground (combined ground) + RadSwReflVeg = RadSwReflVegDir(1)*RadSwDownDir(1) + RadSwReflVegDif(1)*RadSwDownDif(1) + & + RadSwReflVegDir(2)*RadSwDownDir(2) + RadSwReflVegDif(2)*RadSwDownDif(2) + RadSwReflGrd = RadSwReflGrdDir(1)*RadSwDownDir(1) + RadSwReflGrdDif(1)*RadSwDownDif(1) + & + RadSwReflGrdDir(2)*RadSwDownDir(2) + RadSwReflGrdDif(2)*RadSwDownDif(2) + + ! deallocate local arrays to avoid memory leaks + deallocate(RadSwAbsCanDir) + deallocate(RadSwAbsCanDif) + + end associate + + end subroutine SurfaceRadiation + +end module SurfaceRadiationMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/TileDrainageEquiDepthMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/TileDrainageEquiDepthMod.F90 new file mode 100644 index 000000000..df7785639 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/TileDrainageEquiDepthMod.F90 @@ -0,0 +1,69 @@ +module TileDrainageEquiDepthMod + +!!! Calculate tile drainage equivalent depth (currently used in Hooghoudt's scheme) + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine TileDrainageEquiDepth(DrainDepthToImp, DrainTubeDist, DrainTubeRadius, DrainWatHgtAbvImp) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: TD_EQUIVALENT_DEPTH +! Original code: P. Valayamkunnath (NCAR) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! in & out variables + real(kind=kind_noahmp), intent(in) :: DrainDepthToImp ! tile drainage depth to impermeable layer [m] + real(kind=kind_noahmp), intent(in) :: DrainTubeDist ! distance between two drain tubes or tiles [m] + real(kind=kind_noahmp), intent(in) :: DrainTubeRadius ! effective radius of drains [m] + real(kind=kind_noahmp), intent(out) :: DrainWatHgtAbvImp ! Height of water table in drain Above Impermeable Layer [m] + +! local variables + integer :: LoopInd ! loop index + real(kind=kind_noahmp) :: PiMath = 22.0/7.0 ! pi value + real(kind=kind_noahmp) :: DrainAspect ! temporary drain variable + real(kind=kind_noahmp) :: DrainFac ! temporary drain factor + real(kind=kind_noahmp) :: DrainExpFac ! temporary drain exponential factor + real(kind=kind_noahmp) :: DrainFacTmp ! temporary drain factor + +! ---------------------------------------------------------------------- + + ! initialization + DrainFac = 0.0 + DrainExpFac = 0.0 + DrainFacTmp = 0.0 + DrainAspect = (2.0 * PiMath * DrainDepthToImp) / DrainTubeDist + + ! compute tile drainage equivalent depth + if ( DrainAspect > 0.5 ) then + do LoopInd = 1, 45, 2 + DrainExpFac = exp(-2.0 * LoopInd * DrainAspect) + DrainFacTmp = (4.0 * DrainExpFac) / (LoopInd * (1.0-DrainExpFac)) + DrainFac = DrainFac + DrainFacTmp + if ( DrainFacTmp < 1.0e-6 ) then + DrainWatHgtAbvImp = ((PiMath*DrainTubeDist) / 8.0) / & + (log(DrainTubeDist/(PiMath*DrainTubeRadius)) + DrainFac) + exit + endif + enddo + elseif ( DrainAspect < 1.0e-8 ) then + DrainWatHgtAbvImp = DrainDepthToImp + else + DrainFac = ((PiMath*PiMath)/(4.0*DrainAspect)) + (log(DrainAspect/(2.0*PiMath))) + DrainWatHgtAbvImp = ((PiMath*DrainTubeDist) / 8.0) / & + (log(DrainTubeDist/(PiMath*DrainTubeRadius)) + DrainFac) + endif + + if ( (DrainWatHgtAbvImp < 0.0) .and. (LoopInd <= 2) ) DrainWatHgtAbvImp = DrainDepthToImp + + end subroutine TileDrainageEquiDepth + +end module TileDrainageEquiDepthMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/TileDrainageHooghoudtMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/TileDrainageHooghoudtMod.F90 new file mode 100644 index 000000000..4642a590e --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/TileDrainageHooghoudtMod.F90 @@ -0,0 +1,188 @@ +module TileDrainageHooghoudtMod + +!!! Calculate tile drainage discharge [mm] based on Hooghoudt's equation + + use Machine + use NoahmpVarType + use ConstantDefineMod + use TileDrainageEquiDepthMod, only : TileDrainageEquiDepth + use WaterTableDepthSearchMod, only : WaterTableDepthSearch + use WaterTableEquilibriumMod, only : WaterTableEquilibrium + + implicit none + +contains + + subroutine TileDrainageHooghoudt(noahmp) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: TILE_HOOGHOUDT +! Original code: P. Valayamkunnath (NCAR) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: IndSoil ! soil layer loop index + integer :: NumDrain ! number of drains + real(kind=kind_noahmp) :: ThickSatZoneTot ! total thickness of saturated zone + real(kind=kind_noahmp) :: LateralFlow ! lateral flow + real(kind=kind_noahmp) :: DepthToLayerTop ! depth to top of the layer + real(kind=kind_noahmp) :: WatTblTmp1 ! temporary water table variable + real(kind=kind_noahmp) :: WatTblTmp2 ! temporary water table variable + real(kind=kind_noahmp) :: LateralWatCondAve ! average lateral hydruaic conductivity + real(kind=kind_noahmp) :: DrainWatHgtAbvImp ! Height of water table in the drain Above Impermeable Layer + real(kind=kind_noahmp) :: DepthSfcToImp ! Effective Depth to impermeable layer from soil surface + real(kind=kind_noahmp) :: HgtDrnToWatTbl ! Effective Height between water level in drains to water table MiDpoint + real(kind=kind_noahmp) :: DrainCoeffTmp ! Drainage Coefficient + real(kind=kind_noahmp) :: TileDrainTmp ! temporary drainage discharge + real(kind=kind_noahmp) :: DrainDepthToImpTmp ! drain depth to impermeable layer + real(kind=kind_noahmp) :: WatExcFieldCapTot ! amount of water over field capacity + real(kind=kind_noahmp), allocatable, dimension(:) :: ThickSatZone ! thickness of saturated zone + real(kind=kind_noahmp), allocatable, dimension(:) :: LateralWatCondTmp ! lateral hydraulic ocnductivity kth layer + real(kind=kind_noahmp), allocatable, dimension(:) :: WatExcFieldCapTmp ! layer-wise amount of water over field capacity + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilLiqWaterAftDrain ! remaining water after tile drain + +! ---------------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth [m] of layer-bottom from soil surface + SoilTimeStep => noahmp%config%domain%SoilTimeStep ,& ! in, noahmp soil timestep [s] + GridSize => noahmp%config%domain%GridSize ,& ! in, noahmp model grid spacing [m] + ThicknessSoilLayer => noahmp%config%domain%ThicknessSoilLayer ,& ! in, soil layer thickness [m] + SoilMoistureFieldCap => noahmp%water%param%SoilMoistureFieldCap ,& ! in, reference soil moisture (field capacity) [m3/m3] + TileDrainCoeff => noahmp%water%param%TileDrainCoeff ,& ! in, drainage coefficent [m/day] + DrainDepthToImperv => noahmp%water%param%DrainDepthToImperv ,& ! in, Actual depth to impermeable layer from surface [m] + LateralWatCondFac => noahmp%water%param%LateralWatCondFac ,& ! in, multiplication factor to determine lateral hydraulic conductivity + TileDrainDepth => noahmp%water%param%TileDrainDepth ,& ! in, Depth of drain [m] + DrainTubeDist => noahmp%water%param%DrainTubeDist ,& ! in, distance between two drain tubes or tiles [m] + DrainTubeRadius => noahmp%water%param%DrainTubeRadius ,& ! in, effective radius of drains [m] + SoilWatConductivity => noahmp%water%state%SoilWatConductivity ,& ! in, soil hydraulic conductivity [m/s] + SoilIce => noahmp%water%state%SoilIce ,& ! in, soil ice content [m3/m3] + WaterTableHydro => noahmp%water%state%WaterTableHydro ,& ! in, water table depth estimated in WRF-Hydro fine grids [m] + SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! inout, soil water content [m3/m3] + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! inout, total soil moisture [m3/m3] + WaterTableDepth => noahmp%water%state%WaterTableDepth ,& ! inout, water table depth [m] + TileDrain => noahmp%water%flux%TileDrain & ! inout, tile drainage [mm/s] + ) +! ---------------------------------------------------------------------- + + ! initialization + if (.not. allocated(ThickSatZone) ) allocate(ThickSatZone (1:NumSoilLayer)) + if (.not. allocated(LateralWatCondTmp) ) allocate(LateralWatCondTmp (1:NumSoilLayer)) + if (.not. allocated(WatExcFieldCapTmp) ) allocate(WatExcFieldCapTmp (1:NumSoilLayer)) + if (.not. allocated(SoilLiqWaterAftDrain)) allocate(SoilLiqWaterAftDrain(1:NumSoilLayer)) + ThickSatZone = 0.0 + LateralWatCondTmp = 0.0 + WatExcFieldCapTmp = 0.0 + SoilLiqWaterAftDrain = 0.0 + DepthToLayerTop = 0.0 + LateralFlow = 0.0 + ThickSatZoneTot = 0.0 + DrainCoeffTmp = TileDrainCoeff * 1000.0 * SoilTimeStep / (24.0 * 3600.0) ! m per day to mm per timestep + + ! Thickness of soil layers + do IndSoil = 1, NumSoilLayer + if ( IndSoil == 1 ) then + ThicknessSoilLayer(IndSoil) = -1.0 * DepthSoilLayer(IndSoil) + else + ThicknessSoilLayer(IndSoil) = (DepthSoilLayer(IndSoil-1) - DepthSoilLayer(IndSoil)) + endif + enddo + +#ifdef WRF_HYDRO + ! Depth to water table from WRF-HYDRO, m + WatTblTmp2 = WaterTableHydro +#else + call WaterTableDepthSearch(noahmp) + !call WaterTableEquilibrium(noahmp) + WatTblTmp2 = WaterTableDepth +#endif + + if ( WatTblTmp2 > DrainDepthToImperv) WatTblTmp2 = DrainDepthToImperv + + ! Depth of saturated zone + do IndSoil = 1, NumSoilLayer + if ( WatTblTmp2 > (-1.0*DepthSoilLayer(IndSoil)) ) then + ThickSatZone(IndSoil) = 0.0 + else + ThickSatZone(IndSoil) = (-1.0 * DepthSoilLayer(IndSoil)) - WatTblTmp2 + WatTblTmp1 = (-1.0 * DepthSoilLayer(IndSoil)) - DepthToLayerTop + if ( ThickSatZone(IndSoil) > WatTblTmp1 ) ThickSatZone(IndSoil) = WatTblTmp1 + endif + DepthToLayerTop = -1.0 * DepthSoilLayer(IndSoil) + enddo + + ! amount of water over field capacity + WatExcFieldCapTot = 0.0 + do IndSoil = 1, NumSoilLayer + WatExcFieldCapTmp(IndSoil) = (SoilLiqWater(IndSoil) - (SoilMoistureFieldCap(IndSoil)-SoilIce(IndSoil))) * & + ThicknessSoilLayer(IndSoil) * 1000.0 + if ( WatExcFieldCapTmp(IndSoil) < 0.0 ) WatExcFieldCapTmp(IndSoil) = 0.0 + WatExcFieldCapTot = WatExcFieldCapTot + WatExcFieldCapTmp(IndSoil) + enddo + + ! lateral hydraulic conductivity and total lateral flow + do IndSoil = 1, NumSoilLayer + LateralWatCondTmp(IndSoil) = SoilWatConductivity(IndSoil) * LateralWatCondFac * SoilTimeStep ! m/s to m/timestep + LateralFlow = LateralFlow + (ThickSatZone(IndSoil) * LateralWatCondTmp(IndSoil)) + ThickSatZoneTot = ThickSatZoneTot + ThickSatZone(IndSoil) + enddo + if ( ThickSatZoneTot < 0.001 ) ThickSatZoneTot = 0.001 ! unit is m + if ( LateralFlow < 0.001 ) LateralFlow = 0.0 ! unit is m + LateralWatCondAve = LateralFlow / ThickSatZoneTot ! lateral hydraulic conductivity per timestep + DrainDepthToImpTmp = DrainDepthToImperv - TileDrainDepth + + call TileDrainageEquiDepth(DrainDepthToImpTmp, DrainTubeDist, DrainTubeRadius, DrainWatHgtAbvImp) + + DepthSfcToImp = DrainWatHgtAbvImp + TileDrainDepth + HgtDrnToWatTbl = TileDrainDepth - WatTblTmp2 + if ( HgtDrnToWatTbl <= 0.0 ) then + TileDrain = 0.0 + else + TileDrain = ((8.0*LateralWatCondAve*DrainWatHgtAbvImp*HgtDrnToWatTbl) + & + (4.0*LateralWatCondAve*HgtDrnToWatTbl*HgtDrnToWatTbl)) / (DrainTubeDist*DrainTubeDist) + endif + TileDrain = TileDrain * 1000.0 ! m per timestep to mm/timestep /one tile + if ( TileDrain <= 0.0 ) TileDrain = 0.0 + if ( TileDrain > DrainCoeffTmp ) TileDrain = DrainCoeffTmp + NumDrain = int(GridSize / DrainTubeDist) + TileDrain = TileDrain * NumDrain + if ( TileDrain > WatExcFieldCapTot ) TileDrain = WatExcFieldCapTot + + ! update soil moisture after drainage: moisture drains from top to bottom + TileDrainTmp = TileDrain + do IndSoil = 1, NumSoilLayer + if ( TileDrainTmp > 0.0) then + if ( (ThickSatZone(IndSoil) > 0.0) .and. (WatExcFieldCapTmp(IndSoil) > 0.0) ) then + SoilLiqWaterAftDrain(IndSoil) = WatExcFieldCapTmp(IndSoil) - TileDrainTmp ! remaining water after tile drain + if ( SoilLiqWaterAftDrain(IndSoil) > 0.0 ) then + SoilLiqWater(IndSoil) = (SoilMoistureFieldCap(IndSoil) - SoilIce(IndSoil)) + & + SoilLiqWaterAftDrain(IndSoil) / (ThicknessSoilLayer(IndSoil) * 1000.0) + SoilMoisture(IndSoil) = SoilLiqWater(IndSoil) + SoilIce(IndSoil) + exit + else + SoilLiqWater(IndSoil) = SoilMoistureFieldCap(IndSoil) - SoilIce(IndSoil) + SoilMoisture(IndSoil) = SoilLiqWater(IndSoil) + SoilIce (IndSoil) + TileDrainTmp = TileDrainTmp - WatExcFieldCapTmp(IndSoil) + endif + endif + endif + enddo + + TileDrain = TileDrain / SoilTimeStep ! mm/s + + ! deallocate local arrays to avoid memory leaks + deallocate(ThickSatZone ) + deallocate(LateralWatCondTmp ) + deallocate(WatExcFieldCapTmp ) + deallocate(SoilLiqWaterAftDrain) + + end associate + + end subroutine TileDrainageHooghoudt + +end module TileDrainageHooghoudtMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/TileDrainageSimpleMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/TileDrainageSimpleMod.F90 new file mode 100644 index 000000000..d482a4dcb --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/TileDrainageSimpleMod.F90 @@ -0,0 +1,213 @@ +module TileDrainageSimpleMod + +!!! Calculate tile drainage discharge [mm] based on simple model + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine TileDrainageSimple(noahmp) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: TILE_DRAIN +! Original code: P. Valayamkunnath (NCAR) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: IndSoil ! soil layer loop index + real(kind=kind_noahmp) :: DrainWatVolTot ! temporary variable for drainage volume [mm] + real(kind=kind_noahmp) :: DrainCoeffTmp ! temporary variable for drainage + real(kind=kind_noahmp) :: DrainWatTmp ! temporary variable for drainage + real(kind=kind_noahmp), allocatable, dimension(:) :: WatExcFieldCap ! temp variable for volume of water above field capacity + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilFieldCapLiq ! Available field capacity = field capacity - SoilIce [m3/m3] + real(kind=kind_noahmp), allocatable, dimension(:) :: DrainFracTmp ! tile drainage fraction + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth [m] of layer-bottom from soil surface + SoilTimeStep => noahmp%config%domain%SoilTimeStep ,& ! in, noahmp soil timestep [s] + ThicknessSoilLayer => noahmp%config%domain%ThicknessSoilLayer ,& ! in, soil layer thickness [m] + TileDrainCoeffSp => noahmp%water%param%TileDrainCoeffSp ,& ! in, drainage coefficient [mm/d] + DrainSoilLayerInd => noahmp%water%param%DrainSoilLayerInd ,& ! in, starting soil layer for drainage + TileDrainTubeDepth => noahmp%water%param%TileDrainTubeDepth ,& ! in, depth of drain tube from the soil surface + DrainFacSoilWat => noahmp%water%param%DrainFacSoilWat ,& ! in, drainage factor for soil moisture + SoilMoistureFieldCap => noahmp%water%param%SoilMoistureFieldCap ,& ! in, reference soil moisture (field capacity) [m3/m3] + SoilIce => noahmp%water%state%SoilIce ,& ! in, soil ice content [m3/m3] + SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! inout, soil water content [m3/m3] + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! inout, total soil moisture [m3/m3] + TileDrain => noahmp%water%flux%TileDrain & ! out, tile drainage [mm/s] + ) +! ---------------------------------------------------------------------- + + ! initialization + if (.not. allocated(DrainFracTmp) ) allocate(DrainFracTmp (1:NumSoilLayer)) + if (.not. allocated(SoilFieldCapLiq)) allocate(SoilFieldCapLiq(1:NumSoilLayer)) + if (.not. allocated(WatExcFieldCap) ) allocate(WatExcFieldCap (1:NumSoilLayer)) + DrainFracTmp = 0.0 + SoilFieldCapLiq = 0.0 + DrainWatVolTot = 0.0 + WatExcFieldCap = 0.0 + TileDrain = 0.0 + ThicknessSoilLayer = 0.0 + DrainWatTmp = 0.0 + DrainFracTmp = 0.0 + DrainCoeffTmp = TileDrainCoeffSp * SoilTimeStep / (24.0 * 3600.0) + + do IndSoil = 1, NumSoilLayer + if ( IndSoil == 1 ) then + ThicknessSoilLayer(IndSoil) = -1.0 * DepthSoilLayer(IndSoil) + else + ThicknessSoilLayer(IndSoil) = DepthSoilLayer(IndSoil-1) - DepthSoilLayer(IndSoil) + endif + enddo + if ( DrainSoilLayerInd == 0 ) then ! drainage from one specified layer in NoahmpTable.TBL + IndSoil = TileDrainTubeDepth + SoilFieldCapLiq(IndSoil) = SoilMoistureFieldCap(IndSoil) - SoilIce (IndSoil) + WatExcFieldCap(IndSoil) = (SoilLiqWater(IndSoil) - (DrainFacSoilWat*SoilFieldCapLiq(IndSoil))) * & + ThicknessSoilLayer(IndSoil) * 1000.0 ! mm + if ( WatExcFieldCap(IndSoil) > 0.0 ) then + if ( WatExcFieldCap(IndSoil) > DrainCoeffTmp ) WatExcFieldCap(IndSoil) = DrainCoeffTmp + DrainWatVolTot = DrainWatVolTot + WatExcFieldCap(IndSoil) + SoilLiqWater(IndSoil) = SoilLiqWater(IndSoil) - & + (WatExcFieldCap(IndSoil) / (ThicknessSoilLayer(IndSoil) * 1000.0)) + SoilMoisture(IndSoil) = SoilLiqWater(IndSoil) + SoilIce (IndSoil) + endif + else if ( DrainSoilLayerInd == 1 ) then + do IndSoil = 1, 2 + SoilFieldCapLiq(IndSoil) = SoilMoistureFieldCap(IndSoil) - SoilIce (IndSoil) + WatExcFieldCap(IndSoil) = (SoilLiqWater(IndSoil) - (DrainFacSoilWat*SoilFieldCapLiq(IndSoil))) * & + ThicknessSoilLayer(IndSoil) * 1000.0 ! mm + if ( WatExcFieldCap(IndSoil) < 0.0 ) WatExcFieldCap(IndSoil) = 0.0 + DrainWatTmp = DrainWatTmp + WatExcFieldCap(IndSoil) + enddo + do IndSoil = 1, 2 + if ( WatExcFieldCap(IndSoil) /= 0.0 ) then + DrainFracTmp(IndSoil) = WatExcFieldCap(IndSoil) / DrainWatTmp + endif + enddo + if ( DrainWatTmp > 0.0 ) then + if ( DrainWatTmp > DrainCoeffTmp ) DrainWatTmp = DrainCoeffTmp + DrainWatVolTot = DrainWatVolTot + DrainWatTmp + do IndSoil = 1, 2 + WatExcFieldCap(IndSoil) = DrainFracTmp(IndSoil) * DrainWatTmp + SoilLiqWater(IndSoil) = SoilLiqWater(IndSoil) - & + (WatExcFieldCap(IndSoil) / (ThicknessSoilLayer(IndSoil) * 1000.0)) + SoilMoisture(IndSoil) = SoilLiqWater(IndSoil) + SoilIce (IndSoil) + enddo + endif + else if ( DrainSoilLayerInd == 2 ) then + do IndSoil = 1, 3 + SoilFieldCapLiq(IndSoil) = SoilMoistureFieldCap(IndSoil) - SoilIce (IndSoil) + WatExcFieldCap(IndSoil) = (SoilLiqWater(IndSoil) - (DrainFacSoilWat*SoilFieldCapLiq(IndSoil))) * & + ThicknessSoilLayer(IndSoil) * 1000.0 + if ( WatExcFieldCap(IndSoil) < 0.0 ) WatExcFieldCap(IndSoil) = 0.0 + DrainWatTmp = DrainWatTmp + WatExcFieldCap(IndSoil) + enddo + do IndSoil = 1, 3 + if ( WatExcFieldCap(IndSoil) /= 0.0 ) then + DrainFracTmp(IndSoil) = WatExcFieldCap(IndSoil) / DrainWatTmp + endif + enddo + if ( DrainWatTmp > 0.0 ) then + if ( DrainWatTmp > DrainCoeffTmp ) DrainWatTmp = DrainCoeffTmp + DrainWatVolTot = DrainWatVolTot + DrainWatTmp + do IndSoil = 1, 3 + WatExcFieldCap(IndSoil) = DrainFracTmp(IndSoil) * DrainWatTmp + SoilLiqWater(IndSoil) = SoilLiqWater(IndSoil) - & + (WatExcFieldCap(IndSoil) / (ThicknessSoilLayer(IndSoil) * 1000.0)) + SoilMoisture(IndSoil) = SoilLiqWater(IndSoil) + SoilIce (IndSoil) + enddo + endif + else if ( DrainSoilLayerInd == 3 ) then + do IndSoil = 2, 3 + SoilFieldCapLiq(IndSoil) = SoilMoistureFieldCap(IndSoil) - SoilIce (IndSoil) + WatExcFieldCap(IndSoil) = (SoilLiqWater(IndSoil) - (DrainFacSoilWat*SoilFieldCapLiq(IndSoil))) * & + ThicknessSoilLayer(IndSoil) * 1000.0 + if ( WatExcFieldCap(IndSoil) < 0.0 ) WatExcFieldCap(IndSoil) = 0.0 + DrainWatTmp = DrainWatTmp + WatExcFieldCap(IndSoil) + enddo + do IndSoil = 2, 3 + if ( WatExcFieldCap(IndSoil) /= 0.0 ) then + DrainFracTmp(IndSoil) = WatExcFieldCap(IndSoil) / DrainWatTmp + endif + enddo + if ( DrainWatTmp > 0.0 ) then + if ( DrainWatTmp > DrainCoeffTmp ) DrainWatTmp = DrainCoeffTmp + DrainWatVolTot = DrainWatVolTot + DrainWatTmp + do IndSoil = 2, 3 + WatExcFieldCap(IndSoil) = DrainFracTmp(IndSoil) * DrainWatTmp + SoilLiqWater(IndSoil) = SoilLiqWater(IndSoil) - & + (WatExcFieldCap(IndSoil) / (ThicknessSoilLayer(IndSoil) * 1000.0)) + SoilMoisture(IndSoil) = SoilLiqWater(IndSoil) + SoilIce (IndSoil) + enddo + endif + else if ( DrainSoilLayerInd == 4 ) then + do IndSoil = 3, 4 + SoilFieldCapLiq(IndSoil) = SoilMoistureFieldCap(IndSoil) - SoilIce (IndSoil) + WatExcFieldCap(IndSoil) = (SoilLiqWater(IndSoil) - (DrainFacSoilWat*SoilFieldCapLiq(IndSoil))) * & + ThicknessSoilLayer(IndSoil) * 1000.0 + if ( WatExcFieldCap(IndSoil) < 0.0 ) WatExcFieldCap(IndSoil) = 0.0 + DrainWatTmp = DrainWatTmp + WatExcFieldCap(IndSoil) + enddo + do IndSoil = 3, 4 + if ( WatExcFieldCap(IndSoil) /= 0.0 ) then + DrainFracTmp(IndSoil) = WatExcFieldCap(IndSoil) / DrainWatTmp + endif + enddo + if ( DrainWatTmp > 0.0 ) then + if ( DrainWatTmp > DrainCoeffTmp ) DrainWatTmp = DrainCoeffTmp + DrainWatVolTot = DrainWatVolTot + DrainWatTmp + do IndSoil = 3, 4 + WatExcFieldCap(IndSoil) = DrainFracTmp(IndSoil) * DrainWatTmp + SoilLiqWater(IndSoil) = SoilLiqWater(IndSoil) - (WatExcFieldCap(IndSoil) / & + (ThicknessSoilLayer(IndSoil) * 1000.0)) + SoilMoisture(IndSoil) = SoilLiqWater(IndSoil) + SoilIce (IndSoil) + enddo + endif + else if ( DrainSoilLayerInd == 5 ) then ! from all the four layers + do IndSoil = 1, 4 + SoilFieldCapLiq(IndSoil) = SoilMoistureFieldCap(IndSoil) - SoilIce (IndSoil) + WatExcFieldCap(IndSoil) = (SoilLiqWater(IndSoil) - (DrainFacSoilWat*SoilFieldCapLiq(IndSoil))) * & + ThicknessSoilLayer(IndSoil) * 1000.0 + if ( WatExcFieldCap(IndSoil) < 0.0 ) WatExcFieldCap(IndSoil) = 0.0 + DrainWatTmp = DrainWatTmp + WatExcFieldCap(IndSoil) + enddo + do IndSoil = 1, 4 + if ( WatExcFieldCap(IndSoil) /= 0.0 ) then + DrainFracTmp(IndSoil) = WatExcFieldCap(IndSoil) / DrainWatTmp + endif + enddo + if ( DrainWatTmp > 0.0 ) then + if ( DrainWatTmp > DrainCoeffTmp ) DrainWatTmp = DrainCoeffTmp + DrainWatVolTot = DrainWatVolTot + DrainWatTmp + do IndSoil = 1, 4 + WatExcFieldCap(IndSoil) = DrainFracTmp(IndSoil) * DrainWatTmp + SoilLiqWater(IndSoil) = SoilLiqWater(IndSoil) - (WatExcFieldCap(IndSoil) / & + (ThicknessSoilLayer(IndSoil) * 1000.0)) + SoilMoisture(IndSoil) = SoilLiqWater(IndSoil) + SoilIce (IndSoil) + enddo + endif + endif + + TileDrain = DrainWatVolTot / SoilTimeStep + + ! deallocate local arrays to avoid memory leaks + deallocate(DrainFracTmp ) + deallocate(SoilFieldCapLiq) + deallocate(WatExcFieldCap ) + + end associate + + end subroutine TileDrainageSimple + +end module TileDrainageSimpleMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/VaporPressureSaturationMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/VaporPressureSaturationMod.F90 new file mode 100644 index 000000000..09f761f97 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/VaporPressureSaturationMod.F90 @@ -0,0 +1,69 @@ +module VaporPressureSaturationMod + +!!! Calculate saturation vapor pressure and derivative with respect to temperature +!!! using polynomials; over water when t > 0C and over ice when t <= 0C + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine VaporPressureSaturation(T, VapPresSatWat, VapPresSatIce, VapPresSatWatD, VapPresSatIceD) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: ESAT +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + real(kind=kind_noahmp), intent(in) :: T ! air temperature [K] + real(kind=kind_noahmp), intent(out) :: VapPresSatWat ! saturation vapor pressure over water [Pa] + real(kind=kind_noahmp), intent(out) :: VapPresSatIce ! saturation vapor pressure over ice [Pa] + real(kind=kind_noahmp), intent(out) :: VapPresSatWatD ! d(ESAT)/dT over water [Pa/K] + real(kind=kind_noahmp), intent(out) :: VapPresSatIceD ! d(ESAT)/dT over ice [Pa/K] + +! local variable + real(kind=kind_noahmp), parameter :: A0 = 6.107799961 ! coefficients for ESAT over water + real(kind=kind_noahmp), parameter :: A1 = 4.436518521e-01 ! coefficients for ESAT over water + real(kind=kind_noahmp), parameter :: A2 = 1.428945805e-02 ! coefficients for ESAT over water + real(kind=kind_noahmp), parameter :: A3 = 2.650648471e-04 ! coefficients for ESAT over water + real(kind=kind_noahmp), parameter :: A4 = 3.031240396e-06 ! coefficients for ESAT over water + real(kind=kind_noahmp), parameter :: A5 = 2.034080948e-08 ! coefficients for ESAT over water + real(kind=kind_noahmp), parameter :: A6 = 6.136820929e-11 ! coefficients for ESAT over water + real(kind=kind_noahmp), parameter :: B0 = 6.109177956 ! coefficients for ESAT over ice + real(kind=kind_noahmp), parameter :: B1 = 5.034698970e-01 ! coefficients for ESAT over ice + real(kind=kind_noahmp), parameter :: B2 = 1.886013408e-02 ! coefficients for ESAT over ice + real(kind=kind_noahmp), parameter :: B3 = 4.176223716e-04 ! coefficients for ESAT over ice + real(kind=kind_noahmp), parameter :: B4 = 5.824720280e-06 ! coefficients for ESAT over ice + real(kind=kind_noahmp), parameter :: B5 = 4.838803174e-08 ! coefficients for ESAT over ice + real(kind=kind_noahmp), parameter :: B6 = 1.838826904e-10 ! coefficients for ESAT over ice + real(kind=kind_noahmp), parameter :: C0 = 4.438099984e-01 ! coefficients for d(ESAT)/dT over water + real(kind=kind_noahmp), parameter :: C1 = 2.857002636e-02 ! coefficients for d(ESAT)/dT over water + real(kind=kind_noahmp), parameter :: C2 = 7.938054040e-04 ! coefficients for d(ESAT)/dT over water + real(kind=kind_noahmp), parameter :: C3 = 1.215215065e-05 ! coefficients for d(ESAT)/dT over water + real(kind=kind_noahmp), parameter :: C4 = 1.036561403e-07 ! coefficients for d(ESAT)/dT over water + real(kind=kind_noahmp), parameter :: C5 = 3.532421810e-10 ! coefficients for d(ESAT)/dT over water + real(kind=kind_noahmp), parameter :: C6 = -7.090244804e-13 ! coefficients for d(ESAT)/dT over water + real(kind=kind_noahmp), parameter :: D0 = 5.030305237e-01 ! coefficients for d(ESAT)/dT over ice + real(kind=kind_noahmp), parameter :: D1 = 3.773255020e-02 ! coefficients for d(ESAT)/dT over ice + real(kind=kind_noahmp), parameter :: D2 = 1.267995369e-03 ! coefficients for d(ESAT)/dT over ice + real(kind=kind_noahmp), parameter :: D3 = 2.477563108e-05 ! coefficients for d(ESAT)/dT over ice + real(kind=kind_noahmp), parameter :: D4 = 3.005693132e-07 ! coefficients for d(ESAT)/dT over ice + real(kind=kind_noahmp), parameter :: D5 = 2.158542548e-09 ! coefficients for d(ESAT)/dT over ice + real(kind=kind_noahmp), parameter :: D6 = 7.131097725e-12 ! coefficients for d(ESAT)/dT over ice + +! ---------------------------------------------------------------------- + + VapPresSatWat = 100.0 * (A0 + T * (A1 + T * (A2 + T * (A3 + T * ( A4 + T * (A5 + T*A6) ) ) ) ) ) + VapPresSatIce = 100.0 * (B0 + T * (B1 + T * (B2 + T * (B3 + T * ( B4 + T * (B5 + T*B6) ) ) ) ) ) + VapPresSatWatD = 100.0 * (C0 + T * (C1 + T * (C2 + T * (C3 + T * ( C4 + T * (C5 + T*C6) ) ) ) ) ) + VapPresSatIceD = 100.0 * (D0 + T * (D1 + T * (D2 + T * (D3 + T * ( D4 + T * (D5 + T*D6) ) ) ) ) ) + + end subroutine VaporPressureSaturation + +end module VaporPressureSaturationMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/WaterMainGlacierMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/WaterMainGlacierMod.F90 new file mode 100644 index 000000000..1b11f3cd3 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/WaterMainGlacierMod.F90 @@ -0,0 +1,158 @@ +module WaterMainGlacierMod + +!!! Main glacier water module including all water relevant processes +!!! snowpack water -> ice water -> runoff + + use Machine + use NoahmpVarType + use ConstantDefineMod + use SnowWaterMainGlacierMod, only : SnowWaterMainGlacier + + implicit none + +contains + + subroutine WaterMainGlacier(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: WATER_GLACIER +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: LoopInd ! loop index + real(kind=kind_noahmp) :: WatReplaceSublim ! replacement water due to sublimation of glacier + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilIceTmp ! temporary glacier ice content [m3/m3] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilLiqWaterTmp ! temporary glacier liquid water content [m3/m3] + +! -------------------------------------------------------------------- + associate( & + OptGlacierTreatment => noahmp%config%nmlist%OptGlacierTreatment ,& ! in, option for glacier treatment + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, noahmp main time step [s] + GridIndexI => noahmp%config%domain%GridIndexI ,& ! in, grid index in x-direction + GridIndexJ => noahmp%config%domain%GridIndexJ ,& ! in, grid index in y-direction + VaporizeGrd => noahmp%water%flux%VaporizeGrd ,& ! in, ground vaporize rate total (evap+sublim) [mm/s] + CondenseVapGrd => noahmp%water%flux%CondenseVapGrd ,& ! in, ground vapor condense rate total (dew+frost) [mm/s] + RainfallGround => noahmp%water%flux%RainfallGround ,& ! in, ground surface rain rate [mm/s] + SnowfallGround => noahmp%water%flux%SnowfallGround ,& ! in, snowfall on the ground [mm/s] + SnowfallDensity => noahmp%water%state%SnowfallDensity ,& ! in, bulk density of snowfall [kg/m3] + LatHeatVapGrd => noahmp%energy%state%LatHeatVapGrd ,& ! in, latent heat of vaporization/subli [J/kg], ground + HeatLatentGrd => noahmp%energy%flux%HeatLatentGrd ,& ! inout, total ground latent heat [W/m2] (+ to atm) + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! inout, actual number of snow layers (negative) + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! inout, thickness of snow/glacier layers [m] + SnowWaterEquiv => noahmp%water%state%SnowWaterEquiv ,& ! inout, snow water equivalent [mm] + SnowWaterEquivPrev => noahmp%water%state%SnowWaterEquivPrev ,& ! inout, snow water equivalent at last time step [mm] + SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! inout, glacier water content [m3/m3] + SoilIce => noahmp%water%state%SoilIce ,& ! inout, glacier ice moisture [m3/m3] + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! inout, total glacier water [m3/m3] + PondSfcThinSnwMelt => noahmp%water%state%PondSfcThinSnwMelt ,& ! inout, surface ponding [mm] from snowmelt when thin snow has no layer + WaterHeadSfc => noahmp%water%state%WaterHeadSfc ,& ! inout, surface water head [mm)] + SoilSfcInflow => noahmp%water%flux%SoilSfcInflow ,& ! inout, water input on glacier/soil surface [m/s] + FrostSnowSfcIce => noahmp%water%flux%FrostSnowSfcIce ,& ! inout, snow surface frost rate [mm/s] + SublimSnowSfcIce => noahmp%water%flux%SublimSnowSfcIce ,& ! inout, snow surface sublimation rate [mm/s] + GlacierExcessFlow => noahmp%water%flux%GlacierExcessFlow ,& ! inout, glacier snow excess flow [mm/s] + SnowDepthIncr => noahmp%water%flux%SnowDepthIncr ,& ! out, snow depth increasing rate [m/s] due to snowfall + EvapGroundNet => noahmp%water%flux%EvapGroundNet ,& ! out, net direct ground evaporation [mm/s] + RunoffSurface => noahmp%water%flux%RunoffSurface ,& ! out, surface runoff [mm/s] + RunoffSubsurface => noahmp%water%flux%RunoffSubsurface ,& ! out, subsurface runoff [mm/s] + SnowBotOutflow => noahmp%water%flux%SnowBotOutflow ,& ! out, total water (snowmelt + rain through pack) out of snowpack bottom [mm/s] + PondSfcThinSnwComb => noahmp%water%state%PondSfcThinSnwComb ,& ! out, surface ponding [mm] from liquid in thin snow layer combination + PondSfcThinSnwTrans => noahmp%water%state%PondSfcThinSnwTrans & ! out, surface ponding [mm] from thin snow liquid during transition from multilayer to no layer + ) +! ---------------------------------------------------------------------- + + ! initialize + if (.not. allocated(SoilIceTmp) ) allocate(SoilIceTmp (1:NumSoilLayer)) + if (.not. allocated(SoilLiqWaterTmp)) allocate(SoilLiqWaterTmp(1:NumSoilLayer)) + SoilIceTmp = 0.0 + SoilLiqWaterTmp = 0.0 + GlacierExcessFlow = 0.0 + RunoffSubsurface = 0.0 + RunoffSurface = 0.0 + SnowDepthIncr = 0.0 + + ! prepare for water process + SoilIce(:) = max(0.0, SoilMoisture(:)-SoilLiqWater(:)) + SoilIceTmp = SoilIce + SoilLiqWaterTmp = SoilLiqWater + SnowWaterEquivPrev = SnowWaterEquiv + + ! compute soil/snow surface evap/dew rate based on energy flux + VaporizeGrd = max(HeatLatentGrd/LatHeatVapGrd, 0.0) ! positive part of ground latent heat; Barlage change to ground v3.6 + CondenseVapGrd = abs(min(HeatLatentGrd/LatHeatVapGrd, 0.0)) ! negative part of ground latent heat + EvapGroundNet = VaporizeGrd - CondenseVapGrd + + ! snow height increase + SnowDepthIncr = SnowfallGround / SnowfallDensity + + ! ground sublimation and evaporation + SublimSnowSfcIce = VaporizeGrd + + ! ground frost and dew + FrostSnowSfcIce = CondenseVapGrd + + ! snowpack water processs + call SnowWaterMainGlacier(noahmp) + + ! total surface input water to glacier ice + SoilSfcInflow = (PondSfcThinSnwMelt + PondSfcThinSnwComb + PondSfcThinSnwTrans) / MainTimeStep * 0.001 ! convert units (mm/s -> m/s) + if ( NumSnowLayerNeg == 0 ) then + SoilSfcInflow = SoilSfcInflow + (SnowBotOutflow + RainfallGround) * 0.001 + else + SoilSfcInflow = SoilSfcInflow + SnowBotOutflow * 0.001 + endif +#ifdef WRF_HYDRO + SoilSfcInflow = SoilSfcInflow + WaterHeadSfc / MainTimeStep * 0.001 +#endif + + ! surface runoff + RunoffSurface = SoilSfcInflow * 1000.0 ! mm/s + + ! glacier ice water + if ( OptGlacierTreatment == 1 ) then + WatReplaceSublim = 0.0 + do LoopInd = 1, NumSoilLayer + WatReplaceSublim = WatReplaceSublim + ThicknessSnowSoilLayer(LoopInd)*(SoilIce(LoopInd) - & + SoilIceTmp(LoopInd) + SoilLiqWater(LoopInd) - SoilLiqWaterTmp(LoopInd)) + enddo + WatReplaceSublim = WatReplaceSublim * 1000.0 / MainTimeStep ! convert to [mm/s] + SoilIce = min(1.0, SoilIceTmp) + elseif ( OptGlacierTreatment == 2 ) then + SoilIce = 1.0 + endif + SoilLiqWater = 1.0 - SoilIce + + ! use RunoffSubsurface as a water balancer, GlacierExcessFlow is snow that disappears, WatReplaceSublim is + ! water from below that replaces glacier loss + if ( OptGlacierTreatment == 1 ) then + RunoffSubsurface = GlacierExcessFlow + WatReplaceSublim + elseif ( OptGlacierTreatment == 2 ) then + RunoffSubsurface = GlacierExcessFlow + VaporizeGrd = SublimSnowSfcIce + CondenseVapGrd = FrostSnowSfcIce + endif + + if ( OptGlacierTreatment == 2 ) then + EvapGroundNet = VaporizeGrd - CondenseVapGrd + HeatLatentGrd = EvapGroundNet * LatHeatVapGrd + endif + + if ( maxval(SoilIce) < 0.0001 ) then + write(*,*) "GLACIER HAS MELTED AT: ", GridIndexI, GridIndexJ, " ARE YOU SURE THIS SHOULD BE A GLACIER POINT?" + endif + + ! deallocate local arrays to avoid memory leaks + deallocate(SoilIceTmp ) + deallocate(SoilLiqWaterTmp) + + end associate + + end subroutine WaterMainGlacier + +end module WaterMainGlacierMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/WaterMainMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/WaterMainMod.F90 new file mode 100644 index 000000000..d737e81e1 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/WaterMainMod.F90 @@ -0,0 +1,209 @@ +module WaterMainMod + +!!! Main water module including all water relevant processes +!!! canopy water -> snowpack water -> soil water -> ground water + + use Machine + use NoahmpVarType + use ConstantDefineMod + use CanopyHydrologyMod, only : CanopyHydrology + use SnowWaterMainMod, only : SnowWaterMain + use IrrigationFloodMod, only : IrrigationFlood + use IrrigationMicroMod, only : IrrigationMicro + use SoilWaterMainMod, only : SoilWaterMain + + implicit none + +contains + + subroutine WaterMain(noahmp) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: WATER +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: LoopInd ! loop index + +! -------------------------------------------------------------------- + associate( & + MainTimeStep => noahmp%config%domain%MainTimeStep ,& ! in, noahmp main time step [s] + SoilTimeStep => noahmp%config%domain%SoilTimeStep ,& ! in, soil process timestep [s] + SurfaceType => noahmp%config%domain%SurfaceType ,& ! in, surface type 1-soil; 2-lake + FlagCropland => noahmp%config%domain%FlagCropland ,& ! in, flag to identify croplands + FlagUrban => noahmp%config%domain%FlagUrban ,& ! in, urban point flag + FlagSoilProcess => noahmp%config%domain%FlagSoilProcess ,& ! in, flag to calculate soil processes + NumSoilTimeStep => noahmp%config%domain%NumSoilTimeStep ,& ! in, number of timesteps for soil process calculation + VaporizeGrd => noahmp%water%flux%VaporizeGrd ,& ! in, ground vaporize rate total (evap+sublim) [mm/s] + CondenseVapGrd => noahmp%water%flux%CondenseVapGrd ,& ! in, ground vapor condense rate total (dew+frost) [mm/s] + RainfallGround => noahmp%water%flux%RainfallGround ,& ! in, ground surface rain rate [mm/s] + SoilTranspFac => noahmp%water%state%SoilTranspFac ,& ! in, soil water transpiration factor (0 to 1) + WaterStorageLakeMax => noahmp%water%param%WaterStorageLakeMax ,& ! in, maximum lake water storage [mm] + NumSoilLayerRoot => noahmp%water%param%NumSoilLayerRoot ,& ! in, number of soil layers with root present + FlagFrozenGround => noahmp%energy%state%FlagFrozenGround ,& ! in, frozen ground (logical) to define latent heat pathway + LatHeatVapGrd => noahmp%energy%state%LatHeatVapGrd ,& ! in, latent heat of vaporization/subli [J/kg], ground + DensityAirRefHeight => noahmp%energy%state%DensityAirRefHeight ,& ! in, density air [kg/m3] + ExchCoeffShSfc => noahmp%energy%state%ExchCoeffShSfc ,& ! in, exchange coefficient [m/s] for heat, surface, grid mean + SpecHumidityRefHeight => noahmp%forcing%SpecHumidityRefHeight ,& ! in, specific humidity [kg/kg] at reference height + HeatLatentGrd => noahmp%energy%flux%HeatLatentGrd ,& ! in, total ground latent heat [W/m2] (+ to atm) + NumSnowLayerNeg => noahmp%config%domain%NumSnowLayerNeg ,& ! inout, actual number of snow layers (negative) + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! inout, thickness of snow/soil layers [m] + SnowWaterEquiv => noahmp%water%state%SnowWaterEquiv ,& ! inout, snow water equivalent [mm] + SnowWaterEquivPrev => noahmp%water%state%SnowWaterEquivPrev ,& ! inout, snow water equivalent at last time step [mm] + SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! inout, soil water content [m3/m3] + SoilIce => noahmp%water%state%SoilIce ,& ! inout, soil ice moisture [m3/m3] + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! inout, total soil moisture [m3/m3] + WaterStorageLake => noahmp%water%state%WaterStorageLake ,& ! inout, water storage in lake (can be negative) [mm] + PondSfcThinSnwMelt => noahmp%water%state%PondSfcThinSnwMelt ,& ! inout, surface ponding [mm] from snowmelt when thin snow has no layer + WaterHeadSfc => noahmp%water%state%WaterHeadSfc ,& ! inout, surface water head (mm) + IrrigationAmtFlood => noahmp%water%state%IrrigationAmtFlood ,& ! inout, flood irrigation water amount [m] + IrrigationAmtMicro => noahmp%water%state%IrrigationAmtMicro ,& ! inout, micro irrigation water amount [m] + SoilSfcInflow => noahmp%water%flux%SoilSfcInflow ,& ! inout, water input on soil surface [m/s] + EvapSoilSfcLiq => noahmp%water%flux%EvapSoilSfcLiq ,& ! inout, evaporation from soil surface [m/s] + DewSoilSfcLiq => noahmp%water%flux%DewSoilSfcLiq ,& ! inout, soil surface dew rate [mm/s] + FrostSnowSfcIce => noahmp%water%flux%FrostSnowSfcIce ,& ! inout, snow surface frost rate[mm/s] + SublimSnowSfcIce => noahmp%water%flux%SublimSnowSfcIce ,& ! inout, snow surface sublimation rate[mm/s] + TranspWatLossSoil => noahmp%water%flux%TranspWatLossSoil ,& ! inout, transpiration water loss from soil layers [m/s] + GlacierExcessFlow => noahmp%water%flux%GlacierExcessFlow ,& ! inout, glacier excess flow [mm/s] + SoilSfcInflowAcc => noahmp%water%flux%SoilSfcInflowAcc ,& ! inout, accumulated water flux into soil during soil timestep [m/s * dt_soil/dt_main] + EvapSoilSfcLiqAcc => noahmp%water%flux%EvapSoilSfcLiqAcc ,& ! inout, accumulated soil surface evaporation during soil timestep [m/s * dt_soil/dt_main] + TranspWatLossSoilAcc => noahmp%water%flux%TranspWatLossSoilAcc ,& ! inout, accumualted transpiration water loss during soil timestep [m/s * dt_soil/dt_main] + SpecHumidity2mBare => noahmp%energy%state%SpecHumidity2mBare ,& ! out, bare ground 2-m specific humidity [kg/kg] + SpecHumiditySfc => noahmp%energy%state%SpecHumiditySfc ,& ! out, specific humidity at surface [kg/kg] + EvapGroundNet => noahmp%water%flux%EvapGroundNet ,& ! out, net ground (soil/snow) evaporation [mm/s] + Transpiration => noahmp%water%flux%Transpiration ,& ! out, transpiration rate [mm/s] + EvapCanopyNet => noahmp%water%flux%EvapCanopyNet ,& ! out, evaporation of intercepted water [mm/s] + RunoffSurface => noahmp%water%flux%RunoffSurface ,& ! out, surface runoff [mm/dt_soil] per soil timestep + RunoffSubsurface => noahmp%water%flux%RunoffSubsurface ,& ! out, subsurface runoff [mm/dt_soil] per soil timestep + TileDrain => noahmp%water%flux%TileDrain ,& ! out, tile drainage per soil timestep [mm/dt_soil] + SnowBotOutflow => noahmp%water%flux%SnowBotOutflow ,& ! out, total water (snowmelt+rain through pack) out of snow bottom [mm/s] + WaterToAtmosTotal => noahmp%water%flux%WaterToAtmosTotal ,& ! out, total water vapor flux to atmosphere [mm/s] + SoilSfcInflowMean => noahmp%water%flux%SoilSfcInflowMean ,& ! out, mean water flux into soil during soil timestep [m/s] + EvapSoilSfcLiqMean => noahmp%water%flux%EvapSoilSfcLiqMean ,& ! out, mean soil surface evaporation during soil timestep [m/s] + TranspWatLossSoilMean => noahmp%water%flux%TranspWatLossSoilMean ,& ! out, mean transpiration water loss during soil timestep [m/s] + PondSfcThinSnwComb => noahmp%water%state%PondSfcThinSnwComb ,& ! out, surface ponding [mm] from liquid in thin snow layer combination + PondSfcThinSnwTrans => noahmp%water%state%PondSfcThinSnwTrans & ! out, surface ponding [mm] from thin snow liquid during transition from multilayer to no layer + ) +! ---------------------------------------------------------------------- + + ! initialize + TranspWatLossSoil = 0.0 + GlacierExcessFlow = 0.0 + RunoffSubsurface = 0.0 + RunoffSurface = 0.0 + SoilSfcInflow = 0.0 + TileDrain = 0.0 + + ! prepare for water process + SoilIce(:) = max(0.0, SoilMoisture(:)-SoilLiqWater(:)) + SnowWaterEquivPrev = SnowWaterEquiv + ! compute soil/snow surface evap/dew rate based on energy flux + VaporizeGrd = max(HeatLatentGrd/LatHeatVapGrd, 0.0) ! positive part of ground latent heat; Barlage change to ground v3.6 + CondenseVapGrd = abs(min(HeatLatentGrd/LatHeatVapGrd, 0.0)) ! negative part of ground latent heat + EvapGroundNet = VaporizeGrd - CondenseVapGrd + + ! canopy-intercepted snowfall/rainfall, drips, and throughfall + call CanopyHydrology(noahmp) + + ! ground sublimation and evaporation + SublimSnowSfcIce = 0.0 + if ( SnowWaterEquiv > 0.0 ) then + SublimSnowSfcIce = min(VaporizeGrd, SnowWaterEquiv/MainTimeStep) + endif + EvapSoilSfcLiq = VaporizeGrd - SublimSnowSfcIce + + ! ground frost and dew + FrostSnowSfcIce = 0.0 + if ( SnowWaterEquiv > 0.0 ) then + FrostSnowSfcIce = CondenseVapGrd + endif + DewSoilSfcLiq = CondenseVapGrd - FrostSnowSfcIce + + ! snowpack water processs + call SnowWaterMain(noahmp) + + ! treat frozen ground/soil + if ( FlagFrozenGround .eqv. .true. ) then + SoilIce(1) = SoilIce(1) + (DewSoilSfcLiq-EvapSoilSfcLiq) * MainTimeStep / & + (ThicknessSnowSoilLayer(1)*1000.0) + DewSoilSfcLiq = 0.0 + EvapSoilSfcLiq = 0.0 + if ( SoilIce(1) < 0.0 ) then + SoilLiqWater(1) = SoilLiqWater(1) + SoilIce(1) + SoilIce(1) = 0.0 + endif + SoilMoisture(1) = SoilLiqWater(1) + SoilIce(1) + endif + EvapSoilSfcLiq = EvapSoilSfcLiq * 0.001 ! mm/s -> m/s + + ! transpiration mm/s -> m/s + do LoopInd = 1, NumSoilLayerRoot + TranspWatLossSoil(LoopInd) = Transpiration * SoilTranspFac(LoopInd) * 0.001 + enddo + + ! total surface input water to soil mm/s -> m/s + SoilSfcInflow = (PondSfcThinSnwMelt + PondSfcThinSnwComb + PondSfcThinSnwTrans) / & + MainTimeStep * 0.001 ! convert units (mm/s -> m/s) + if ( NumSnowLayerNeg == 0 ) then + SoilSfcInflow = SoilSfcInflow + (SnowBotOutflow + DewSoilSfcLiq + RainfallGround) * 0.001 + else + SoilSfcInflow = SoilSfcInflow + (SnowBotOutflow + DewSoilSfcLiq) * 0.001 + endif + +#ifdef WRF_HYDRO + SoilSfcInflow = SoilSfcInflow + WaterHeadSfc / MainTimeStep * 0.001 +#endif + + ! calculate soil process only at soil timestep + SoilSfcInflowAcc = SoilSfcInflowAcc + SoilSfcInflow + EvapSoilSfcLiqAcc = EvapSoilSfcLiqAcc + EvapSoilSfcLiq + TranspWatLossSoilAcc = TranspWatLossSoilAcc + TranspWatLossSoil + + ! start soil water processes + if ( FlagSoilProcess .eqv. .true. ) then + + ! irrigation: call flood irrigation and add to SoilSfcInflowAcc + if ( (FlagCropland .eqv. .true.) .and. (IrrigationAmtFlood > 0.0) ) call IrrigationFlood(noahmp) + + ! irrigation: call micro irrigation assuming we implement drip in first layer + ! of the Noah-MP. Change layer 1 moisture wrt to MI rate + if ( (FlagCropland .eqv. .true.) .and. (IrrigationAmtMicro > 0.0) ) call IrrigationMicro(noahmp) + + ! compute mean water flux during soil timestep + SoilSfcInflowMean = SoilSfcInflowAcc / NumSoilTimeStep + EvapSoilSfcLiqMean = EvapSoilSfcLiqAcc / NumSoilTimeStep + TranspWatLossSoilMean = TranspWatLossSoilAcc / NumSoilTimeStep + + ! lake/soil water balances + if ( SurfaceType == 2 ) then ! lake + RunoffSurface = 0.0 + if ( WaterStorageLake >= WaterStorageLakeMax ) RunoffSurface = SoilSfcInflowMean*1000.0*SoilTimeStep ! mm per soil timestep + WaterStorageLake = WaterStorageLake + (SoilSfcInflowMean-EvapSoilSfcLiqMean)*1000.0*SoilTimeStep - RunoffSurface ! mm per soil timestep + else ! soil + ! soil water processes (including Top model groundwater and shallow water MMF groundwater) + call SoilWaterMain(noahmp) + endif + + endif ! FlagSoilProcess soil timestep + + ! merge excess glacier snow flow to subsurface runoff + RunoffSubsurface = RunoffSubsurface + GlacierExcessFlow * MainTimeStep ! mm per soil timestep + + ! update surface water vapor flux ! urban - jref + WaterToAtmosTotal = Transpiration + EvapCanopyNet + EvapGroundNet + if ( (FlagUrban .eqv. .true.) ) then + SpecHumiditySfc = WaterToAtmosTotal / (DensityAirRefHeight*ExchCoeffShSfc) + SpecHumidityRefHeight + SpecHumidity2mBare = SpecHumiditySfc + endif + + end associate + + end subroutine WaterMain + +end module WaterMainMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/WaterTableDepthSearchMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/WaterTableDepthSearchMod.F90 new file mode 100644 index 000000000..5f396bc90 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/WaterTableDepthSearchMod.F90 @@ -0,0 +1,77 @@ +module WaterTableDepthSearchMod + +!!! Calculate/search water table depth as on WRF-Hydro/NWM + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine WaterTableDepthSearch(noahmp) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: TD_FINDZWAT +! Original code: P. Valayamkunnath (NCAR) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + +! in & out variables + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: IndSoil ! loop index + integer :: IndSatLayer ! check saturated layer + real(kind=kind_noahmp) :: WaterAvailTmp ! temporary available water + real(kind=kind_noahmp) :: WaterTableDepthTmp ! temporary water table depth [m] + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth [m] of layer-bottom from soil surface + ThicknessSoilLayer => noahmp%config%domain%ThicknessSoilLayer ,& ! in, soil layer thickness [m] + SoilMoistureFieldCap => noahmp%water%param%SoilMoistureFieldCap ,& ! in, reference soil moisture (field capacity) [m3/m3] + SoilMoistureWilt => noahmp%water%param%SoilMoistureWilt ,& ! in, wilting point soil moisture [m3/m3] + SoilMoisture => noahmp%water%state%SoilMoisture ,& ! inout, total soil moisture [m3/m3] + WaterTableDepth => noahmp%water%state%WaterTableDepth & ! out, water table depth [m] + ) +! ---------------------------------------------------------------------- + + ! initialization + IndSatLayer = 0 ! indicator for sat. layers + WaterAvailTmp = 0.0 ! set water avail for subsfc rtng = 0. + + ! calculate/search for water table depth + do IndSoil = NumSoilLayer, 1, -1 + if ( (SoilMoisture(IndSoil) >= SoilMoistureFieldCap(IndSoil)) .and. & + (SoilMoistureFieldCap(IndSoil) > SoilMoistureWilt(IndSoil)) ) then + if ( (IndSatLayer == (IndSoil+1)) .or. (IndSoil == NumSoilLayer) ) IndSatLayer = IndSoil + endif + enddo + + if ( IndSatLayer /= 0 ) then + if ( IndSatLayer /= 1 ) then ! soil column is partially sat. + WaterTableDepthTmp = -DepthSoilLayer(IndSatLayer-1) + else ! soil column is fully saturated to sfc. + WaterTableDepthTmp = 0.0 + endif + do IndSoil = IndSatLayer, NumSoilLayer + WaterAvailTmp = WaterAvailTmp + & + (SoilMoisture(IndSoil) - SoilMoistureFieldCap(IndSoil)) * ThicknessSoilLayer(IndSoil) + enddo + else ! no saturated layers... + WaterTableDepthTmp = -DepthSoilLayer(NumSoilLayer) + IndSatLayer = NumSoilLayer + 1 + endif + + WaterTableDepth = WaterTableDepthTmp + + end associate + + end subroutine WaterTableDepthSearch + +end module WaterTableDepthSearchMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/WaterTableEquilibriumMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/WaterTableEquilibriumMod.F90 new file mode 100644 index 000000000..932b94a12 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/WaterTableEquilibriumMod.F90 @@ -0,0 +1,76 @@ +module WaterTableEquilibriumMod + +!!! Calculate equilibrium water table depth (Niu et al., 2005) + + use Machine + use NoahmpVarType + use ConstantDefineMod + + implicit none + +contains + + subroutine WaterTableEquilibrium(noahmp) + +! ------------------------ Code history -------------------------------------------------- +! Original Noah-MP subroutine: ZWTEQ +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ---------------------------------------------------------------------------------------- + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + +! local variable + integer :: IndSoil ! do-loop index + integer, parameter :: NumSoilFineLy = 100 ! no. of fine soil layers of 6m soil + real(kind=kind_noahmp) :: WatDeficitCoarse ! water deficit from coarse (4-L) soil moisture profile + real(kind=kind_noahmp) :: WatDeficitFine ! water deficit from fine (100-L) soil moisture profile + real(kind=kind_noahmp) :: ThickSoilFineLy ! layer thickness of the 100-L soil layers to 6.0 m + real(kind=kind_noahmp) :: TmpVar ! temporary variable + real(kind=kind_noahmp), dimension(1:NumSoilFineLy) :: DepthSoilFineLy ! layer-bottom depth of the 100-L soil layers to 6.0 m + +! -------------------------------------------------------------------- + associate( & + NumSoilLayer => noahmp%config%domain%NumSoilLayer ,& ! in, number of soil layers + DepthSoilLayer => noahmp%config%domain%DepthSoilLayer ,& ! in, depth [m] of layer-bottom from soil surface + ThicknessSnowSoilLayer => noahmp%config%domain%ThicknessSnowSoilLayer ,& ! in, thickness of snow/soil layers [m] + SoilLiqWater => noahmp%water%state%SoilLiqWater ,& ! in, soil water content [m3/m3] + SoilMoistureSat => noahmp%water%param%SoilMoistureSat ,& ! in, saturated value of soil moisture [m3/m3] + SoilMatPotentialSat => noahmp%water%param%SoilMatPotentialSat ,& ! in, saturated soil matric potential [m] + SoilExpCoeffB => noahmp%water%param%SoilExpCoeffB ,& ! in, soil B parameter + WaterTableDepth => noahmp%water%state%WaterTableDepth & ! out, water table depth [m] + ) +! ---------------------------------------------------------------------- + + DepthSoilFineLy(1:NumSoilFineLy) = 0.0 + WatDeficitCoarse = 0.0 + do IndSoil = 1, NumSoilLayer + WatDeficitCoarse = WatDeficitCoarse + (SoilMoistureSat(1) - SoilLiqWater(IndSoil)) * & + ThicknessSnowSoilLayer(IndSoil) ! [m] + enddo + + ThickSoilFineLy = 3.0 * (-DepthSoilLayer(NumSoilLayer)) / NumSoilFineLy + do IndSoil = 1, NumSoilFineLy + DepthSoilFineLy(IndSoil) = float(IndSoil) * ThickSoilFineLy + enddo + + WaterTableDepth = -3.0 * DepthSoilLayer(NumSoilLayer) - 0.001 ! initial value [m] + + WatDeficitFine = 0.0 + do IndSoil = 1, NumSoilFineLy + TmpVar = 1.0 + (WaterTableDepth - DepthSoilFineLy(IndSoil)) / SoilMatPotentialSat(1) + WatDeficitFine = WatDeficitFine + SoilMoistureSat(1) * & + (1.0 - TmpVar**(-1.0/SoilExpCoeffB(1))) * ThickSoilFineLy + if ( abs(WatDeficitFine-WatDeficitCoarse) <= 0.01 ) then + WaterTableDepth = DepthSoilFineLy(IndSoil) + exit + endif + enddo + + end associate + + end subroutine WaterTableEquilibrium + +end module WaterTableEquilibriumMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/WaterVarInitMod.F90 b/src/core_atmosphere/physics/physics_noahmp/src/WaterVarInitMod.F90 new file mode 100644 index 000000000..a03d8b4f3 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/WaterVarInitMod.F90 @@ -0,0 +1,310 @@ +module WaterVarInitMod + +!!! Initialize column (1-D) Noah-MP water variables +!!! Water variables should be first defined in WaterVarType.F90 + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use Machine + use NoahmpVarType + + implicit none + +contains + +!=== initialize with default values + subroutine WaterVarInitDefault(noahmp) + + implicit none + + type(noahmp_type), intent(inout) :: noahmp + + associate( & + NumSnowLayerMax => noahmp%config%domain%NumSnowLayerMax ,& + NumSoilLayer => noahmp%config%domain%NumSoilLayer & + ) + + ! water state variables + noahmp%water%state%IrrigationCntSprinkler = undefined_int + noahmp%water%state%IrrigationCntMicro = undefined_int + noahmp%water%state%IrrigationCntFlood = undefined_int + noahmp%water%state%IrrigationFracFlood = undefined_real + noahmp%water%state%IrrigationAmtFlood = undefined_real + noahmp%water%state%IrrigationFracMicro = undefined_real + noahmp%water%state%IrrigationAmtMicro = undefined_real + noahmp%water%state%IrrigationFracSprinkler = undefined_real + noahmp%water%state%IrrigationAmtSprinkler = undefined_real + noahmp%water%state%IrrigationFracGrid = undefined_real + noahmp%water%state%CanopyLiqWater = undefined_real + noahmp%water%state%CanopyIce = undefined_real + noahmp%water%state%CanopyTotalWater = undefined_real + noahmp%water%state%CanopyWetFrac = undefined_real + noahmp%water%state%CanopyIceMax = undefined_real + noahmp%water%state%CanopyLiqWaterMax = undefined_real + noahmp%water%state%SnowfallDensity = undefined_real + noahmp%water%state%SnowDepth = undefined_real + noahmp%water%state%SnowWaterEquiv = undefined_real + noahmp%water%state%SnowWaterEquivPrev = undefined_real + noahmp%water%state%SnowCoverFrac = undefined_real + noahmp%water%state%PondSfcThinSnwMelt = undefined_real + noahmp%water%state%PondSfcThinSnwComb = undefined_real + noahmp%water%state%PondSfcThinSnwTrans = undefined_real + noahmp%water%state%SoilIceMax = undefined_real + noahmp%water%state%SoilLiqWaterMin = undefined_real + noahmp%water%state%SoilSaturateFrac = undefined_real + noahmp%water%state%SoilImpervFracMax = undefined_real + noahmp%water%state%SoilMoistureToWT = undefined_real + noahmp%water%state%SoilTranspFacAcc = undefined_real + noahmp%water%state%SoilWaterRootZone = undefined_real + noahmp%water%state%SoilWaterStress = undefined_real + noahmp%water%state%SoilSaturationExcess = undefined_real + noahmp%water%state%RechargeGwDeepWT = undefined_real + noahmp%water%state%RechargeGwShallowWT = undefined_real + noahmp%water%state%WaterTableHydro = undefined_real + noahmp%water%state%WaterTableDepth = undefined_real + noahmp%water%state%WaterStorageAquifer = undefined_real + noahmp%water%state%WaterStorageSoilAqf = undefined_real + noahmp%water%state%WaterStorageLake = undefined_real + noahmp%water%state%WaterStorageTotBeg = undefined_real + noahmp%water%state%WaterBalanceError = undefined_real + noahmp%water%state%WaterStorageTotEnd = undefined_real + noahmp%water%state%WaterHeadSfc = undefined_real + noahmp%water%state%PrecipAreaFrac = undefined_real + noahmp%water%state%TileDrainFrac = undefined_real + noahmp%water%state%FrozenPrecipFrac = undefined_real + + if ( .not. allocated(noahmp%water%state%IndexPhaseChange) ) & + allocate( noahmp%water%state%IndexPhaseChange(-NumSnowLayerMax+1:NumSoilLayer) ) + if ( .not. allocated(noahmp%water%state%SoilSupercoolWater) ) & + allocate( noahmp%water%state%SoilSupercoolWater(-NumSnowLayerMax+1:NumSoilLayer) ) + if ( .not. allocated(noahmp%water%state%SnowIce) ) & + allocate( noahmp%water%state%SnowIce(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%state%SnowLiqWater) ) & + allocate( noahmp%water%state%SnowLiqWater(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%state%SnowIceVol) ) & + allocate( noahmp%water%state%SnowIceVol(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%state%SnowLiqWaterVol) ) & + allocate( noahmp%water%state%SnowLiqWaterVol(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%state%SnowIceFracPrev) ) & + allocate( noahmp%water%state%SnowIceFracPrev(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%state%SnowIceFrac) ) & + allocate( noahmp%water%state%SnowIceFrac(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%state%SnowEffPorosity) ) & + allocate( noahmp%water%state%SnowEffPorosity(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%state%SoilLiqWater) ) & + allocate( noahmp%water%state%SoilLiqWater(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%water%state%SoilIce) ) & + allocate( noahmp%water%state%SoilIce(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%water%state%SoilMoisture) ) & + allocate( noahmp%water%state%SoilMoisture(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%water%state%SoilImpervFrac) ) & + allocate( noahmp%water%state%SoilImpervFrac(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%water%state%SoilWatConductivity) ) & + allocate( noahmp%water%state%SoilWatConductivity(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%water%state%SoilWatDiffusivity) ) & + allocate( noahmp%water%state%SoilWatDiffusivity(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%water%state%SoilEffPorosity) ) & + allocate( noahmp%water%state%SoilEffPorosity(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%water%state%SoilIceFrac) ) & + allocate( noahmp%water%state%SoilIceFrac(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%water%state%SoilMoistureEqui) ) & + allocate( noahmp%water%state%SoilMoistureEqui(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%water%state%SoilTranspFac) ) & + allocate( noahmp%water%state%SoilTranspFac(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%water%state%SoilMatPotential) ) & + allocate( noahmp%water%state%SoilMatPotential(1:NumSoilLayer) ) + + noahmp%water%state%IndexPhaseChange (:) = undefined_int + noahmp%water%state%SoilSupercoolWater (:) = undefined_real + noahmp%water%state%SnowIce (:) = undefined_real + noahmp%water%state%SnowLiqWater (:) = undefined_real + noahmp%water%state%SnowIceVol (:) = undefined_real + noahmp%water%state%SnowLiqWaterVol (:) = undefined_real + noahmp%water%state%SnowIceFracPrev (:) = undefined_real + noahmp%water%state%SnowIceFrac (:) = undefined_real + noahmp%water%state%SoilIceFrac (:) = undefined_real + noahmp%water%state%SnowEffPorosity (:) = undefined_real + noahmp%water%state%SoilLiqWater (:) = undefined_real + noahmp%water%state%SoilIce (:) = undefined_real + noahmp%water%state%SoilMoisture (:) = undefined_real + noahmp%water%state%SoilImpervFrac (:) = undefined_real + noahmp%water%state%SoilWatConductivity(:) = undefined_real + noahmp%water%state%SoilWatDiffusivity (:) = undefined_real + noahmp%water%state%SoilEffPorosity (:) = undefined_real + noahmp%water%state%SoilMoistureEqui (:) = undefined_real + noahmp%water%state%SoilTranspFac (:) = undefined_real + noahmp%water%state%SoilMatPotential (:) = undefined_real + + ! water flux variables + noahmp%water%flux%PrecipTotRefHeight = undefined_real + noahmp%water%flux%RainfallRefHeight = undefined_real + noahmp%water%flux%SnowfallRefHeight = undefined_real + noahmp%water%flux%PrecipConvTotRefHeight = undefined_real + noahmp%water%flux%PrecipLargeSclRefHeight = undefined_real + noahmp%water%flux%EvapCanopyNet = undefined_real + noahmp%water%flux%Transpiration = undefined_real + noahmp%water%flux%EvapCanopyLiq = undefined_real + noahmp%water%flux%DewCanopyLiq = undefined_real + noahmp%water%flux%FrostCanopyIce = undefined_real + noahmp%water%flux%SublimCanopyIce = undefined_real + noahmp%water%flux%MeltCanopyIce = undefined_real + noahmp%water%flux%FreezeCanopyLiq = undefined_real + noahmp%water%flux%SnowfallGround = undefined_real + noahmp%water%flux%SnowDepthIncr = undefined_real + noahmp%water%flux%FrostSnowSfcIce = undefined_real + noahmp%water%flux%SublimSnowSfcIce = undefined_real + noahmp%water%flux%RainfallGround = undefined_real + noahmp%water%flux%SnowBotOutflow = undefined_real + noahmp%water%flux%GlacierExcessFlow = undefined_real + noahmp%water%flux%SoilSfcInflow = undefined_real + noahmp%water%flux%RunoffSurface = undefined_real + noahmp%water%flux%RunoffSubsurface = undefined_real + noahmp%water%flux%InfilRateSfc = undefined_real + noahmp%water%flux%EvapSoilSfcLiq = undefined_real + noahmp%water%flux%DrainSoilBot = undefined_real + noahmp%water%flux%RechargeGw = undefined_real + noahmp%water%flux%DischargeGw = undefined_real + noahmp%water%flux%VaporizeGrd = undefined_real + noahmp%water%flux%CondenseVapGrd = undefined_real + noahmp%water%flux%DewSoilSfcLiq = undefined_real + noahmp%water%flux%InterceptCanopyRain = undefined_real + noahmp%water%flux%DripCanopyRain = undefined_real + noahmp%water%flux%ThroughfallRain = undefined_real + noahmp%water%flux%InterceptCanopySnow = undefined_real + noahmp%water%flux%DripCanopySnow = undefined_real + noahmp%water%flux%ThroughfallSnow = undefined_real + noahmp%water%flux%EvapGroundNet = undefined_real + noahmp%water%flux%MeltGroundSnow = undefined_real + noahmp%water%flux%WaterToAtmosTotal = undefined_real + noahmp%water%flux%EvapSoilSfcLiqAcc = undefined_real + noahmp%water%flux%SoilSfcInflowAcc = undefined_real + noahmp%water%flux%SfcWaterTotChgAcc = undefined_real + noahmp%water%flux%PrecipTotAcc = undefined_real + noahmp%water%flux%EvapCanopyNetAcc = undefined_real + noahmp%water%flux%TranspirationAcc = undefined_real + noahmp%water%flux%EvapGroundNetAcc = undefined_real + noahmp%water%flux%EvapSoilSfcLiqMean = undefined_real + noahmp%water%flux%SoilSfcInflowMean = undefined_real + noahmp%water%flux%IrrigationRateFlood = 0.0 + noahmp%water%flux%IrrigationRateMicro = 0.0 + noahmp%water%flux%IrrigationRateSprinkler = 0.0 + noahmp%water%flux%IrriEvapLossSprinkler = 0.0 + noahmp%water%flux%EvapIrriSprinkler = 0.0 + noahmp%water%flux%TileDrain = 0.0 + + if ( .not. allocated(noahmp%water%flux%CompactionSnowAging) ) & + allocate( noahmp%water%flux%CompactionSnowAging(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%flux%CompactionSnowBurden) ) & + allocate( noahmp%water%flux%CompactionSnowBurden(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%flux%CompactionSnowMelt) ) & + allocate( noahmp%water%flux%CompactionSnowMelt(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%flux%CompactionSnowTot) ) & + allocate( noahmp%water%flux%CompactionSnowTot(-NumSnowLayerMax+1:0) ) + if ( .not. allocated(noahmp%water%flux%TranspWatLossSoil) ) & + allocate( noahmp%water%flux%TranspWatLossSoil(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%water%flux%TranspWatLossSoilAcc) ) & + allocate( noahmp%water%flux%TranspWatLossSoilAcc(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%water%flux%TranspWatLossSoilMean) ) & + allocate( noahmp%water%flux%TranspWatLossSoilMean(1:NumSoilLayer) ) + + noahmp%water%flux%CompactionSnowAging (:) = undefined_real + noahmp%water%flux%CompactionSnowBurden (:) = undefined_real + noahmp%water%flux%CompactionSnowMelt (:) = undefined_real + noahmp%water%flux%CompactionSnowTot (:) = undefined_real + noahmp%water%flux%TranspWatLossSoil (:) = undefined_real + noahmp%water%flux%TranspWatLossSoilAcc (:) = undefined_real + noahmp%water%flux%TranspWatLossSoilMean(:) = undefined_real + + ! water parameter variables + noahmp%water%param%DrainSoilLayerInd = undefined_int + noahmp%water%param%TileDrainTubeDepth = undefined_int + noahmp%water%param%NumSoilLayerRoot = undefined_int + noahmp%water%param%IrriStopDayBfHarvest = undefined_int + noahmp%water%param%CanopyLiqHoldCap = undefined_real + noahmp%water%param%SnowCompactBurdenFac = undefined_real + noahmp%water%param%SnowCompactAgingFac1 = undefined_real + noahmp%water%param%SnowCompactAgingFac2 = undefined_real + noahmp%water%param%SnowCompactAgingFac3 = undefined_real + noahmp%water%param%SnowCompactAgingMax = undefined_real + noahmp%water%param%SnowViscosityCoeff = undefined_real + noahmp%water%param%SnowLiqFracMax = undefined_real + noahmp%water%param%SnowLiqHoldCap = undefined_real + noahmp%water%param%SnowLiqReleaseFac = undefined_real + noahmp%water%param%IrriFloodRateFac = undefined_real + noahmp%water%param%IrriMicroRate = undefined_real + noahmp%water%param%SoilInfilMaxCoeff = undefined_real + noahmp%water%param%SoilImpervFracCoeff = undefined_real + noahmp%water%param%InfilFacVic = undefined_real + noahmp%water%param%TensionWatDistrInfl = undefined_real + noahmp%water%param%TensionWatDistrShp = undefined_real + noahmp%water%param%FreeWatDistrShp = undefined_real + noahmp%water%param%InfilHeteroDynVic = undefined_real + noahmp%water%param%InfilCapillaryDynVic = undefined_real + noahmp%water%param%InfilFacDynVic = undefined_real + noahmp%water%param%SoilDrainSlope = undefined_real + noahmp%water%param%TileDrainCoeffSp = undefined_real + noahmp%water%param%DrainFacSoilWat = undefined_real + noahmp%water%param%TileDrainCoeff = undefined_real + noahmp%water%param%DrainDepthToImperv = undefined_real + noahmp%water%param%LateralWatCondFac = undefined_real + noahmp%water%param%TileDrainDepth = undefined_real + noahmp%water%param%DrainTubeDist = undefined_real + noahmp%water%param%DrainTubeRadius = undefined_real + noahmp%water%param%DrainWatDepToImperv = undefined_real + noahmp%water%param%RunoffDecayFac = undefined_real + noahmp%water%param%BaseflowCoeff = undefined_real + noahmp%water%param%GridTopoIndex = undefined_real + noahmp%water%param%SoilSfcSatFracMax = undefined_real + noahmp%water%param%SpecYieldGw = undefined_real + noahmp%water%param%MicroPoreContent = undefined_real + noahmp%water%param%WaterStorageLakeMax = undefined_real + noahmp%water%param%SnoWatEqvMaxGlacier = undefined_real + noahmp%water%param%SoilConductivityRef = undefined_real + noahmp%water%param%SoilInfilFacRef = undefined_real + noahmp%water%param%GroundFrzCoeff = undefined_real + noahmp%water%param%IrriTriggerLaiMin = undefined_real + noahmp%water%param%SoilWatDeficitAllow = undefined_real + noahmp%water%param%IrriFloodLossFrac = undefined_real + noahmp%water%param%IrriSprinklerRate = undefined_real + noahmp%water%param%IrriFracThreshold = undefined_real + noahmp%water%param%IrriStopPrecipThr = undefined_real + noahmp%water%param%SnowfallDensityMax = undefined_real + noahmp%water%param%SnowMassFullCoverOld = undefined_real + noahmp%water%param%SoilMatPotentialWilt = undefined_real + noahmp%water%param%SnowMeltFac = undefined_real + noahmp%water%param%SnowCoverFac = undefined_real + + if ( .not. allocated(noahmp%water%param%SoilMoistureSat) ) & + allocate( noahmp%water%param%SoilMoistureSat(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%water%param%SoilMoistureWilt) ) & + allocate( noahmp%water%param%SoilMoistureWilt(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%water%param%SoilMoistureFieldCap) ) & + allocate( noahmp%water%param%SoilMoistureFieldCap(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%water%param%SoilMoistureDry) ) & + allocate( noahmp%water%param%SoilMoistureDry(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%water%param%SoilWatDiffusivitySat) ) & + allocate( noahmp%water%param%SoilWatDiffusivitySat(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%water%param%SoilWatConductivitySat) ) & + allocate( noahmp%water%param%SoilWatConductivitySat(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%water%param%SoilExpCoeffB) ) & + allocate( noahmp%water%param%SoilExpCoeffB(1:NumSoilLayer) ) + if ( .not. allocated(noahmp%water%param%SoilMatPotentialSat) ) & + allocate( noahmp%water%param%SoilMatPotentialSat(1:NumSoilLayer) ) + + noahmp%water%param%SoilMoistureSat (:) = undefined_real + noahmp%water%param%SoilMoistureWilt (:) = undefined_real + noahmp%water%param%SoilMoistureFieldCap (:) = undefined_real + noahmp%water%param%SoilMoistureDry (:) = undefined_real + noahmp%water%param%SoilWatDiffusivitySat (:) = undefined_real + noahmp%water%param%SoilWatConductivitySat(:) = undefined_real + noahmp%water%param%SoilExpCoeffB (:) = undefined_real + noahmp%water%param%SoilMatPotentialSat (:) = undefined_real + + end associate + + end subroutine WaterVarInitDefault + +end module WaterVarInitMod diff --git a/src/core_atmosphere/physics/physics_noahmp/src/WaterVarType.F90 b/src/core_atmosphere/physics/physics_noahmp/src/WaterVarType.F90 new file mode 100644 index 000000000..2d2f91324 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/src/WaterVarType.F90 @@ -0,0 +1,244 @@ +module WaterVarType + +!!! Define column (1-D) Noah-MP Water variables +!!! Water variable initialization is done in WaterVarInitMod.F90 + +! ------------------------ Code history ----------------------------------- +! Original code: Guo-Yue Niu and Noah-MP team (Niu et al. 2011) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + use Machine + + implicit none + save + private + +!=== define "flux" sub-type of water (water%flux%variable) + type :: flux_type + + real(kind=kind_noahmp) :: RainfallRefHeight ! liquid rainfall rate [mm/s] at reference height + real(kind=kind_noahmp) :: SnowfallRefHeight ! snowfall rate [mm/s] at reference height + real(kind=kind_noahmp) :: PrecipTotRefHeight ! total precipitation [mm/s] at reference height + real(kind=kind_noahmp) :: PrecipConvTotRefHeight ! total convective precipitation [mm/s] at reference height + real(kind=kind_noahmp) :: PrecipLargeSclRefHeight ! large-scale precipitation [mm/s] at reference height + real(kind=kind_noahmp) :: EvapCanopyNet ! net evaporation of canopy intercepted total water [mm/s] + real(kind=kind_noahmp) :: Transpiration ! transpiration rate [mm/s] + real(kind=kind_noahmp) :: EvapCanopyLiq ! canopy liquid water evaporation rate [mm/s] + real(kind=kind_noahmp) :: DewCanopyLiq ! canopy water dew rate [mm/s] + real(kind=kind_noahmp) :: FrostCanopyIce ! canopy ice frost rate [mm/s] + real(kind=kind_noahmp) :: SublimCanopyIce ! canopy ice sublimation rate [mm/s] + real(kind=kind_noahmp) :: MeltCanopyIce ! canopy ice melting rate [mm/s] + real(kind=kind_noahmp) :: FreezeCanopyLiq ! canopy water freezing rate [mm/s] + real(kind=kind_noahmp) :: SnowfallGround ! snowfall on the ground (below canopy) [mm/s] + real(kind=kind_noahmp) :: SnowDepthIncr ! snow depth increasing rate [m/s] due to snowfall + real(kind=kind_noahmp) :: FrostSnowSfcIce ! snow surface ice frost rate[mm/s] + real(kind=kind_noahmp) :: SublimSnowSfcIce ! snow surface ice sublimation rate[mm/s] + real(kind=kind_noahmp) :: RainfallGround ! ground surface rain rate [mm/s] + real(kind=kind_noahmp) :: SnowBotOutflow ! total water (snowmelt + rain through pack) out of snowpack bottom [mm/s] + real(kind=kind_noahmp) :: GlacierExcessFlow ! glacier excess flow [mm/s] + real(kind=kind_noahmp) :: IrrigationRateFlood ! flood irrigation water rate [m/timestep] + real(kind=kind_noahmp) :: IrrigationRateMicro ! micro irrigation water rate [m/timestep] + real(kind=kind_noahmp) :: IrrigationRateSprinkler ! sprinkler irrigation water rate [m/timestep] + real(kind=kind_noahmp) :: IrriEvapLossSprinkler ! loss of irrigation water to evaporation,sprinkler [m/timestep] + real(kind=kind_noahmp) :: SoilSfcInflow ! water input on soil surface [m/s] + real(kind=kind_noahmp) :: RunoffSurface ! surface runoff [mm/s] + real(kind=kind_noahmp) :: RunoffSubsurface ! subsurface runoff [mm/s] + real(kind=kind_noahmp) :: InfilRateSfc ! infiltration rate at surface [m/s] + real(kind=kind_noahmp) :: EvapSoilSfcLiq ! soil surface water evaporation [m/s] + real(kind=kind_noahmp) :: DrainSoilBot ! soil bottom drainage [mm/s] + real(kind=kind_noahmp) :: TileDrain ! tile drainage [mm/s] + real(kind=kind_noahmp) :: RechargeGw ! groundwater recharge rate [mm/s] + real(kind=kind_noahmp) :: DischargeGw ! groundwater discharge rate [mm/s] + real(kind=kind_noahmp) :: VaporizeGrd ! ground vaporize rate total (evap+sublim) [mm/s] + real(kind=kind_noahmp) :: CondenseVapGrd ! ground vapor condense rate total (dew+frost) [mm/s] + real(kind=kind_noahmp) :: DewSoilSfcLiq ! soil surface water dew rate [mm/s] + real(kind=kind_noahmp) :: EvapIrriSprinkler ! evaporation of irrigation water, sprinkler [mm/s] + real(kind=kind_noahmp) :: InterceptCanopyRain ! interception rate for rain [mm/s] + real(kind=kind_noahmp) :: DripCanopyRain ! drip rate for intercepted rain [mm/s] + real(kind=kind_noahmp) :: ThroughfallRain ! throughfall for rain [mm/s] + real(kind=kind_noahmp) :: InterceptCanopySnow ! interception (loading) rate for snowfall [mm/s] + real(kind=kind_noahmp) :: DripCanopySnow ! drip (unloading) rate for intercepted snow [mm/s] + real(kind=kind_noahmp) :: ThroughfallSnow ! throughfall of snowfall [mm/s] + real(kind=kind_noahmp) :: EvapGroundNet ! net ground (soil/snow) evaporation [mm/s] + real(kind=kind_noahmp) :: MeltGroundSnow ! ground snow melting rate [mm/s] + real(kind=kind_noahmp) :: WaterToAtmosTotal ! total surface water vapor flux to atmosphere [mm/s] + real(kind=kind_noahmp) :: EvapSoilSfcLiqAcc ! accumulated soil surface water evaporation per soil timestep [m/s * dt_soil/dt_main] + real(kind=kind_noahmp) :: SoilSfcInflowAcc ! accumulated water input on soil surface per soil timestep [m/s * dt_soil/dt_main] + real(kind=kind_noahmp) :: SfcWaterTotChgAcc ! accumulated snow,soil,canopy water change per soil timestep [mm] + real(kind=kind_noahmp) :: PrecipTotAcc ! accumulated precipitation per soil timestep [mm] + real(kind=kind_noahmp) :: EvapCanopyNetAcc ! accumulated net evaporation of canopy intercepted water per soil timestep [mm] + real(kind=kind_noahmp) :: TranspirationAcc ! accumulated transpiration per soil timestep [mm] + real(kind=kind_noahmp) :: EvapGroundNetAcc ! accumulated net ground (soil/snow) evaporation per soil timestep [mm] + real(kind=kind_noahmp) :: EvapSoilSfcLiqMean ! mean soil surface water evaporation during soil timestep [m/s] + real(kind=kind_noahmp) :: SoilSfcInflowMean ! mean water input on soil surface during soil timestep [m/s] + + real(kind=kind_noahmp), allocatable, dimension(:) :: TranspWatLossSoil ! transpiration water loss from soil layers [m/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: TranspWatLossSoilAcc ! accumulated transpiration water loss from soil per soil timestep [m/s * dt_soil/dt_main] + real(kind=kind_noahmp), allocatable, dimension(:) :: TranspWatLossSoilMean ! mean transpiration water loss from soil during soil timestep [m/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: CompactionSnowAging ! rate of snow compaction due to destructive metamorphism/aging [1/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: CompactionSnowBurden ! rate of snow compaction due to overburden [1/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: CompactionSnowMelt ! rate of snow compaction due to melt [1/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: CompactionSnowTot ! rate of total snow compaction [fraction/timestep] + + end type flux_type + + +!=== define "state" sub-type of water (water%state%variable) + type :: state_type + + integer :: IrrigationCntSprinkler ! irrigation event number, Sprinkler + integer :: IrrigationCntMicro ! irrigation event number, Micro + integer :: IrrigationCntFlood ! irrigation event number, Flood + real(kind=kind_noahmp) :: CanopyTotalWater ! total (liquid+ice) canopy intercepted water [mm] + real(kind=kind_noahmp) :: CanopyWetFrac ! wetted or snowed fraction of the canopy + real(kind=kind_noahmp) :: SnowfallDensity ! bulk density of snowfall (kg/m3) + real(kind=kind_noahmp) :: CanopyLiqWater ! intercepted canopy liquid water [mm] + real(kind=kind_noahmp) :: CanopyIce ! intercepted canopy ice [mm] + real(kind=kind_noahmp) :: CanopyIceMax ! canopy capacity for snow interception [mm] + real(kind=kind_noahmp) :: CanopyLiqWaterMax ! canopy capacity for rain interception [mm] + real(kind=kind_noahmp) :: SnowDepth ! snow depth [m] + real(kind=kind_noahmp) :: SnowWaterEquiv ! snow water equivalent (ice+liquid) [mm] + real(kind=kind_noahmp) :: SnowWaterEquivPrev ! snow water equivalent at previous time step (mm) + real(kind=kind_noahmp) :: PondSfcThinSnwMelt ! surface ponding [mm] from snowmelt when snow has no layer + real(kind=kind_noahmp) :: PondSfcThinSnwComb ! surface ponding [mm] from liquid in thin snow layer combination + real(kind=kind_noahmp) :: PondSfcThinSnwTrans ! surface ponding [mm] from thin snow liquid during transition from multilayer to no layer + real(kind=kind_noahmp) :: IrrigationFracFlood ! fraction of grid under flood irrigation (0 to 1) + real(kind=kind_noahmp) :: IrrigationAmtFlood ! flood irrigation water amount [m] + real(kind=kind_noahmp) :: IrrigationFracMicro ! fraction of grid under micro irrigation (0 to 1) + real(kind=kind_noahmp) :: IrrigationAmtMicro ! micro irrigation water amount [m] + real(kind=kind_noahmp) :: IrrigationFracSprinkler ! fraction of grid under sprinkler irrigation (0 to 1) + real(kind=kind_noahmp) :: IrrigationAmtSprinkler ! sprinkler irrigation water amount [m] + real(kind=kind_noahmp) :: WaterTableDepth ! water table depth [m] + real(kind=kind_noahmp) :: SoilIceMax ! maximum soil ice content [m3/m3] + real(kind=kind_noahmp) :: SoilLiqWaterMin ! minimum soil liquid water content [m3/m3] + real(kind=kind_noahmp) :: SoilSaturateFrac ! fractional saturated area for soil moisture + real(kind=kind_noahmp) :: SoilImpervFracMax ! maximum soil imperviousness fraction + real(kind=kind_noahmp) :: SoilMoistureToWT ! soil moisture between bottom of the soil and the water table + real(kind=kind_noahmp) :: RechargeGwDeepWT ! groundwater recharge to or from the water table when deep [m] + real(kind=kind_noahmp) :: RechargeGwShallowWT ! groundwater recharge to or from shallow water table [m] + real(kind=kind_noahmp) :: SoilSaturationExcess ! saturation excess of the total soil [m] + real(kind=kind_noahmp) :: WaterTableHydro ! water table depth estimated in WRF-Hydro fine grids [m] + real(kind=kind_noahmp) :: TileDrainFrac ! tile drainage fraction + real(kind=kind_noahmp) :: WaterStorageAquifer ! water storage in aquifer [mm] + real(kind=kind_noahmp) :: WaterStorageSoilAqf ! water storage in aquifer + saturated soil [mm] + real(kind=kind_noahmp) :: WaterStorageLake ! water storage in lake (can be negative) [mm] + real(kind=kind_noahmp) :: WaterHeadSfc ! surface water head [mm] + real(kind=kind_noahmp) :: IrrigationFracGrid ! total irrigation fraction from input for a grid + real(kind=kind_noahmp) :: PrecipAreaFrac ! fraction of the gridcell that receives precipitation + real(kind=kind_noahmp) :: SnowCoverFrac ! snow cover fraction + real(kind=kind_noahmp) :: SoilTranspFacAcc ! accumulated soil water transpiration factor (0 to 1) + real(kind=kind_noahmp) :: FrozenPrecipFrac ! fraction of frozen precip in total precipitation + real(kind=kind_noahmp) :: SoilWaterRootZone ! root zone soil water + real(kind=kind_noahmp) :: SoilWaterStress ! soil water stress + real(kind=kind_noahmp) :: WaterStorageTotBeg ! total water storage [mm] at the begining before NoahMP process + real(kind=kind_noahmp) :: WaterBalanceError ! water balance error [mm] + real(kind=kind_noahmp) :: WaterStorageTotEnd ! total water storage [mm] at the end of NoahMP process + + integer , allocatable, dimension(:) :: IndexPhaseChange ! phase change index (0-none;1-melt;2-refreeze) + real(kind=kind_noahmp), allocatable, dimension(:) :: SnowIce ! snow layer ice [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: SnowLiqWater ! snow layer liquid water [mm] + real(kind=kind_noahmp), allocatable, dimension(:) :: SnowIceFracPrev ! ice fraction in snow layers at previous timestep + real(kind=kind_noahmp), allocatable, dimension(:) :: SnowIceFrac ! ice fraction in snow layers at current timestep + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilIceFrac ! ice fraction in soil layers at current timestep + real(kind=kind_noahmp), allocatable, dimension(:) :: SnowEffPorosity ! snow effective porosity [m3/m3] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilLiqWater ! soil liquid moisture [m3/m3] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilIce ! soil ice moisture [m3/m3] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilMoisture ! total soil moisture [m3/m3] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilImpervFrac ! fraction of imperviousness due to frozen soil + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilWatConductivity ! soil hydraulic/water conductivity [m/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilWatDiffusivity ! soil water diffusivity [m2/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilEffPorosity ! soil effective porosity [m3/m3] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilMoistureEqui ! equilibrium soil water content [m3/m3] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilTranspFac ! soil water transpiration factor (0 to 1) + real(kind=kind_noahmp), allocatable, dimension(:) :: SnowIceVol ! partial volume of snow ice [m3/m3] + real(kind=kind_noahmp), allocatable, dimension(:) :: SnowLiqWaterVol ! partial volume of snow liquid water [m3/m3] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilSupercoolWater ! supercooled water in soil [kg/m2] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilMatPotential ! soil matric potential [m] + + end type state_type + + +!=== define "parameter" sub-type of water (water%param%variable) + type :: parameter_type + + integer :: DrainSoilLayerInd ! starting soil layer for drainage + integer :: TileDrainTubeDepth ! depth [m] of drain tube from the soil surface for simple scheme + integer :: NumSoilLayerRoot ! number of soil layers with root present + integer :: IrriStopDayBfHarvest ! number of days before harvest date to stop irrigation + real(kind=kind_noahmp) :: CanopyLiqHoldCap ! maximum canopy intercepted liquid water per unit veg area index [mm] + real(kind=kind_noahmp) :: SnowCompactBurdenFac ! overburden snow compaction parameter [m3/kg] + real(kind=kind_noahmp) :: SnowCompactAgingFac1 ! snow desctructive metamorphism compaction parameter1 [1/s] + real(kind=kind_noahmp) :: SnowCompactAgingFac2 ! snow desctructive metamorphism compaction parameter2 [1/k] + real(kind=kind_noahmp) :: SnowCompactAgingFac3 ! snow desctructive metamorphism compaction parameter3 + real(kind=kind_noahmp) :: SnowCompactAgingMax ! upper Limit on destructive metamorphism compaction [kg/m3] + real(kind=kind_noahmp) :: SnowViscosityCoeff ! snow viscosity coefficient [kg-s/m2], Anderson1979: 0.52e6~1.38e6 + real(kind=kind_noahmp) :: SnowLiqFracMax ! maximum liquid water fraction in snow + real(kind=kind_noahmp) :: SnowLiqHoldCap ! liquid water holding capacity for snowpack [m3/m3] + real(kind=kind_noahmp) :: SnowLiqReleaseFac ! snowpack water release timescale factor [1/s] + real(kind=kind_noahmp) :: IrriFloodRateFac ! flood irrigation application rate factor + real(kind=kind_noahmp) :: IrriMicroRate ! micro irrigation rate [mm/hr] + real(kind=kind_noahmp) :: SoilInfilMaxCoeff ! parameter to calculate maximum soil infiltration rate + real(kind=kind_noahmp) :: SoilImpervFracCoeff ! parameter to calculate frozen soil impermeable fraction + real(kind=kind_noahmp) :: InfilFacVic ! VIC model infiltration parameter + real(kind=kind_noahmp) :: TensionWatDistrInfl ! Tension water distribution inflection parameter + real(kind=kind_noahmp) :: TensionWatDistrShp ! Tension water distribution shape parameter + real(kind=kind_noahmp) :: FreeWatDistrShp ! Free water distribution shape parameter + real(kind=kind_noahmp) :: InfilHeteroDynVic ! DVIC heterogeniety parameter for infiltration + real(kind=kind_noahmp) :: InfilCapillaryDynVic ! DVIC Mean Capillary Drive (m) for infiltration models + real(kind=kind_noahmp) :: InfilFacDynVic ! DVIC model infiltration parameter + real(kind=kind_noahmp) :: SoilDrainSlope ! slope index for soil drainage + real(kind=kind_noahmp) :: TileDrainCoeffSp ! drainage coefficient [mm d^-1] for simple scheme + real(kind=kind_noahmp) :: DrainFacSoilWat ! drainage factor for soil moisture + real(kind=kind_noahmp) :: TileDrainCoeff ! drainage coefficent [m d^-1] for Hooghoudt scheme + real(kind=kind_noahmp) :: DrainDepthToImperv ! Actual depth of tile drainage to impermeable layer form surface + real(kind=kind_noahmp) :: LateralWatCondFac ! multiplication factor to determine lateral hydraulic conductivity + real(kind=kind_noahmp) :: TileDrainDepth ! Depth of drain [m] for Hooghoudt scheme + real(kind=kind_noahmp) :: DrainTubeDist ! distance between two drain tubes or tiles [m] + real(kind=kind_noahmp) :: DrainTubeRadius ! effective radius of drain tubes [m] + real(kind=kind_noahmp) :: DrainWatDepToImperv ! depth to impervious layer from drain water level [m] + real(kind=kind_noahmp) :: RunoffDecayFac ! runoff decay factor [m^-1] + real(kind=kind_noahmp) :: BaseflowCoeff ! baseflow coefficient [mm/s] + real(kind=kind_noahmp) :: GridTopoIndex ! gridcell mean topgraphic index (global mean) + real(kind=kind_noahmp) :: SoilSfcSatFracMax ! maximum surface soil saturated fraction (global mean) + real(kind=kind_noahmp) :: SpecYieldGw ! specific yield [-] for Niu et al. 2007 groundwater scheme + real(kind=kind_noahmp) :: MicroPoreContent ! microprore content (0.0-1.0), 0.0: close to free drainage + real(kind=kind_noahmp) :: WaterStorageLakeMax ! maximum lake water storage [mm] + real(kind=kind_noahmp) :: SnoWatEqvMaxGlacier ! Maximum SWE allowed at glaciers [mm] + real(kind=kind_noahmp) :: SoilConductivityRef ! Reference Soil Conductivity parameter (used in runoff formulation) + real(kind=kind_noahmp) :: SoilInfilFacRef ! Reference Soil Infiltration Parameter (used in runoff formulation) + real(kind=kind_noahmp) :: GroundFrzCoeff ! Frozen ground parameter to compute frozen soil impervious fraction + real(kind=kind_noahmp) :: IrriTriggerLaiMin ! minimum lai to trigger irrigation + real(kind=kind_noahmp) :: SoilWatDeficitAllow ! management allowable deficit (0-1) + real(kind=kind_noahmp) :: IrriFloodLossFrac ! factor of flood irrigation loss + real(kind=kind_noahmp) :: IrriSprinklerRate ! sprinkler irrigation rate [mm/h] + real(kind=kind_noahmp) :: IrriFracThreshold ! irrigation Fraction threshold in a grid + real(kind=kind_noahmp) :: IrriStopPrecipThr ! precipitation threshold [mm/hr] to stop irrigation trigger + real(kind=kind_noahmp) :: SnowfallDensityMax ! maximum fresh snowfall density [kg/m3] + real(kind=kind_noahmp) :: SnowMassFullCoverOld ! new snow mass to fully cover old snow [mm] + real(kind=kind_noahmp) :: SoilMatPotentialWilt ! soil metric potential for wilting point [m] + real(kind=kind_noahmp) :: SnowMeltFac ! snowmelt m parameter in snow cover fraction calculation + real(kind=kind_noahmp) :: SnowCoverFac ! snow cover factor [m] (originally hard-coded 2.5*z0 in SCF formulation) + + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilMoistureSat ! saturated value of soil moisture [m3/m3] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilMoistureWilt ! wilting point soil moisture [m3/m3] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilMoistureFieldCap ! reference soil moisture (field capacity) [m3/m3] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilMoistureDry ! dry soil moisture threshold [m3/m3] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilWatDiffusivitySat ! saturated soil hydraulic diffusivity [m2/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilWatConductivitySat ! saturated soil hydraulic conductivity [m/s] + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilExpCoeffB ! soil exponent B paramete + real(kind=kind_noahmp), allocatable, dimension(:) :: SoilMatPotentialSat ! saturated soil matric potential [m] + + end type parameter_type + + +!=== define water type that includes 3 subtypes (flux,state,parameter) + type, public :: water_type + + type(flux_type) :: flux + type(state_type) :: state + type(parameter_type) :: param + + end type water_type + +end module WaterVarType diff --git a/src/core_atmosphere/physics/physics_noahmp/utility/CheckNanMod.F90 b/src/core_atmosphere/physics/physics_noahmp/utility/CheckNanMod.F90 new file mode 100644 index 000000000..54bb631d3 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/utility/CheckNanMod.F90 @@ -0,0 +1,26 @@ +module CheckNanMod + +!!! Check NaN values + + use Machine, only : kind_noahmp + + implicit none + +contains + + subroutine CheckRealNaN(NumIn, OutVal) + +! ------------------------ Code history ----------------------------------- +! Original Noah-MP subroutine: embedded in NOAHMP_SFLX +! Original code: P. Valayamkunnath (2021) +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + real(kind=kind_noahmp), intent(in) :: NumIn + logical , intent(out) :: OutVal + + OutVal = (NumIn /= NumIn) + + end subroutine CheckRealNaN + +end module CheckNanMod diff --git a/src/core_atmosphere/physics/physics_noahmp/utility/ErrorHandleMod.F90 b/src/core_atmosphere/physics/physics_noahmp/utility/ErrorHandleMod.F90 new file mode 100644 index 000000000..74466efa3 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/utility/ErrorHandleMod.F90 @@ -0,0 +1,26 @@ +module ErrorHandleMod + +!!! define subroutines handling Noah-MP model errors + + use netcdf + + implicit none + +contains + + subroutine ErrorHandle(status) + +! ------------------------ Code history ----------------------------------- +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + integer, intent (in) :: status + + if(status /= nf90_noerr) then + print *, trim( nf90_strerror(status) ) + stop "Stopped" + endif + + end subroutine ErrorHandle + +end module ErrorHandleMod diff --git a/src/core_atmosphere/physics/physics_noahmp/utility/Machine.F90 b/src/core_atmosphere/physics/physics_noahmp/utility/Machine.F90 new file mode 100644 index 000000000..aafa838a7 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/utility/Machine.F90 @@ -0,0 +1,22 @@ +module Machine +use mpas_kind_types,only: RKIND + +!!! define machine-related constants and parameters +!!! To define real data type precision, use "-DOUBLE_PREC" in CPPFLAG in user_build_options file +!!! By default, Noah-MP uses single precision + +! ------------------------ Code history ----------------------------------- +! Refactered code: C. He, P. Valayamkunnath, & refactor team (He et al. 2023) +! ------------------------------------------------------------------------- + + implicit none + save + private + + integer, public, parameter :: kind_noahmp = RKIND + integer, public, parameter :: undefined_int = -9999 ! undefined integer for variable initialization + real(kind=kind_noahmp), public, parameter :: undefined_real = -9999.0 ! undefined real for variable initializatin + integer, public, parameter :: undefined_int_neg = -9999 ! undefined integer negative for variable initialization + real(kind=kind_noahmp), public, parameter :: undefined_real_neg = -9999.0 ! undefined real negative for variable initializatin + +end module Machine diff --git a/src/core_atmosphere/physics/physics_noahmp/utility/Makefile b/src/core_atmosphere/physics/physics_noahmp/utility/Makefile new file mode 100644 index 000000000..c5b584655 --- /dev/null +++ b/src/core_atmosphere/physics/physics_noahmp/utility/Makefile @@ -0,0 +1,30 @@ +.SUFFIXES: .F90 .o + +.PHONY: utility utility_lib + +all: dummy utility + +dummy: + echo "****** compiling physics_noahmp/utility ******" + +OBJS = Machine.o \ + CheckNanMod.o + +utility: $(OBJS) + +utility_lib: + ar -ru ./../../libphys.a $(OBJS) + +# DEPENDENCIES: +CheckNanMod.o: \ + Machine.o + +clean: + $(RM) *.f90 *.o *.mod + @# Certain systems with intel compilers generate *.i files + @# This removes them during the clean process + $(RM) *.i + +.F90.o: + $(FC) $(CPPFLAGS) $(COREDEF) $(FFLAGS) -c $*.F90 $(CPPINCLUDES) $(FCINCLUDES) -I../../../../framework + diff --git a/src/core_atmosphere/physics/physics_wrf/Makefile b/src/core_atmosphere/physics/physics_wrf/Makefile index e9dabbc0e..4495b7496 100644 --- a/src/core_atmosphere/physics/physics_wrf/Makefile +++ b/src/core_atmosphere/physics/physics_wrf/Makefile @@ -1,5 +1,7 @@ .SUFFIXES: .F .o +.PHONY: physics_wrf physics_wrf_lib + all: dummy physics_wrf dummy: @@ -9,6 +11,7 @@ OBJS = \ libmassv.o \ module_bep_bem_helper.o \ module_bl_gwdo.o \ + module_bl_ugwp_gwdo.o \ module_bl_mynn.o \ module_bl_ysu.o \ module_cam_error_function.o \ @@ -20,12 +23,14 @@ OBJS = \ module_cu_kfeta.o \ module_mp_kessler.o \ module_mp_thompson.o \ + module_mp_thompson_aerosols.o \ module_mp_thompson_cldfra3.o \ module_mp_wsm6.o \ module_ra_cam.o \ module_ra_cam_support.o \ module_ra_rrtmg_lw.o \ module_ra_rrtmg_sw.o \ + module_ra_rrtmg_sw_aerosols.o \ module_ra_rrtmg_vinterp.o \ module_sf_bem.o \ module_sf_bep.o \ @@ -34,18 +39,24 @@ 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_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_sfclayrev.o \ module_sf_urban.o \ bl_mynn_post.o \ bl_mynn_pre.o \ - sf_mynn_pre.o + cu_ntiedtke_post.o \ + cu_ntiedtke_pre.o \ + sf_mynn_pre.o \ + sf_sfclayrev_pre.o + physics_wrf: $(OBJS) + +physics_wrf_lib: ar -ru ./../libphys.a $(OBJS) # DEPENDENCIES: @@ -56,6 +67,10 @@ module_bl_mynn.o: \ module_cam_support.o: \ module_cam_shr_kind_mod.o +module_cu_ntiedtke.o: \ + cu_ntiedtke_post.o \ + cu_ntiedtke_pre.o + module_ra_cam.o: \ module_cam_support.o \ module_ra_cam_support.o @@ -79,22 +94,25 @@ module_sf_bep_bem.o: \ module_sf_mynn.o: \ sf_mynn_pre.o +module_sf_sfclayrev.o: \ + sf_sfclayrev_pre.o + module_sf_noahdrv.o: \ module_sf_bem.o \ module_sf_bep.o \ module_sf_bep_bem.o \ module_sf_noahlsm.o \ - module_sf_noahlsm_glacial_only.o \ + module_sf_noahlsm_glacial_only.o \ module_sf_urban.o module_sf_noahlsm_glacial_only.o: \ - module_sf_noahlsm.o + module_sf_noahlsm.o module_sf_noah_seaice_drv.o: \ - module_sf_noah_seaice.o + module_sf_noah_seaice.o module_sf_noah_seaice.o: \ - module_sf_noahlsm.o + module_sf_noahlsm.o clean: $(RM) *.f90 *.o *.mod @@ -107,5 +125,5 @@ ifeq "$(GEN_F90)" "true" $(CPP) $(CPPFLAGS) $(COREDEF) $(CPPINCLUDES) $< > $*.f90 $(FC) $(FFLAGS) -c $*.f90 $(FCINCLUDES) -I.. -I../physics_mmm -I../../../framework -I../../../external/esmf_time_f90 else - $(FC) $(CPPFLAGS) $(COREDEF) $(FFLAGS) -c $*.F $(CPPINCLUDES) $(FCINCLUDES) -I.. -I../physics_mmm -I../../../framework -I../../../external/esmf_time_f90 + $(FC) $(CPPFLAGS) $(COREDEF) $(FFLAGS) -c $*.F $(CPPINCLUDES) $(FCINCLUDES) -I.. -I../physics_mmm -I../physics_noaa/UGWP -I../../../framework -I../../../external/esmf_time_f90 endif diff --git a/src/core_atmosphere/physics/physics_wrf/bl_mynn_post.F b/src/core_atmosphere/physics/physics_wrf/bl_mynn_post.F index 096010ed1..ffca583a8 100644 --- a/src/core_atmosphere/physics/physics_wrf/bl_mynn_post.F +++ b/src/core_atmosphere/physics/physics_wrf/bl_mynn_post.F @@ -1,6 +1,6 @@ !================================================================================================================= module bl_mynn_post - use ccpp_kinds,only: kind_phys + use ccpp_kind_types,only: kind_phys implicit none private @@ -57,6 +57,9 @@ subroutine bl_mynn_post_finalize(errmsg,errflg) end subroutine bl_mynn_post_finalize !================================================================================================================= +!>\section arg_table_bl_mynn_post_run +!!\html\include bl_mynn_post_run.html +!! subroutine bl_mynn_post_run(its,ite,kte,f_qc,f_qi,f_qs,delt,qv,qc,qi,qs,dqv,dqc,dqi,dqs,errmsg,errflg) !================================================================================================================= diff --git a/src/core_atmosphere/physics/physics_wrf/bl_mynn_pre.F b/src/core_atmosphere/physics/physics_wrf/bl_mynn_pre.F index dfd583120..5b7696960 100644 --- a/src/core_atmosphere/physics/physics_wrf/bl_mynn_pre.F +++ b/src/core_atmosphere/physics/physics_wrf/bl_mynn_pre.F @@ -1,6 +1,6 @@ !================================================================================================================= module bl_mynn_pre - use ccpp_kinds,only: kind_phys + use ccpp_kind_types,only: kind_phys implicit none private diff --git a/src/core_atmosphere/physics/physics_wrf/cu_ntiedtke_post.F b/src/core_atmosphere/physics/physics_wrf/cu_ntiedtke_post.F new file mode 100644 index 000000000..e08c87d9f --- /dev/null +++ b/src/core_atmosphere/physics/physics_wrf/cu_ntiedtke_post.F @@ -0,0 +1,120 @@ +!================================================================================================================= + module cu_ntiedtke_post + use ccpp_kind_types,only: kind_phys + + implicit none + private + public:: cu_ntiedtke_post_init, & + cu_ntiedtke_post_finalize, & + cu_ntiedtke_post_run + + + contains + + +!================================================================================================================= +!>\section arg_table_cu_ntiedtke_post_init +!!\html\include cu_ntiedtke_post_init.html +!! + subroutine cu_ntiedtke_post_init(errmsg,errflg) +!================================================================================================================= + +!--- output arguments: + character(len=*),intent(out):: & + errmsg ! output error message (-). + + integer,intent(out):: & + errflg ! output error flag (-). + +!----------------------------------------------------------------------------------------------------------------- + +!--- output error flag and message: + errflg = 0 + errmsg = " " + + end subroutine cu_ntiedtke_post_init + +!================================================================================================================= +!>\section arg_table_cu_ntiedtke_post_finalize +!!\html\include cu_ntiedtke_post_finalize.html +!! + subroutine cu_ntiedtke_post_finalize(errmsg,errflg) +!================================================================================================================= + +!--- output arguments: + character(len=*),intent(out):: & + errmsg ! output error message (-). + + integer,intent(out):: & + errflg ! output error flag (-). + +!----------------------------------------------------------------------------------------------------------------- + +!--- output error flag and message: + errflg = 0 + errmsg = " " + + end subroutine cu_ntiedtke_post_finalize + +!================================================================================================================= +!>\section arg_table_cu_ntiedtke_post_run +!!\html\include cu_ntiedtke_post_run.html +!! + subroutine cu_ntiedtke_post_run(its,ite,kts,kte,stepcu,dt,exner,qv,qc,qi,t,u,v,qvf,qcf,qif,tf,uf,vf,rn,raincv, & + pratec,rthcuten,rqvcuten,rqccuten,rqicuten,rucuten,rvcuten,errmsg,errflg) +!================================================================================================================= + +!--- input arguments: + integer,intent(in):: its,ite,kts,kte + integer,intent(in):: stepcu + + real(kind=kind_phys),intent(in):: dt + real(kind=kind_phys),intent(in),dimension(its:ite):: rn + real(kind=kind_phys),intent(in),dimension(its:ite,kts:kte):: exner,qv,qc,qi,t,u,v,qvf,qcf,qif,tf,uf,vf + +!--- inout arguments: + real(kind=kind_phys),intent(inout),dimension(its:ite):: raincv,pratec + real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte):: rqvcuten,rqccuten,rqicuten + real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte):: rthcuten,rucuten,rvcuten + +!--- output arguments: + character(len=*),intent(out):: errmsg + integer,intent(out):: errflg + +!--- local variables and arrays: + integer:: i,k,pp,zz + + real(kind=kind_phys):: delt,rdelt + +!----------------------------------------------------------------------------------------------------------------- + + delt = dt*stepcu + rdelt = 1./delt + + do i = its,ite + raincv(i) = rn(i)/stepcu + pratec(i) = rn(i)/(stepcu*dt) + enddo + + pp = 0 + do k = kts,kte + zz = kte - pp + do i = its,ite + rthcuten(i,k) = (tf(i,zz)-t(i,k))/exner(i,k)*rdelt + rqvcuten(i,k) = (qvf(i,zz)-qv(i,k))*rdelt + rqccuten(i,k) = (qcf(i,zz)-qc(i,k))*rdelt + rqicuten(i,k) = (qif(i,zz)-qi(i,k))*rdelt + rucuten(i,k) = (uf(i,zz)-u(i,k))*rdelt + rvcuten(i,k) = (vf(i,zz)-v(i,k))*rdelt + enddo + pp = pp + 1 + enddo + + errmsg = 'cu_ntiedtke_post_run OK' + errflg = 0 + + end subroutine cu_ntiedtke_post_run + +!================================================================================================================= + end module cu_ntiedtke_post +!================================================================================================================= diff --git a/src/core_atmosphere/physics/physics_wrf/cu_ntiedtke_pre.F b/src/core_atmosphere/physics/physics_wrf/cu_ntiedtke_pre.F new file mode 100644 index 000000000..84d2d89a5 --- /dev/null +++ b/src/core_atmosphere/physics/physics_wrf/cu_ntiedtke_pre.F @@ -0,0 +1,187 @@ +!================================================================================================================= + module cu_ntiedtke_pre + use ccpp_kind_types,only: kind_phys + + implicit none + private + public:: cu_ntiedtke_pre_init, & + cu_ntiedtke_pre_finalize, & + cu_ntiedtke_pre_run + + + contains + + +!================================================================================================================= +!>\section arg_table_cu_ntiedtke_pre_init +!!\html\include cu_ntiedtke_pre_init.html +!! + subroutine cu_ntiedtke_pre_init(errmsg,errflg) +!================================================================================================================= + +!--- output arguments: + character(len=*),intent(out):: & + errmsg ! output error message (-). + + integer,intent(out):: & + errflg ! output error flag (-). + +!----------------------------------------------------------------------------------------------------------------- + +!--- output error flag and message: + errflg = 0 + errmsg = " " + + end subroutine cu_ntiedtke_pre_init + +!================================================================================================================= +!>\section arg_table_cu_ntiedtke_pre_finalize +!!\html\include cu_ntiedtke_pre_finalize.html +!! + subroutine cu_ntiedtke_pre_finalize(errmsg,errflg) +!================================================================================================================= + +!--- output arguments: + character(len=*),intent(out):: & + errmsg ! output error message (-). + + integer,intent(out):: & + errflg ! output error flag (-). + +!----------------------------------------------------------------------------------------------------------------- + +!--- output error flag and message: + errflg = 0 + errmsg = " " + + end subroutine cu_ntiedtke_pre_finalize + +!================================================================================================================= +!>\section arg_table_cu_ntiedtke_pre_run +!!\html\include cu_ntiedtke_pre_run.html +!! + subroutine cu_ntiedtke_pre_run(its,ite,kts,kte,im,kx,kx1,itimestep,stepcu,dt,grav,xland,dz,pres,presi, & + t,rho,qv,qc,qi,u,v,w,qvften,thften,qvftenz,thftenz,slimsk,delt,prsl,ghtl, & + tf,qvf,qcf,qif,uf,vf,prsi,ghti,omg,errmsg,errflg) +!================================================================================================================= + +!--- input arguments: + integer,intent(in):: its,ite,kts,kte + integer,intent(in):: itimestep + integer,intent(in):: stepcu + + real(kind=kind_phys),intent(in):: dt,grav + real(kind=kind_phys),intent(in),dimension(its:ite):: xland + real(kind=kind_phys),intent(in),dimension(its:ite,kts:kte):: dz,pres,t,rho,qv,qc,qi,u,v + real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte):: qvften,thften + real(kind=kind_phys),intent(in),dimension(its:ite,kts:kte+1):: presi,w + +!--- inout arguments: + integer,intent(inout):: im,kx,kx1 + integer,intent(inout),dimension(its:ite):: slimsk + + real(kind=kind_phys),intent(inout):: delt + real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte):: tf,qvf,qcf,qif,uf,vf + real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte):: ghtl,omg,prsl + real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte):: qvftenz,thftenz + real(kind=kind_phys),intent(inout),dimension(its:ite,kts:kte+1):: ghti,prsi + +!--- output arguments: + character(len=*),intent(out):: errmsg + integer,intent(out):: errflg + +!--- local variables and arrays: + integer:: i,k,pp,zz + + real(kind=kind_phys),dimension(its:ite,kts:kte):: zl,dot + real(kind=kind_phys),dimension(its:ite,kts:kte+1):: zi + +!----------------------------------------------------------------------------------------------------------------- + + im = ite-its+1 + kx = kte-kts+1 + kx1 = kx+1 + + delt = dt*stepcu + + do i = its,ite + slimsk(i) = (abs(xland(i)-2.)) + enddo + + k = kts + do i = its,ite + zi(i,k) = 0. + enddo + do k = kts,kte + do i = its,ite + zi(i,k+1) = zi(i,k)+dz(i,k) + enddo + enddo + do k = kts,kte + do i = its,ite + zl(i,k) = 0.5*(zi(i,k)+zi(i,k+1)) + dot(i,k) = -0.5*grav*rho(i,k)*(w(i,k)+w(i,k+1)) + enddo + enddo + + pp = 0 + do k = kts,kte+1 + zz = kte + 1 - pp + do i = its,ite + ghti(i,zz) = zi(i,k) + prsi(i,zz) = presi(i,k) + enddo + pp = pp + 1 + enddo + pp = 0 + do k = kts,kte + zz = kte-pp + do i = its,ite + ghtl(i,zz) = zl(i,k) + omg(i,zz) = dot(i,k) + prsl(i,zz) = pres(i,k) + enddo + pp = pp + 1 + enddo + + pp = 0 + do k = kts,kte + zz = kte-pp + do i = its,ite + tf(i,zz) = t(i,k) + qvf(i,zz) = qv(i,k) + qcf(i,zz) = qc(i,k) + qif(i,zz) = qi(i,k) + uf(i,zz) = u(i,k) + vf(i,zz) = v(i,k) + enddo + pp = pp + 1 + enddo + + if(itimestep == 1) then + do k = kts,kte + do i = its,ite + qvftenz(i,k) = 0. + thftenz(i,k) = 0. + enddo + enddo + else + pp = 0 + do k = kts,kte + zz = kte-pp + do i = its,ite + qvftenz(i,zz) = qvften(i,k) + thftenz(i,zz) = thften(i,k) + enddo + pp = pp + 1 + enddo + endif + + errmsg = 'cu_ntiedtke_pre_run OK' + errflg = 0 + + end subroutine cu_ntiedtke_pre_run + +!================================================================================================================= + end module cu_ntiedtke_pre +!================================================================================================================= diff --git a/src/core_atmosphere/physics/physics_wrf/module_bl_ugwp_gwdo.F b/src/core_atmosphere/physics/physics_wrf/module_bl_ugwp_gwdo.F new file mode 100644 index 000000000..d916c4a72 --- /dev/null +++ b/src/core_atmosphere/physics/physics_wrf/module_bl_ugwp_gwdo.F @@ -0,0 +1,471 @@ +!================================================================================================================= + module module_bl_ugwp_gwdo + use mpas_kind_types,only: kind_phys => RKIND + use bl_ugwp,only: bl_ugwp_run + use bl_ugwpv1_ngw,only: ugwpv1_ngw_run + + implicit none + private + public:: gwdo_ugwp + + + contains + + +!================================================================================================================= + subroutine gwdo_ugwp(u3d,v3d,t3d,qv3d,p3d,p3di,pi3d,z,pblh,kpbl2d,br1,xland, & + rublten,rvblten,rthblten, & + dtaux3d,dtauy3d,dusfcg,dvsfcg, & + dtaux3d_ls,dtauy3d_ls,dtaux3d_bl,dtauy3d_bl, & + dtaux3d_ss,dtauy3d_ss,dtaux3d_fd,dtauy3d_fd, & + dusfc_ls,dvsfc_ls,dusfc_bl,dvsfc_bl,dusfc_ss,dvsfc_ss, & + dusfc_fd,dvsfc_fd,ugwp_diags,ngw_scheme,xlatd, & + jindx1_tau,jindx2_tau,ddy_j1tau,ddy_j2tau,r_DoY, & + raincv,rainncv,ntau_d1y,ntau_d2t,days_limb,tau_limb, & + dudt_ngw,dvdt_ngw,dtdt_ngw, & + var2dls,oc12dls,oa2d1ls,oa2d2ls,oa2d3ls,oa2d4ls,ol2d1ls, & + ol2d2ls,ol2d3ls,ol2d4ls,var2dss,oc12dss,oa2d1ss,oa2d2ss, & + oa2d3ss,oa2d4ss,ol2d1ss,ol2d2ss,ol2d3ss,ol2d4ss, & + sina,cosa,zi,dz,znu,znw,p_top, & + cp,g,rd,rv,ep1,pi, & + dt,dx,itimestep, & + ids,ide, jds,jde, kds,kde, & + ims,ime, jms,jme, kms,kme, & + its,ite, jts,jte, kts,kte, & + errmsg,errflg & + ) +!================================================================================================================= +! +!-- 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) +!-- pblh PBL height (m) +!-- br1 bulk Richardson number at lowest model level +!-- kpbl2d index level of PBL top +!-- xland land mask (1 for land, 2 for water) +!-- rublten u tendency due to pbl parameterization (m/s/s) +!-- rvblten v tendency due to pbl parameterization (m/s/s) +!-- rthblten potential temperature tendency due to pbl parameterization (K/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 of layer centers (m) +!-- zi height above sea level of layer interfaces (m) +!-- dz layer thickness (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 +! +!================================================================================================================= + +!--- input arguments: + 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 + + integer,intent(in),dimension(ims:ime,jms:jme):: kpbl2d + + real(kind=kind_phys),intent(in):: dt,cp,g,rd,rv,ep1,pi + real(kind=kind_phys),intent(in),optional:: p_top + + real(kind=kind_phys),intent(in),dimension(kms:kme),optional:: & + znu, & + znw + + real(kind=kind_phys),intent(in),dimension(ims:ime,jms:jme):: & + dx, & + sina,cosa, & + pblh,br1,xland + + real(kind=kind_phys),intent(in),dimension(ims:ime,jms:jme),optional::& + xlatd,raincv,rainncv,ddy_j1tau,ddy_j2tau + integer,intent(in),dimension(ims:ime,jms:jme),optional:: & + jindx1_tau,jindx2_tau + integer,intent(in):: ntau_d1y,ntau_d2t + real(kind=kind_phys),intent(in),dimension(ntau_d2t),optional:: & + days_limb + real(kind=kind_phys),intent(in),dimension(ntau_d1y,ntau_d2t),optional:: & + tau_limb + real(kind=kind_phys),intent(in) :: r_DoY + + real(kind=kind_phys),intent(in),dimension(ims:ime,jms:jme):: & + var2dls,var2dss, & + oc12dls,oc12dss, & + oa2d1ls,oa2d2ls,oa2d3ls,oa2d4ls, & + oa2d1ss,oa2d2ss,oa2d3ss,oa2d4ss, & + ol2d1ls,ol2d2ls,ol2d3ls,ol2d4ls, & + ol2d1ss,ol2d2ss,ol2d3ss,ol2d4ss + + + real(kind=kind_phys),intent(in),dimension(ims:ime,kms:kme,jms:jme):: & + qv3d, & + p3d, & + pi3d, & + t3d, & + u3d, & + v3d, & + z, & + zi, & + dz + + real(kind=kind_phys),intent(in),dimension(ims:ime,kms:kme,jms:jme):: & + p3di + + logical,intent(in):: ugwp_diags,ngw_scheme + +!--- output arguments: + character(len=*),intent(out):: errmsg + + integer,intent(out):: errflg + + real(kind=kind_phys),intent(out),dimension(ims:ime,jms:jme):: & + dusfcg,dvsfcg + + real(kind=kind_phys),intent(out),dimension(:,:),optional:: & + dusfc_ls,dusfc_bl,dusfc_ss,dusfc_fd, & + dvsfc_ls,dvsfc_bl,dvsfc_ss,dvsfc_fd + + real(kind=kind_phys),intent(out),dimension(ims:ime,kms:kme,jms:jme ):: & + dtaux3d,dtauy3d + + real(kind=kind_phys),intent(out),dimension(:,:,:),optional:: & + dtaux3d_ls,dtaux3d_bl,dtaux3d_ss,dtaux3d_fd, & + dtauy3d_ls,dtauy3d_bl,dtauy3d_ss,dtauy3d_fd + + real(kind=kind_phys),intent(out),dimension(:,:,:),optional:: & + dudt_ngw,dvdt_ngw,dtdt_ngw + +!--- inout arguments: + real(kind=kind_phys),intent(inout),dimension(ims:ime,kms:kme,jms:jme):: & + rublten,rvblten,rthblten + +!--- local variables and arrays: + integer:: i,j,k + + real(kind=kind_phys),dimension(its:ite):: & + dx_hv,sina_hv,cosa_hv,pblh_hv,br1_hv,xland_hv + integer,dimension(its:ite):: kpbl_hv + real(kind=kind_phys),dimension(its:ite):: & + var2dls_hv,oc12dls_hv,oa2d1ls_hv,oa2d2ls_hv,oa2d3ls_hv,oa2d4ls_hv, & + ol2d1ls_hv,ol2d2ls_hv,ol2d3ls_hv,ol2d4ls_hv + real(kind=kind_phys),dimension(its:ite):: & + var2dss_hv,oc12dss_hv,oa2d1ss_hv,oa2d2ss_hv,oa2d3ss_hv,oa2d4ss_hv, & + ol2d1ss_hv,ol2d2ss_hv,ol2d3ss_hv,ol2d4ss_hv + + real(kind=kind_phys),dimension(its:ite):: & + dusfcg_hv,dvsfcg_hv + + real(kind=kind_phys),dimension(:),allocatable:: & + dusfc_ls_hv,dvsfc_ls_hv,dusfc_bl_hv,dvsfc_bl_hv, & + dusfc_ss_hv,dvsfc_ss_hv,dusfc_fd_hv,dvsfc_fd_hv, & + xlatd_hv,raincv_hv,rainncv_hv, & + ddy_j1tau_hv,ddy_j2tau_hv + + integer,dimension(:),allocatable:: & + jindx1_tau_hv,jindx2_tau_hv + + real(kind=kind_phys),dimension(its:ite,kts:kte):: & + u3d_hv,v3d_hv,t3d_hv,qv3d_hv,pi3d_hv,p3d_hv,z_hv,dz_hv + + real(kind=kind_phys),dimension(its:ite,kts:kte):: & + rublten_hv,rvblten_hv,rthblten_hv,dtaux3d_hv,dtauy3d_hv + real(kind=kind_phys),dimension(:,:),allocatable:: & + dtaux3d_ls_hv,dtauy3d_ls_hv,dtaux3d_bl_hv,dtauy3d_bl_hv, & + dtaux3d_ss_hv,dtauy3d_ss_hv,dtaux3d_fd_hv,dtauy3d_fd_hv + real(kind=kind_phys),dimension(:,:),allocatable:: & + dudt_ngw_hv,dvdt_ngw_hv,dtdt_ngw_hv + + real(kind=kind_phys),dimension(its:ite,kms:kme):: & + p3di_hv,zi_hv + +!----------------------------------------------------------------------------------------------------------------- + +! Outer j-loop. Allows consistency between WRF and MPAS in the driver. + + do j = jts,jte + + ! All variables for gwdo2d are tile-sized and have only a single + ! horizontal dimension. The _hv suffix refers to "horizontal vertical", + ! a reminder that there is a single horizontal index. Yes, we know that + ! variables that have only a horizontal index are not *really* _hv. + + ! All of the following 3d and 2d variables are declared intent(in) in the + ! gwdo2d subroutine, so there is no need to put the updated values back + ! from the temporary arrays back into the original arrays. + + ! Variables that are INTENT(IN) or INTENT(INOUT) + + ! 3d, interface levels: + do k = kts,kte+1 + do i = its,ite + p3di_hv(i,k) = p3di(i,k,j) + zi_hv(i,k) = zi(i,k,j) + enddo + enddo + + ! 3d, layers: + do k = kts,kte + do i = its,ite + rublten_hv(i,k) = rublten(i,k,j) + rvblten_hv(i,k) = rvblten(i,k,j) + rthblten_hv(i,k) = rthblten(i,k,j) + u3d_hv(i,k) = u3d(i,k,j) + v3d_hv(i,k) = v3d(i,k,j) + t3d_hv(i,k) = t3d(i,k,j) + qv3d_hv(i,k) = qv3d(i,k,j) + p3d_hv(i,k) = p3d(i,k,j) + pi3d_hv(i,k) = pi3d(i,k,j) + z_hv(i,k) = z(i,k,j) + dz_hv(i,k) = dz(i,k,j) + enddo + enddo + + ! 2d: + do i = its,ite + dx_hv(i) = dx(i,j) + sina_hv(i) = sina(i,j) + cosa_hv(i) = cosa(i,j) + pblh_hv(i) = pblh(i,j) + br1_hv(i) = br1(i,j) + kpbl_hv(i) = kpbl2d(i,j) + xland_hv(i) = xland(i,j) + var2dls_hv(i) = var2dls(i,j) + oc12dls_hv(i) = oc12dls(i,j) + oa2d1ls_hv(i) = oa2d1ls(i,j) + oa2d2ls_hv(i) = oa2d2ls(i,j) + oa2d3ls_hv(i) = oa2d3ls(i,j) + oa2d4ls_hv(i) = oa2d4ls(i,j) + ol2d1ls_hv(i) = ol2d1ls(i,j) + ol2d2ls_hv(i) = ol2d2ls(i,j) + ol2d3ls_hv(i) = ol2d3ls(i,j) + ol2d4ls_hv(i) = ol2d4ls(i,j) + var2dss_hv(i) = var2dss(i,j) + oc12dss_hv(i) = oc12dss(i,j) + oa2d1ss_hv(i) = oa2d1ss(i,j) + oa2d2ss_hv(i) = oa2d2ss(i,j) + oa2d3ss_hv(i) = oa2d3ss(i,j) + oa2d4ss_hv(i) = oa2d4ss(i,j) + ol2d1ss_hv(i) = ol2d1ss(i,j) + ol2d2ss_hv(i) = ol2d2ss(i,j) + ol2d3ss_hv(i) = ol2d3ss(i,j) + ol2d4ss_hv(i) = ol2d4ss(i,j) + enddo + if (ngw_scheme) then + allocate (xlatd_hv(its:ite)) + allocate (raincv_hv(its:ite)) + allocate (rainncv_hv(its:ite)) + allocate (ddy_j1tau_hv(its:ite)) + allocate (ddy_j2tau_hv(its:ite)) + allocate (jindx1_tau_hv(its:ite)) + allocate (jindx2_tau_hv(its:ite)) + do i = its,ite + xlatd_hv(i) = xlatd(i,j) + raincv_hv(i) = raincv(i,j) + rainncv_hv(i) = rainncv(i,j) + ddy_j1tau_hv(i) = ddy_j1tau(i,j) + ddy_j2tau_hv(i) = ddy_j2tau(i,j) + jindx1_tau_hv(i) = jindx1_tau(i,j) + jindx2_tau_hv(i) = jindx2_tau(i,j) + enddo + endif + + ! Allocate ugwp_diags and/or variables if needed + if (ugwp_diags) then + allocate (dusfc_ls_hv(its:ite)) + allocate (dvsfc_ls_hv(its:ite)) + allocate (dusfc_bl_hv(its:ite)) + allocate (dvsfc_bl_hv(its:ite)) + allocate (dusfc_ss_hv(its:ite)) + allocate (dvsfc_ss_hv(its:ite)) + allocate (dusfc_fd_hv(its:ite)) + allocate (dvsfc_fd_hv(its:ite)) + allocate (dtaux3d_ls_hv(its:ite,kts:kte)) + allocate (dtauy3d_ls_hv(its:ite,kts:kte)) + allocate (dtaux3d_bl_hv(its:ite,kts:kte)) + allocate (dtauy3d_bl_hv(its:ite,kts:kte)) + allocate (dtaux3d_ss_hv(its:ite,kts:kte)) + allocate (dtauy3d_ss_hv(its:ite,kts:kte)) + allocate (dtaux3d_fd_hv(its:ite,kts:kte)) + allocate (dtauy3d_fd_hv(its:ite,kts:kte)) + if (ngw_scheme) then + allocate (dudt_ngw_hv(its:ite,kts:kte)) + allocate (dvdt_ngw_hv(its:ite,kts:kte)) + allocate (dtdt_ngw_hv(its:ite,kts:kte)) + endif + endif + + call bl_ugwp_run(sina=sina_hv,cosa=cosa_hv & + ,rublten=rublten_hv,rvblten=rvblten_hv & + ,dtaux3d=dtaux3d_hv,dtauy3d=dtauy3d_hv & + ,dtaux3d_ls=dtaux3d_ls_hv,dtauy3d_ls=dtauy3d_ls_hv & + ,dtaux3d_bl=dtaux3d_bl_hv,dtauy3d_bl=dtauy3d_bl_hv & + ,dtaux3d_ss=dtaux3d_ss_hv,dtauy3d_ss=dtauy3d_ss_hv & + ,dtaux3d_fd=dtaux3d_fd_hv,dtauy3d_fd=dtauy3d_fd_hv & + ,dusfcg=dusfcg_hv,dvsfcg=dvsfcg_hv & + ,dusfc_ls=dusfc_ls_hv,dvsfc_ls=dvsfc_ls_hv & + ,dusfc_bl=dusfc_bl_hv,dvsfc_bl=dvsfc_bl_hv & + ,dusfc_ss=dusfc_ss_hv,dvsfc_ss=dvsfc_ss_hv & + ,dusfc_fd=dusfc_fd_hv,dvsfc_fd=dvsfc_fd_hv & + ,ugwp_diags=ugwp_diags & + ,uproj=u3d_hv,vproj=v3d_hv & + ,t1=t3d_hv,q1=qv3d_hv & + ,prsi=p3di_hv,prsl=p3d_hv,prslk=pi3d_hv & + ,zl=z_hv,dz=dz_hv,hpbl=pblh_hv & + ,kpbl=kpbl_hv,br1=br1_hv,xland1=xland_hv & + ,var=var2dls_hv,oc1=oc12dls_hv & + ,oa2d1=oa2d1ls_hv,oa2d2=oa2d2ls_hv & + ,oa2d3=oa2d3ls_hv,oa2d4=oa2d4ls_hv & + ,ol2d1=ol2d1ls_hv,ol2d2=ol2d2ls_hv & + ,ol2d3=ol2d3ls_hv,ol2d4=ol2d4ls_hv & + ,varss=var2dss_hv,oc1ss=oc12dss_hv & + ,oa2d1ss=oa2d1ss_hv,oa2d2ss=oa2d2ss_hv & + ,oa2d3ss=oa2d3ss_hv,oa2d4ss=oa2d4ss_hv & + ,ol2d1ss=ol2d1ss_hv,ol2d2ss=ol2d2ss_hv & + ,ol2d3ss=ol2d3ss_hv,ol2d4ss=ol2d4ss_hv & + ,g_=g,cp_=cp,rd_=rd,rv_=rv,fv_=ep1,pi_=pi & + ,dxmeter=dx_hv,deltim=dt & + ,its=its,ite=ite,kte=kte,kme=kte+1 & + ,errmsg=errmsg,errflg=errflg) + +! +! Option to call non-stationary gravity wave drag +! + if (ngw_scheme) then + call ugwpv1_ngw_run(xlatd=xlatd_hv,raincv=raincv_hv,rainncv=rainncv_hv & + ,ddy_j1tau=ddy_j1tau_hv,ddy_j2tau=ddy_j2tau_hv & + ,jindx1_tau=jindx1_tau_hv,jindx2_tau=jindx2_tau_hv & + ,r_DoY=r_DoY,kdt=itimestep,dtp=dt & + ,ugrs=u3d_hv,vgrs=v3d_hv & + ,tgrs=t3d_hv,q1=qv3d_hv,prsl=p3d_hv,prslk=pi3d_hv & + ,prsi=p3di_hv,zl=z_hv,zi=zi_hv,ntau_d2t=ntau_d2t & + ,days_limb=days_limb,tau_limb=tau_limb & + ,rublten=rublten_hv,rvblten=rvblten_hv & + ,rthblten=rthblten_hv,ugwp_diags=ugwp_diags & + ,dudt_ngw=dudt_ngw_hv,dvdt_ngw=dvdt_ngw_hv & + ,dtdt_ngw=dtdt_ngw_hv,its=its,ite=ite,levs=kte) + endif + + + + ! Variables that are INTENT(OUT) or INTENT(INOUT): + + ! 3d, layers: + do k = kts,kte + do i = its,ite + rublten(i,k,j) = rublten_hv(i,k) + rvblten(i,k,j) = rvblten_hv(i,k) + rthblten(i,k,j)= rthblten_hv(i,k) + dtaux3d(i,k,j) = dtaux3d_hv(i,k) + dtauy3d(i,k,j) = dtauy3d_hv(i,k) + enddo + enddo + if (ugwp_diags) then + do k = kts,kte + do i = its,ite + dtaux3d_ls(i,k,j) = dtaux3d_ls_hv(i,k) + dtauy3d_ls(i,k,j) = dtauy3d_ls_hv(i,k) + dtaux3d_bl(i,k,j) = dtaux3d_bl_hv(i,k) + dtauy3d_bl(i,k,j) = dtauy3d_bl_hv(i,k) + dtaux3d_ss(i,k,j) = dtaux3d_ss_hv(i,k) + dtauy3d_ss(i,k,j) = dtauy3d_ss_hv(i,k) + dtaux3d_fd(i,k,j) = dtaux3d_fd_hv(i,k) + dtauy3d_fd(i,k,j) = dtauy3d_fd_hv(i,k) + enddo + enddo + endif + if (ugwp_diags.and.ngw_scheme) then + do k = kts,kte + do i = its,ite + dudt_ngw(i,k,j) = dudt_ngw_hv(i,k) + dvdt_ngw(i,k,j) = dvdt_ngw_hv(i,k) + dtdt_ngw(i,k,j) = dtdt_ngw_hv(i,k) + enddo + enddo + endif + + ! 2d: + do i = its,ite + dusfcg(i,j) = dusfcg_hv(i) + dvsfcg(i,j) = dvsfcg_hv(i) + enddo + if (ugwp_diags) then + do i = its,ite + dusfc_ls(i,j) = dusfc_ls_hv(i) + dvsfc_ls(i,j) = dvsfc_ls_hv(i) + dusfc_bl(i,j) = dusfc_bl_hv(i) + dvsfc_bl(i,j) = dvsfc_bl_hv(i) + dusfc_ss(i,j) = dusfc_ss_hv(i) + dvsfc_ss(i,j) = dvsfc_ss_hv(i) + dusfc_fd(i,j) = dusfc_fd_hv(i) + dvsfc_fd(i,j) = dvsfc_fd_hv(i) + enddo + endif + + ! Deallocate ugwp_diags and/or ngw_scheme variables if used + if (ugwp_diags) then + deallocate (dusfc_ls_hv) + deallocate (dvsfc_ls_hv) + deallocate (dusfc_bl_hv) + deallocate (dvsfc_bl_hv) + deallocate (dusfc_ss_hv) + deallocate (dvsfc_ss_hv) + deallocate (dusfc_fd_hv) + deallocate (dvsfc_fd_hv) + deallocate (dtaux3d_ls_hv) + deallocate (dtauy3d_ls_hv) + deallocate (dtaux3d_bl_hv) + deallocate (dtauy3d_bl_hv) + deallocate (dtaux3d_ss_hv) + deallocate (dtauy3d_ss_hv) + deallocate (dtaux3d_fd_hv) + deallocate (dtauy3d_fd_hv) + if (ngw_scheme) then + deallocate (dudt_ngw_hv) + deallocate (dvdt_ngw_hv) + deallocate (dtdt_ngw_hv) + endif + endif + if (ngw_scheme) then + deallocate (xlatd_hv ) + deallocate (raincv_hv ) + deallocate (rainncv_hv ) + deallocate (ddy_j1tau_hv ) + deallocate (ddy_j2tau_hv ) + deallocate (jindx1_tau_hv) + deallocate (jindx2_tau_hv) + endif + + enddo ! Outer J-loop + + end subroutine gwdo_ugwp + +!================================================================================================================= +end module module_bl_ugwp_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 44e6cb667..cf7340aaf 100644 --- a/src/core_atmosphere/physics/physics_wrf/module_bl_ysu.F +++ b/src/core_atmosphere/physics/physics_wrf/module_bl_ysu.F @@ -1,10 +1,10 @@ #define NEED_B4B_DURING_CCPP_TESTING 1 !================================================================================================================= module module_bl_ysu - use mpas_log use mpas_kind_types,only: kind_phys => RKIND use bl_ysu + implicit none private public:: ysu @@ -232,8 +232,11 @@ subroutine ysu(u3d,v3d,t3d,qv3d,qc3d,qi3d,p3d,p3di,pi3d, & !temporary allocation of local chemical species and/or passive tracers that are vertically- !mixed in subroutine bl_ysu_run: + logical:: l_topdown_pblmix + integer, parameter :: nmix = 0 integer :: n + real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme,nmix):: qmix real(kind=kind_phys), dimension(ims:ime,kms:kme,jms:jme,nmix):: rqmixblten @@ -304,9 +307,13 @@ subroutine ysu(u3d,v3d,t3d,qv3d,qc3d,qi3d,p3d,p3di,pi3d, & integer, dimension(its:ite) :: & kpbl2d_hv - real, dimension(its:ite) :: & + real(kind=kind_phys), dimension(its:ite) :: & frcurb_hv +!----------------------------------------------------------------------------------------------------------------- + + l_topdown_pblmix = .false. + if(ysu_topdown_pblmix .eq. 1) l_topdown_pblmix = .true. do j = jts,jte ! @@ -391,10 +398,10 @@ subroutine ysu(u3d,v3d,t3d,qv3d,qc3d,qi3d,p3d,p3di,pi3d, & call bl_ysu_run(ux=u3d_hv,vx=v3d_hv & ,tx=t3d_hv & ,qvx=qv3d_hv,qcx=qc3d_hv,qix=qi3d_hv & + ,f_qc=flag_qc,f_qi=flag_qi & ,nmix=nmix,qmix=qmix_hv & ,p2d=p3d_hv,p2di=p3di_hv & ,pi2d=pi3d_hv & - ,f_qc=flag_qc,f_qi=flag_qi & !PK: correct position ,utnp=rublten_hv,vtnp=rvblten_hv & ,ttnp=rthblten_hv,qvtnp=rqvblten_hv & ,qctnp=rqcblten_hv,qitnp=rqiblten_hv & @@ -417,7 +424,7 @@ subroutine ysu(u3d,v3d,t3d,qv3d,qc3d,qi3d,p3d,p3di,pi3d, & ,u10=u10_hv,v10=v10_hv & ,uox=uoce_hv,vox=voce_hv & ,rthraten=rthraten_hv & - ,ysu_topdown_pblmix=ysu_topdown_pblmix & + ,ysu_topdown_pblmix=l_topdown_pblmix & ,ctopo=ctopo_hv,ctopo2=ctopo2_hv & ,a_u=a_u_hv,a_v=a_v_hv,a_t=a_t_hv,a_q=a_q_hv,a_e=a_e_hv & ,b_u=b_u_hv,b_v=b_v_hv,b_t=b_t_hv,b_q=b_q_hv,b_e=b_e_hv & 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 b36cb5e61..806de7c51 100644 --- a/src/core_atmosphere/physics/physics_wrf/module_cu_ntiedtke.F +++ b/src/core_atmosphere/physics/physics_wrf/module_cu_ntiedtke.F @@ -1,12 +1,11 @@ !================================================================================================================= module module_cu_ntiedtke - use mpas_kind_types,only: RKIND,StrKIND - - use cu_ntiedtke,only: cu_ntiedtke_run, & - cu_ntiedtke_init, & - cu_ntiedtke_timestep_init, & - cu_ntiedtke_timestep_final + use mpas_kind_types,only: kind_phys => RKIND + use cu_ntiedtke,only: cu_ntiedtke_run, & + cu_ntiedtke_init use cu_ntiedtke_common + use cu_ntiedtke_post,only: cu_ntiedtke_post_run + use cu_ntiedtke_pre,only: cu_ntiedtke_pre_run implicit none private @@ -94,7 +93,7 @@ subroutine cu_ntiedtke_driver( & integer,intent(in):: itimestep,stepcu - real(kind=RKIND),intent(in):: cp,grav,rd,rv,xlf,xls,xlv + real(kind=kind_phys),intent(in):: cp,grav,rd,rv,xlf,xls,xlv real(kind=kind_phys),intent(in):: dt @@ -204,7 +203,7 @@ subroutine cu_ntiedtke_driver( & enddo enddo - call cu_ntiedtke_timestep_init( & + call cu_ntiedtke_pre_run( & its = its , ite = ite , kts = kts , kte = kte , & im = im , kx = kx , kx1 = kx1 , itimestep = itimestep , & stepcu = stepcu , dt = dt , grav = grav , xland = xland_hv , & @@ -216,7 +215,7 @@ subroutine cu_ntiedtke_driver( & qvf = qvf , qcf = qcf , qif = qif , uf = uf , & vf = vf , prsi = prsi , ghti = ghti , omg = omg , & errmsg = errmsg , errflg = errflg & - ) + ) call cu_ntiedtke_run( & pu = uf , pv = vf , pt = tf , pqv = qvf , & @@ -227,7 +226,7 @@ subroutine cu_ntiedtke_driver( & dt = delt , dx = dx_hv , errmsg = errmsg , errflg = errflg & ) - call cu_ntiedtke_timestep_final( & + call cu_ntiedtke_post_run( & its = its , ite = ite , kts = kts , kte = kte , & stepcu = stepcu , dt = dt , exner = pi_hv , qv = qv_hv , & qc = qc_hv , qi = qi_hv , t = t_hv , u = u_hv , & @@ -236,7 +235,7 @@ subroutine cu_ntiedtke_driver( & raincv = raincv_hv , pratec = pratec_hv , rthcuten = rthcuten_hv , rqvcuten = rqvcuten_hv , & rqccuten = rqccuten_hv , rqicuten = rqicuten_hv , rucuten = rucuten_hv , rvcuten = rvcuten_hv , & errmsg = errmsg , errflg = errflg & - ) + ) do i = its,ite raincv(i,j) = raincv_hv(i) diff --git a/src/core_atmosphere/physics/physics_wrf/module_mp_thompson.F b/src/core_atmosphere/physics/physics_wrf/module_mp_thompson.F index 9abf27904..8e2434050 100644 --- a/src/core_atmosphere/physics/physics_wrf/module_mp_thompson.F +++ b/src/core_atmosphere/physics/physics_wrf/module_mp_thompson.F @@ -1,4 +1,7 @@ !================================================================================================================= +!reference: WRF-v4.1.4 +!Laura D. Fowler (laura@ucar.edu) / 2020-01-10. + !module_mp_thompson was originally copied from./phys/module_mp_thompson.F from WRF version 3.8. Modifications made !to the original sourcecode are mostly confined to subroutine thompson_init. !Laura D. Fowler (laura@ucar.edu) / 2016-06-04. @@ -11,7 +14,18 @@ ! Laura D. Fowler (laura@ucar.edu) / 2016-10-29. ! * in subroutine mp_gt_driver, moved the initialization of variables Nt_c and mu_c ! before initialization of local mixing ratios and number concentrations. -! Laura D. Fowler (lara@ucar.edu) / 2916-12-30. +! Laura D. Fowler (laura@ucar.edu) / 2016-12-30. +! * in subroutine freezeH2O, modified the calculation of the variable prob, following +! Greg Thompson for the release of WRF version 3.9.0. +! Laura D. Fowler (laura@ucar.edu) / 2017-03-27. +! * in subroutine mp_gt_driver, added the variables vqr, vqi, vqs, and vqg to output the +! mean mass-weighted fall velocities of rain, cloud ice, snow, and graupel to compute +! diagnostics of lightning flash rates. +! Laura D. Fowler (laura@ucar.edu) / 2017-04-19. +! * in subroutine mp_gt_driver, changed the declarations of arrays vqg1d, vqid1,vqr1d, and vqs1d, +! from (kts:kte) to (kts:kte+1) to match the dimensions of arrays vtgk, vtik, vtsk, and vtrk, in +! subroutine mp_thompson. +! Laura D. Fowler (laura@ucar.edu) / 2017-08-31. !+---+-----------------------------------------------------------------+ @@ -52,7 +66,7 @@ !.. Remaining values should probably be left alone. !.. !..Author: Greg Thompson, NCAR-RAL, gthompsn@ucar.edu, 303-497-2805 -!..Last modified: 01 Aug 2016 Aerosol additions to v3.5.1 code 9/2013 +!..Last modified: 24 Jan 2018 Aerosol additions to v3.5.1 code 9/2013 !.. Cloud fraction additions 11/2014 part of pre-v3.7 !+---+-----------------------------------------------------------------+ !wrft:model_layer:physics @@ -60,6 +74,7 @@ ! MODULE module_mp_thompson + use mpas_log use mpas_kind_types use mpas_atmphys_functions, only: gammp,wgamma,rslf,rsif use mpas_atmphys_utilities @@ -90,6 +105,8 @@ MODULE module_mp_thompson !.. scheme. In 2-moment cloud water, Nt_c represents a maximum of !.. droplet concentration and nu_c is also variable depending on local !.. droplet number concentration. +!.. MPAS: Nt_c is initialized to 100.E6 over oceans and 300.E6 over land as +! a function of landmask in subroutine init_thompson_clouddroplets_forMPAS. ! REAL, PARAMETER, PRIVATE:: Nt_c = 100.E6 REAL, PARAMETER, PRIVATE:: Nt_c_max = 1999.E6 REAL, PRIVATE:: Nt_c @@ -97,10 +114,12 @@ MODULE module_mp_thompson !..Declaration of constants for assumed CCN/IN aerosols when none in !.. the input data. Look inside the init routine for modifications !.. due to surface land-sea points or vegetation characteristics. - REAL, PARAMETER, PRIVATE:: naIN0 = 1.5E6 - REAL, PARAMETER, PRIVATE:: naIN1 = 0.5E6 - REAL, PARAMETER, PRIVATE:: naCCN0 = 300.0E6 - REAL, PARAMETER, PRIVATE:: naCCN1 = 50.0E6 +!.. MPAS: naIN0, naIN1, naCCN0, and naCCN1 are used in init_thompson_aerosols_forMPAS +!.. for initialization of nwfa. and nifa. + REAL, PARAMETER, PUBLIC:: naIN0 = 1.5E6 + REAL, PARAMETER, PUBLIC:: naIN1 = 0.5E6 + REAL, PARAMETER, PUBLIC:: naCCN0 = 300.0E6 + REAL, PARAMETER, PUBLIC:: naCCN1 = 50.0E6 !..Generalized gamma distributions for rain, graupel and cloud ice. !.. N(D) = N_0 * D**mu * exp(-lamda*D); mu=0 is exponential. @@ -235,12 +254,12 @@ MODULE module_mp_thompson INTEGER, PARAMETER, PRIVATE:: ntb_i1 = 55 INTEGER, PARAMETER, PRIVATE:: ntb_t = 9 INTEGER, PRIVATE:: nic1, nic2, nii2, nii3, nir2, nir3, nis2, nig2, nig3 - INTEGER, PARAMETER, PRIVATE:: ntb_arc = 7 - INTEGER, PARAMETER, PRIVATE:: ntb_arw = 9 - INTEGER, PARAMETER, PRIVATE:: ntb_art = 7 - INTEGER, PARAMETER, PRIVATE:: ntb_arr = 5 - INTEGER, PARAMETER, PRIVATE:: ntb_ark = 4 - INTEGER, PARAMETER, PRIVATE:: ntb_IN = 55 + INTEGER, PARAMETER, PUBLIC:: ntb_arc = 7 + INTEGER, PARAMETER, PUBLIC:: ntb_arw = 9 + INTEGER, PARAMETER, PUBLIC:: ntb_art = 7 + INTEGER, PARAMETER, PUBLIC:: ntb_arr = 5 + INTEGER, PARAMETER, PUBLIC:: ntb_ark = 4 + INTEGER, PARAMETER, PUBLIC:: ntb_IN = 55 INTEGER, PRIVATE:: niIN2 DOUBLE PRECISION, DIMENSION(nbins+1):: xDx @@ -979,17 +998,18 @@ END SUBROUTINE thompson_init !+---+-----------------------------------------------------------------+ !..This is a wrapper routine designed to transfer values from 3D to 1D. !+---+-----------------------------------------------------------------+ - SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & - nwfa, nifa, nwfa2d, & - th, pii, p, w, dz, dt_in, itimestep, & - RAINNC, RAINNCV, & - SNOWNC, SNOWNCV, & - GRAUPELNC, GRAUPELNCV, SR, & + SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & + nwfa, nifa, nwfa2d, nifa2d, & + th, pii, p, w, dz, dt_in, itimestep, & + RAINNC, RAINNCV, & + SNOWNC, SNOWNCV, & + GRAUPELNC, GRAUPELNCV, SR, & + rainprod, evapprod, & refl_10cm, diagflag, do_radar_ref, & re_cloud, re_ice, re_snow, & has_reqc, has_reqi, has_reqs, & #if defined(mpas) - ntc,muc,rainprod,evapprod, & + ntc,muc, & #endif ids,ide, jds,jde, kds,kde, & ! domain dims ims,ime, jms,jme, kms,kme, & ! memory dims @@ -1005,7 +1025,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & qv, qc, qr, qi, qs, qg, ni, nr, th REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT):: & nc, nwfa, nifa - REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(IN):: nwfa2d + REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(IN):: nwfa2d, nifa2d REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & re_cloud, re_ice, re_snow INTEGER, INTENT(IN):: has_reqc, has_reqi, has_reqs @@ -1015,11 +1035,11 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & RAINNC, RAINNCV, SR REAL, DIMENSION(ims:ime, jms:jme), OPTIONAL, INTENT(INOUT):: & SNOWNC, SNOWNCV, GRAUPELNC, GRAUPELNCV + REAL, DIMENSION(ims:ime, kms:kme, jms:jme), OPTIONAL, INTENT(INOUT):: & + rainprod,evapprod #if defined(mpas) REAL, DIMENSION(ims:ime, jms:jme), INTENT(IN):: & ntc,muc - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT):: & - rainprod,evapprod REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT), OPTIONAL:: & refl_10cm #else @@ -1035,10 +1055,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & nr1d, nc1d, nwfa1d, nifa1d, & t1d, p1d, w1d, dz1d, rho, dBZ REAL, DIMENSION(kts:kte):: re_qc1d, re_qi1d, re_qs1d -#if defined(mpas) - REAL, DIMENSION(kts:kte):: & - rainprod1d, evapprod1d -#endif + REAL, DIMENSION(kts:kte):: rainprod1d, evapprod1d REAL, DIMENSION(its:ite, jts:jte):: pcp_ra, pcp_sn, pcp_gr, pcp_ic REAL:: dt, pptrain, pptsnow, pptgraul, pptice REAL:: qc_max, qr_max, qs_max, qi_max, qg_max, ni_max, nr_max @@ -1050,7 +1067,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & INTEGER:: i_start, j_start, i_end, j_end LOGICAL, OPTIONAL, INTENT(IN) :: diagflag INTEGER, OPTIONAL, INTENT(IN) :: do_radar_ref - CHARACTER*256:: mp_debug +! CHARACTER*256:: mp_debug !+---+ @@ -1098,9 +1115,9 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & kmax_qg = 0 kmax_ni = 0 kmax_nr = 0 - do i = 1, 256 - mp_debug(i:i) = char(0) - enddo +! do i = 1, 256 +! mp_debug(i:i) = char(0) +! enddo ! if (.NOT. is_aerosol_aware .AND. PRESENT(nc) .AND. PRESENT(nwfa) & ! .AND. PRESENT(nifa) .AND. PRESENT(nwfa2d)) then @@ -1128,6 +1145,11 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & Nt_c = ntc(i,j) mu_c = muc(i,j) #endif + do k = kts,kte + rainprod1d(k) = 0. + evapprod1d(k) = 0. + enddo + do k = kts, kte t1d(k) = th(i,k,j)*pii(i,k,j) p1d(k) = p(i,k,j) @@ -1141,6 +1163,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & qg1d(k) = qg(i,k,j) ni1d(k) = ni(i,k,j) nr1d(k) = nr(i,k,j) + rho(k) = 0.622*p1d(k)/(R*t1d(k)*(qv1d(k)+0.622)) enddo if (is_aerosol_aware) then do k = kts, kte @@ -1151,7 +1174,6 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & nwfa1 = nwfa2d(i,j) else do k = kts, kte - rho(k) = 0.622*p1d(k)/(R*t1d(k)*(qv1d(k)+0.622)) nc1d(k) = Nt_c/rho(k) nwfa1d(k) = 11.1E6/rho(k) nifa1d(k) = naIN1*0.01/rho(k) @@ -1161,10 +1183,8 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & call mp_thompson(qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & nr1d, nc1d, nwfa1d, nifa1d, t1d, p1d, w1d, dz1d, & - pptrain, pptsnow, pptgraul, pptice, & -#if defined(mpas) - rainprod1d, evapprod1d, & -#endif + pptrain, pptsnow, pptgraul, pptice, & + rainprod1d, evapprod1d, & kts, kte, dt, i, j) pcp_ra(i,j) = pptrain @@ -1191,6 +1211,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & if (is_aerosol_aware) then !-GT nwfa1d(kts) = nwfa1 nwfa1d(kts) = nwfa1d(kts) + nwfa2d(i,j)*dt_in + nifa1d(kts) = nifa1d(kts) + nifa2d(i,j)*dt_in do k = kts, kte nc(i,k,j) = nc1d(k) @@ -1219,8 +1240,10 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & kmax_qc = k qc_max = qc1d(k) elseif (qc1d(k) .lt. 0.0) then - write(mp_debug,*) 'WARNING, negative qc ', qc1d(k), & - ' at i,j,k=', i,j,k + call mpas_log_write('--- WARNING, negative qc $r at i,j,k = $i $i $i ', & + realArgs=(/qc1d(k)/),intArgs=(/i,j,k/)) +! write(mp_debug,*) 'WARNING, negative qc ', qc1d(k), & +! ' at i,j,k=', i,j,k ! CALL wrf_debug(150, mp_debug) endif if (qr1d(k) .gt. qr_max) then @@ -1229,8 +1252,10 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & kmax_qr = k qr_max = qr1d(k) elseif (qr1d(k) .lt. 0.0) then - write(mp_debug,*) 'WARNING, negative qr ', qr1d(k), & - ' at i,j,k=', i,j,k + call mpas_log_write('--- WARNING, negative qr $r at i,j,k = $i $i $i ', & + realArgs=(/qr1d(k)/),intArgs=(/i,j,k/)) +! write(mp_debug,*) 'WARNING, negative qr ', qr1d(k), & +! ' at i,j,k=', i,j,k ! CALL wrf_debug(150, mp_debug) endif if (nr1d(k) .gt. nr_max) then @@ -1239,8 +1264,10 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & kmax_nr = k nr_max = nr1d(k) elseif (nr1d(k) .lt. 0.0) then - write(mp_debug,*) 'WARNING, negative nr ', nr1d(k), & - ' at i,j,k=', i,j,k + call mpas_log_write('--- WARNING, negative nr $r at i,j,k = $i $i $i ', & + realArgs=(/nr1d(k)/),intArgs=(/i,j,k/)) +! write(mp_debug,*) 'WARNING, negative nr ', nr1d(k), & +! ' at i,j,k=', i,j,k ! CALL wrf_debug(150, mp_debug) endif if (qs1d(k) .gt. qs_max) then @@ -1249,8 +1276,10 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & kmax_qs = k qs_max = qs1d(k) elseif (qs1d(k) .lt. 0.0) then - write(mp_debug,*) 'WARNING, negative qs ', qs1d(k), & - ' at i,j,k=', i,j,k + call mpas_log_write('--- WARNING, negative qs $r at i,j,k = $i $i $i ', & + realArgs=(/qs1d(k)/),intArgs=(/i,j,k/)) +! write(mp_debug,*) 'WARNING, negative qs ', qs1d(k), & +! ' at i,j,k=', i,j,k ! CALL wrf_debug(150, mp_debug) endif if (qi1d(k) .gt. qi_max) then @@ -1259,8 +1288,10 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & kmax_qi = k qi_max = qi1d(k) elseif (qi1d(k) .lt. 0.0) then - write(mp_debug,*) 'WARNING, negative qi ', qi1d(k), & - ' at i,j,k=', i,j,k + call mpas_log_write('--- WARNING, negative qi $r at i,j,k = $i $i $i ', & + realArgs=(/qi1d(k)/),intArgs=(/i,j,k/)) +! write(mp_debug,*) 'WARNING, negative qi ', qi1d(k), & +! ' at i,j,k=', i,j,k ! CALL wrf_debug(150, mp_debug) endif if (qg1d(k) .gt. qg_max) then @@ -1269,8 +1300,10 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & kmax_qg = k qg_max = qg1d(k) elseif (qg1d(k) .lt. 0.0) then - write(mp_debug,*) 'WARNING, negative qg ', qg1d(k), & - ' at i,j,k=', i,j,k + call mpas_log_write('--- WARNING, negative qg $r at i,j,k = $i $i $i ', & + realArgs=(/qg1d(k)/),intArgs=(/i,j,k/)) +! write(mp_debug,*) 'WARNING, negative qg ', qg1d(k), & +! ' at i,j,k=', i,j,k ! CALL wrf_debug(150, mp_debug) endif if (ni1d(k) .gt. ni_max) then @@ -1279,21 +1312,31 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & kmax_ni = k ni_max = ni1d(k) elseif (ni1d(k) .lt. 0.0) then - write(mp_debug,*) 'WARNING, negative ni ', ni1d(k), & - ' at i,j,k=', i,j,k + call mpas_log_write('--- WARNING, negative qni $r at i,j,k = $i $i $i ', & + realArgs=(/ni1d(k)/),intArgs=(/i,j,k/)) +! write(mp_debug,*) 'WARNING, negative ni ', ni1d(k), & +! ' at i,j,k=', i,j,k ! CALL wrf_debug(150, mp_debug) endif if (qv1d(k) .lt. 0.0) then - write(mp_debug,*) 'WARNING, negative qv ', qv1d(k), & - ' at i,j,k=', i,j,k -! CALL wrf_debug(150, mp_debug) + call mpas_log_write('--- WARNING, negative qv $r at i,j,k = $i $i $i ', & + realArgs=(/qv1d(k)/),intArgs=(/i,j,k/)) if (k.lt.kte-2 .and. k.gt.kts+1) then - write(mp_debug,*) ' below and above are: ', qv(i,k-1,j), qv(i,k+1,j) -! CALL wrf_debug(150, mp_debug) + call mpas_log_write('-- below and above are: $r $r',realArgs=(/qv(i,k-1,j), qv(i,k+1,j)/)) qv(i,k,j) = MAX(1.E-7, 0.5*(qv(i,k-1,j) + qv(i,k+1,j))) else qv(i,k,j) = 1.E-7 endif +! write(mp_debug,*) 'WARNING, negative qv ', qv1d(k), & +! ' at i,j,k=', i,j,k +! CALL wrf_debug(150, mp_debug) +! if (k.lt.kte-2 .and. k.gt.kts+1) then +! write(mp_debug,*) ' below and above are: ', qv(i,k-1,j), qv(i,k+1,j) +! CALL wrf_debug(150, mp_debug) +! qv(i,k,j) = MAX(1.E-7, 0.5*(qv(i,k-1,j) + qv(i,k+1,j))) +! else +! qv(i,k,j) = 1.E-7 +! endif endif enddo @@ -1326,20 +1369,20 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & enddo j_loop ! DEBUG - GT - write(mp_debug,'(a,7(a,e13.6,1x,a,i3,a,i3,a,i3,a,1x))') 'MP-GT:', & - 'qc: ', qc_max, '(', imax_qc, ',', jmax_qc, ',', kmax_qc, ')', & - 'qr: ', qr_max, '(', imax_qr, ',', jmax_qr, ',', kmax_qr, ')', & - 'qi: ', qi_max, '(', imax_qi, ',', jmax_qi, ',', kmax_qi, ')', & - 'qs: ', qs_max, '(', imax_qs, ',', jmax_qs, ',', kmax_qs, ')', & - 'qg: ', qg_max, '(', imax_qg, ',', jmax_qg, ',', kmax_qg, ')', & - 'ni: ', ni_max, '(', imax_ni, ',', jmax_ni, ',', kmax_ni, ')', & - 'nr: ', nr_max, '(', imax_nr, ',', jmax_nr, ',', kmax_nr, ')' +! write(mp_debug,'(a,7(a,e13.6,1x,a,i3,a,i3,a,i3,a,1x))') 'MP-GT:', & +! 'qc: ', qc_max, '(', imax_qc, ',', jmax_qc, ',', kmax_qc, ')', & +! 'qr: ', qr_max, '(', imax_qr, ',', jmax_qr, ',', kmax_qr, ')', & +! 'qi: ', qi_max, '(', imax_qi, ',', jmax_qi, ',', kmax_qi, ')', & +! 'qs: ', qs_max, '(', imax_qs, ',', jmax_qs, ',', kmax_qs, ')', & +! 'qg: ', qg_max, '(', imax_qg, ',', jmax_qg, ',', kmax_qg, ')', & +! 'ni: ', ni_max, '(', imax_ni, ',', jmax_ni, ',', kmax_ni, ')', & +! 'nr: ', nr_max, '(', imax_nr, ',', jmax_nr, ',', kmax_nr, ')' ! CALL wrf_debug(150, mp_debug) ! END DEBUG - GT - do i = 1, 256 - mp_debug(i:i) = char(0) - enddo +! do i = 1, 256 +! mp_debug(i:i) = char(0) +! enddo END SUBROUTINE mp_gt_driver @@ -1354,12 +1397,10 @@ END SUBROUTINE mp_gt_driver !.. Thompson et al. (2004, 2008). !+---+-----------------------------------------------------------------+ ! - subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & + subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & nr1d, nc1d, nwfa1d, nifa1d, t1d, p1d, w1d, dzq, & - pptrain, pptsnow, pptgraul, pptice, & -#if defined(mpas) - rainprod, evapprod, & -#endif + pptrain, pptsnow, pptgraul, pptice, & + rainprod, evapprod, & kts, kte, dt, ii, jj) implicit none @@ -1372,10 +1413,8 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & REAL, DIMENSION(kts:kte), INTENT(IN):: p1d, w1d, dzq REAL, INTENT(INOUT):: pptrain, pptsnow, pptgraul, pptice REAL, INTENT(IN):: dt -#if defined(mpas) REAL, DIMENSION(kts:kte), INTENT(INOUT):: & rainprod, evapprod -#endif !..Local variables REAL, DIMENSION(kts:kte):: tten, qvten, qcten, qiten, & @@ -1449,7 +1488,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & REAL:: r_frac, g_frac REAL:: Ef_rw, Ef_sw, Ef_gw, Ef_rr REAL:: Ef_ra, Ef_sa, Ef_ga - REAL:: dtsave, odts, odt, odzq, hgt_agl + REAL:: dtsave, odts, odt, odzq, hgt_agl, SR REAL:: xslw1, ygra1, zans1, eva_factor INTEGER:: i, k, k2, n, nn, nstep, k_0, kbot, IT, iexfrq INTEGER, DIMENSION(5):: ksed1 @@ -1463,9 +1502,14 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & CHARACTER*256:: mp_debug INTEGER:: nu_c +! modifications proposed by Ted Mansell for MPAS. +! Laura D. Fowler (laura@ucar.edu) / 2017-03-27. +! real, parameter:: mvd_r_breakup = 1.e-3 +!... end modifications. + LOGICAL, DIMENSION(kts:kte):: L_nifa,L_nwfa + REAL:: tem !+---+ - debug_flag = .false. ! if (ii.eq.901 .and. jj.eq.379) debug_flag = .true. if(debug_flag) then @@ -1576,12 +1620,19 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & pnd_scd(k) = 0. pnd_gcd(k) = 0. enddo -#if defined(mpas) do k = kts, kte rainprod(k) = 0. evapprod(k) = 0. enddo -#endif +!.. initialize the logicals L_nifa and L_nwfa used to detect instances of the cloud +!.. ice and cloud liquid water mixing ratios being greater than R1 but their number +!.. concentration being less than 2. and R2: + if(is_aerosol_aware) then + do k = kts, kte + L_nifa(k) = .false. + L_nwfa(k) = .false. + enddo + endif !..Bug fix (2016Jun15), prevent use of uninitialized value(s) of snow moments. do k = kts, kte @@ -1611,8 +1662,10 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & if (qc1d(k) .gt. R1) then no_micro = .false. rc(k) = qc1d(k)*rho(k) - nc(k) = MAX(2., nc1d(k)*rho(k)) + nc(k) = MAX(2., MIN(nc1d(k)*rho(k), Nt_c_max)) L_qc(k) = .true. +!.. set L_nwfa to true when the cloud liquid water number concentration is less than 2.: + if(is_aerosol_aware .and. nc(k) .le. 2.) L_nwfa(k) = .true. nu_c = MIN(15, NINT(1000.E6/nc(k)) + 2) lamc = (nc(k)*am_r*ccg(2,nu_c)*ocg1(nu_c)/rc(k))**obmr xDc = (bm_r + nu_c + 1.) / lamc @@ -1636,17 +1689,20 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & no_micro = .false. ri(k) = qi1d(k)*rho(k) ni(k) = MAX(R2, ni1d(k)*rho(k)) + L_qi(k) = .true. +!.. set L_nifa to true when the cloud ice number concentration is less than R2: + if(is_aerosol_aware .and. ni(k) .le. R2) L_nifa(k) = .true. if (ni(k).le. R2) then - lami = cie(2)/25.E-6 - ni(k) = MIN(499.D3, cig(1)*oig2*ri(k)/am_i*lami**bm_i) + lami = cie(2)/5.E-6 + ni(k) = MIN(9999.D3, cig(1)*oig2*ri(k)/am_i*lami**bm_i) endif - L_qi(k) = .true. +! L_qi(k) = .true. lami = (am_i*cig(2)*oig1*ni(k)/ri(k))**obmi ilami = 1./lami xDi = (bm_i + mu_i + 1.) * ilami if (xDi.lt. 5.E-6) then lami = cie(2)/5.E-6 - ni(k) = MIN(499.D3, cig(1)*oig2*ri(k)/am_i*lami**bm_i) + ni(k) = MIN(9999.D3, cig(1)*oig2*ri(k)/am_i*lami**bm_i) elseif (xDi.gt. 300.E-6) then lami = cie(2)/300.E-6 ni(k) = cig(1)*oig2*ri(k)/am_i*lami**bm_i @@ -1925,7 +1981,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & tau = 3.72/(rc(k)*taud) prr_wau(k) = zeta/tau prr_wau(k) = MIN(DBLE(rc(k)*odts), prr_wau(k)) - pnr_wau(k) = prr_wau(k) / (am_r*nu_c*D0r*D0r*D0r) ! RAIN2M + pnr_wau(k) = prr_wau(k) / (am_r*nu_c*200.*D0r*D0r*D0r) ! RAIN2M pnc_wau(k) = MIN(DBLE(nc(k)*odts), prr_wau(k) & / (am_r*mvd_c(k)*mvd_c(k)*mvd_c(k))) ! Qc2M endif @@ -1964,8 +2020,12 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !..Compute all frozen hydrometeor species' process terms. !+---+-----------------------------------------------------------------+ if (.not. iiwarm) then + !..vts_boost is the factor applied to snow terminal + !..fallspeed due to riming of snow do k = kts, kte - vts_boost(k) = 1.5 + vts_boost(k) = 1.0 + xDs = 0.0 + if (L_qs(k)) xDs = smoc(k) / smob(k) !..Temperature lookup table indexes. tempc = temp(k) - 273.15 @@ -2117,13 +2177,12 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !..Snow collecting cloud water. In CE, assume Dc< mvd_r_breakup ) then + pnr_rcg(k) = -5.0*tnr_gacr(idx_g1,idx_g,idx_r1,idx_r) ! RAIN2M +! else +! pnr_rcg(k) = -3.0*tnr_gacr(idx_g1,idx_g,idx_r1,idx_r) ! RAIN2M +! endif endif endif endif @@ -2287,8 +2351,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & pnr_rfz(k) = MIN(DBLE(nr(k)*odts), pnr_rfz(k)) elseif (rr(k).gt. R1 .and. temp(k).lt.HGFR) then pri_rfz(k) = rr(k)*odts - pnr_rfz(k) = nr(k)*odts ! RAIN2M - pni_rfz(k) = pnr_rfz(k) + pni_rfz(k) = nr(k)*odts ! RAIN2M endif if (rc(k).gt. r_c(1)) then @@ -2319,7 +2382,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !..Freezing of aqueous aerosols based on Koop et al (2001, Nature) xni = smo0(k)+ni(k) + (pni_rfz(k)+pni_wfz(k)+pni_inu(k))*dtsave - if (is_aerosol_aware .AND. homogIce .AND. (xni.le.500.E3) & + if (is_aerosol_aware .AND. homogIce .AND. (xni.le.999.E3) & & .AND.(temp(k).lt.238).AND.(ssati(k).ge.0.4) ) then xnc = iceKoop(temp(k),qv(k),qvs(k),nwfa(k), dtsave) pni_iha(k) = xnc*odts @@ -2442,7 +2505,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & prs_sde(k).gt.eps) then r_frac = MIN(30.0D0, prs_scw(k)/prs_sde(k)) g_frac = MIN(0.95, 0.15 + (r_frac-2.)*.028) - vts_boost(k) = MIN(1.5, 1.1 + (r_frac-2.)*.016) + vts_boost(k) = MIN(1.5, 1.1 + (r_frac-2.)*.014) prg_scw(k) = g_frac*prs_scw(k) prs_scw(k) = (1. - g_frac)*prs_scw(k) endif @@ -2454,12 +2517,13 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & if (L_qs(k)) then prr_sml(k) = (tempc*tcond(k)-lvap0*diffu(k)*delQvs(k)) & * (t1_qs_me*smo1(k) + t2_qs_me*rhof2(k)*vsc2(k)*smof(k)) - prr_sml(k) = prr_sml(k) + 4218.*olfus*tempc & - * (prr_rcs(k)+prs_scw(k)) + if (prr_sml(k) .gt. 0.) then + prr_sml(k) = prr_sml(k) + 4218.*olfus*tempc & + * (prr_rcs(k)+prs_scw(k)) + endif prr_sml(k) = MIN(DBLE(rs(k)*odts), MAX(0.D0, prr_sml(k))) pnr_sml(k) = smo0(k)/rs(k)*prr_sml(k) * 10.0**(-0.25*tempc) ! RAIN2M pnr_sml(k) = MIN(DBLE(smo0(k)*odts), pnr_sml(k)) -! if (tempc.gt.3.5 .or. rs(k).lt.0.005E-3) pnr_sml(k)=0.0 if (ssati(k).lt. 0.) then prs_sde(k) = C_cube*t1_subl*diffu(k)*ssati(k)*rvs & @@ -2478,7 +2542,6 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & prr_gml(k) = MIN(DBLE(rg(k)*odts), MAX(0.D0, prr_gml(k))) pnr_gml(k) = N0_g(k)*cgg(2)*ilamg(k)**cge(2) / rg(k) & ! RAIN2M * prr_gml(k) * 10.0**(-0.5*tempc) -! if (tempc.gt.7.5 .or. rg(k).lt.0.005E-3) pnr_gml(k)=0.0 if (ssati(k).lt. 0.) then prg_gde(k) = C_cube*t1_subl*diffu(k)*ssati(k)*rvs & @@ -2514,7 +2577,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !.. supersat again. sump = pri_inu(k) + pri_ide(k) + prs_ide(k) & + prs_sde(k) + prg_gde(k) + pri_iha(k) - rate_max = (qv(k)-qvsi(k))*odts*0.999 + rate_max = (qv(k)-qvsi(k))*rho(k)*odts*0.999 if ( (sump.gt. eps .and. sump.gt. rate_max) .or. & (sump.lt. -eps .and. sump.lt. rate_max) ) then ratio = rate_max/sump @@ -2687,7 +2750,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & xDi = (bm_i + mu_i + 1.) * ilami if (xDi.lt. 5.E-6) then lami = cie(2)/5.E-6 - xni = MIN(499.D3, cig(1)*oig2*xri/am_i*lami**bm_i) + xni = MIN(9999.D3, cig(1)*oig2*xri/am_i*lami**bm_i) niten(k) = (xni-ni1d(k)*rho(k))*odts*orho elseif (xDi.gt. 300.E-6) then lami = cie(2)/300.E-6 @@ -2698,8 +2761,8 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & niten(k) = -ni1d(k)*odts endif xni=MAX(0.,(ni1d(k) + niten(k)*dtsave)*rho(k)) - if (xni.gt.499.E3) & - niten(k) = (499.E3-ni1d(k)*rho(k))*odts*orho + if (xni.gt.9999.E3) & + niten(k) = (9999.E3-ni1d(k)*rho(k))*odts*orho !..Rain tendency qrten(k) = qrten(k) + (prr_wau(k) + prr_rcw(k) & @@ -2711,7 +2774,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !..Rain number tendency nrten(k) = nrten(k) + (pnr_wau(k) + pnr_sml(k) + pnr_gml(k) & - (pnr_rfz(k) + pnr_rcr(k) + pnr_rcg(k) & - + pnr_rcs(k) + pnr_rci(k)) ) & + + pnr_rcs(k) + pnr_rci(k) + pni_rfz(k)) ) & * orho !..Rain mass/number balance; keep median volume diameter between @@ -2799,10 +2862,12 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & lvt2(k)=lvap(k)*lvap(k)*ocp(k)*oRv*otemp*otemp nwfa(k) = MAX(11.1E6, (nwfa1d(k) + nwfaten(k)*DT)*rho(k)) + enddo + do k = kts, kte if ((qc1d(k) + qcten(k)*DT) .gt. R1) then rc(k) = (qc1d(k) + qcten(k)*DT)*rho(k) - nc(k) = MAX(2., (nc1d(k) + ncten(k)*DT)*rho(k)) + nc(k) = MAX(2., MIN((nc1d(k)+ncten(k)*DT)*rho(k), Nt_c_max)) if (.NOT. is_aerosol_aware) nc(k) = Nt_c L_qc(k) = .true. else @@ -2864,6 +2929,12 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & !.. intercepts/slopes of graupel and rain. !+---+-----------------------------------------------------------------+ if (.not. iiwarm) then + do k = kts, kte + smo2(k) = 0. + smob(k) = 0. + smoc(k) = 0. + smod(k) = 0. + enddo do k = kts, kte if (.not. L_qs(k)) CYCLE tc0 = MIN(-0.1, temp(k)-273.15) @@ -3031,9 +3102,10 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & ! -tpc_wev(idx_d, idx_c, idx_n)*orho*odt) prw_vcd(k) = MAX(DBLE(-rc(k)*0.99*orho*odt), prw_vcd(k)) pnc_wcd(k) = MAX(DBLE(-nc(k)*0.99*orho*odt), & - DBLE(-tnc_wev(idx_d, idx_c, idx_n)*orho*odt)) + -tnc_wev(idx_d, idx_c, idx_n)*orho*odt) endif + if(is_aerosol_aware .and. L_nwfa(k)) L_nwfa(k) = .false. else prw_vcd(k) = -rc(k)*orho*odt pnc_wcd(k) = -nc(k)*orho*odt @@ -3047,7 +3119,8 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & nwfaten(k) = nwfaten(k) - pnc_wcd(k) tten(k) = tten(k) + lvap(k)*ocp(k)*prw_vcd(k)*(1-IFDRY) rc(k) = MAX(R1, (qc1d(k) + DT*qcten(k))*rho(k)) - nc(k) = MAX(2., (nc1d(k) + DT*ncten(k))*rho(k)) + if (rc(k).eq.R1) L_qc(k) = .false. + nc(k) = MAX(2., MIN((nc1d(k)+ncten(k)*DT)*rho(k), Nt_c_max)) if (.NOT. is_aerosol_aware) nc(k) = Nt_c qv(k) = MAX(1.E-10, qv1d(k) + DT*qvten(k)) temp(k) = t1d(k) + DT*tten(k) @@ -3108,7 +3181,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & prv_rev(k) = MIN(DBLE(rate_max), prv_rev(k)*orho) !..TEST: G. Thompson 10 May 2013 -!..Reduce the rain evaporation in same places as melting graupel occurs. +!..Reduce the rain evaporation in same places as melting graupel occurs. !..Rationale: falling and simultaneous melting graupel in subsaturated !..regions will not melt as fast because particle temperature stays !..at 0C. Also not much shedding of the water from the graupel so @@ -3136,7 +3209,6 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & rho(k) = 0.622*pres(k)/(R*temp(k)*(qv(k)+0.622)) endif enddo -#if defined(mpas) do k = kts, kte evapprod(k) = prv_rev(k) - (min(zeroD0,prs_sde(k)) + & min(zeroD0,prg_gde(k))) @@ -3145,7 +3217,6 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & prg_gcw(k) + prs_sci(k) + & pri_rci(k) enddo -#endif !+---+-----------------------------------------------------------------+ !..Find max terminal fallspeed (distribution mass-weighted mean @@ -3168,6 +3239,8 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & vtck(k) = 0. vtnck(k) = 0. enddo + + if (ANY(L_qr .eqv. .true.)) then do k = kte, kts, -1 vtr = 0. rhof(k) = SQRT(RHO_NOT/rho(k)) @@ -3198,9 +3271,11 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & enddo if (ksed1(1) .eq. kte) ksed1(1) = kte-1 if (nstep .gt. 0) onstep(1) = 1./REAL(nstep) + endif !+---+-----------------------------------------------------------------+ + if (ANY(L_qc .eqv. .true.)) then hgt_agl = 0. do k = kts, kte-1 if (rc(k) .gt. R2) ksed1(5) = k @@ -3221,11 +3296,13 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & vtnck(k) = vtc endif enddo + endif !+---+-----------------------------------------------------------------+ if (.not. iiwarm) then + if (ANY(L_qi .eqv. .true.)) then nstep = 0 do k = kte, kts, -1 vti = 0. @@ -3253,9 +3330,11 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & enddo if (ksed1(2) .eq. kte) ksed1(2) = kte-1 if (nstep .gt. 0) onstep(2) = 1./REAL(nstep) + endif !+---+-----------------------------------------------------------------+ + if (ANY(L_qs .eqv. .true.)) then nstep = 0 do k = kte, kts, -1 vts = 0. @@ -3273,8 +3352,8 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & t4_vts = Kap1*Mrat**mu_s*csg(7)*ils2**cse(7) vts = rhof(k)*av_s * (t1_vts+t2_vts)/(t3_vts+t4_vts) if (temp(k).gt. (T_0+0.1)) then - vtsk(k) = MAX(vts*vts_boost(k), & - & vts*((vtrk(k)-vts*vts_boost(k))/(temp(k)-T_0))) + SR = rs(k)/(rs(k)+rr(k)) + vtsk(k) = vts*SR + (1.-SR)*vtrk(k) else vtsk(k) = vts*vts_boost(k) endif @@ -3290,9 +3369,11 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & enddo if (ksed1(3) .eq. kte) ksed1(3) = kte-1 if (nstep .gt. 0) onstep(3) = 1./REAL(nstep) + endif !+---+-----------------------------------------------------------------+ + if (ANY(L_qg .eqv. .true.)) then nstep = 0 do k = kte, kts, -1 vtg = 0. @@ -3316,18 +3397,16 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & enddo if (ksed1(4) .eq. kte) ksed1(4) = kte-1 if (nstep .gt. 0) onstep(4) = 1./REAL(nstep) + endif endif !+---+-----------------------------------------------------------------+ !..Sedimentation of mixing ratio is the integral of v(D)*m(D)*N(D)*dD, !.. whereas neglect m(D) term for number concentration. Therefore, !.. cloud ice has proper differential sedimentation. -!.. New in v3.0+ is computing separate for rain, ice, snow, and -!.. graupel species thus making code faster with credit to J. Schmidt. -!.. Bug fix, 2013Nov01 to tendencies using rho(k+1) correction thanks to -!.. Eric Skyllingstad. !+---+-----------------------------------------------------------------+ + if (ANY(L_qr .eqv. .true.)) then nstep = NINT(1./onstep(1)) do n = 1, nstep do k = kte, kts, -1 @@ -3354,12 +3433,14 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & *odzq*DT*onstep(1)) enddo - if (rr(kts).gt.R1*10.) & + if (rr(kts).gt.R1*1000.) & pptrain = pptrain + sed_r(kts)*DT*onstep(1) enddo + endif !+---+-----------------------------------------------------------------+ + if (ANY(L_qc .eqv. .true.)) then do k = kte, kts, -1 sed_c(k) = vtck(k)*rc(k) sed_n(k) = vtnck(k)*nc(k) @@ -3372,9 +3453,11 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & rc(k) = MAX(R1, rc(k) + (sed_c(k+1)-sed_c(k)) *odzq*DT) nc(k) = MAX(10., nc(k) + (sed_n(k+1)-sed_n(k)) *odzq*DT) enddo + endif !+---+-----------------------------------------------------------------+ + if (ANY(L_qi .eqv. .true.)) then nstep = NINT(1./onstep(2)) do n = 1, nstep do k = kte, kts, -1 @@ -3401,12 +3484,14 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & *odzq*DT*onstep(2)) enddo - if (ri(kts).gt.R1*10.) & + if (ri(kts).gt.R1*1000.) & pptice = pptice + sed_i(kts)*DT*onstep(2) enddo + endif !+---+-----------------------------------------------------------------+ + if (ANY(L_qs .eqv. .true.)) then nstep = NINT(1./onstep(3)) do n = 1, nstep do k = kte, kts, -1 @@ -3426,12 +3511,14 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & *odzq*DT*onstep(3)) enddo - if (rs(kts).gt.R1*10.) & + if (rs(kts).gt.R1*1000.) & pptsnow = pptsnow + sed_s(kts)*DT*onstep(3) enddo + endif !+---+-----------------------------------------------------------------+ + if (ANY(L_qg .eqv. .true.)) then nstep = NINT(1./onstep(4)) do n = 1, nstep do k = kte, kts, -1 @@ -3451,9 +3538,10 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & *odzq*DT*onstep(4)) enddo - if (rg(kts).gt.R1*10.) & + if (rg(kts).gt.R1*1000.) & pptgraul = pptgraul + sed_g(kts)*DT*onstep(4) enddo + endif !+---+-----------------------------------------------------------------+ !.. Instantly melt any cloud ice into cloud water if above 0C and @@ -3490,10 +3578,10 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & t1d(k) = t1d(k) + tten(k)*DT qv1d(k) = MAX(1.E-10, qv1d(k) + qvten(k)*DT) qc1d(k) = qc1d(k) + qcten(k)*DT - nc1d(k) = MAX(2./rho(k), nc1d(k) + ncten(k)*DT) - nwfa1d(k) = MAX(11.1E6/rho(k), MIN(9999.E6/rho(k), & + nc1d(k) = MAX(2./rho(k), MIN(nc1d(k) + ncten(k)*DT, Nt_c_max)) + nwfa1d(k) = MAX(11.1E6, MIN(9999.E6, & (nwfa1d(k)+nwfaten(k)*DT))) - nifa1d(k) = MAX(naIN1*0.01, MIN(9999.E6/rho(k), & + nifa1d(k) = MAX(naIN1*0.01, MIN(9999.E6, & (nifa1d(k)+nifaten(k)*DT))) if (qc1d(k) .le. R1) then @@ -3527,7 +3615,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & lami = cie(2)/300.E-6 endif ni1d(k) = MIN(cig(1)*oig2*qi1d(k)/am_i*lami**bm_i, & - 499.D3/rho(k)) + 9999.D3/rho(k)) endif qr1d(k) = qr1d(k) + qrten(k)*DT nr1d(k) = MAX(R2/rho(k), nr1d(k) + nrten(k)*DT) @@ -3640,7 +3728,8 @@ subroutine qr_acr_qg tcg_racg(i,j,k,m) = t1 tmr_racg(i,j,k,m) = DMIN1(z1, r_r(m)*1.0d0) tcr_gacr(i,j,k,m) = t2 - tmg_gacr(i,j,k,m) = z2 + tmg_gacr(i,j,k,m) = DMIN1(z2, r_g(j)*1.0d0) + !DAVE tmg_gacr(i,j,k,m) = DMIN1(z2, DBLE(r_g(j))) tnr_racg(i,j,k,m) = y1 tnr_gacr(i,j,k,m) = y2 enddo @@ -3829,8 +3918,10 @@ subroutine freezeH2O !..Local variables INTEGER:: i, j, k, m, n, n2 - DOUBLE PRECISION, DIMENSION(nbr):: N_r, massr - DOUBLE PRECISION, DIMENSION(nbc):: N_c, massc + INTEGER:: km, km_s, km_e + DOUBLE PRECISION:: N_r, N_c + DOUBLE PRECISION, DIMENSION(nbr):: massr + DOUBLE PRECISION, DIMENSION(nbc):: massc DOUBLE PRECISION:: sum1, sum2, sumn1, sumn2, & prob, vol, Texp, orho_w, & lam_exp, lamr, N0_r, lamc, N0_c, y @@ -3848,10 +3939,14 @@ subroutine freezeH2O massc(n) = am_r*Dc(n)**bm_r enddo + km_s = 0 + km_e = ntb_IN*45 - 1 + !..Freeze water (smallest drops become cloud ice, otherwise graupel). - do m = 1, ntb_IN - T_adjust = MAX(-3.0, MIN(3.0 - ALOG10(Nt_IN(m)), 3.0)) - do k = 1, 45 + do km = km_s, km_e + m = km / 45 + 1 + k = mod( km , 45 ) + 1 + T_adjust = MAX(-3.0, MIN(3.0 - ALOG10(Nt_IN(m)), 3.0)) ! print*, ' Freezing water for temp = ', -k Texp = DEXP( REAL(k,KIND=R8SIZE) - T_adjust*1.0D0 ) - 1.0D0 do j = 1, ntb_r1 @@ -3864,15 +3959,15 @@ subroutine freezeH2O sumn1 = 0.0d0 sumn2 = 0.0d0 do n2 = nbr, 1, -1 - N_r(n2) = N0_r*Dr(n2)**mu_r*DEXP(-lamr*Dr(n2))*dtr(n2) + N_r = N0_r*Dr(n2)**mu_r*DEXP(-lamr*Dr(n2))*dtr(n2) vol = massr(n2)*orho_w - prob = 1.0D0 - DEXP(-120.0D0*vol*5.2D-4 * Texp) + prob = MAX(0.0D0, 1.0D0 - DEXP(-120.0D0*vol*5.2D-4 * Texp)) if (massr(n2) .lt. xm0g) then - sumn1 = sumn1 + prob*N_r(n2) - sum1 = sum1 + prob*N_r(n2)*massr(n2) + sumn1 = sumn1 + prob*N_r + sum1 = sum1 + prob*N_r*massr(n2) else - sumn2 = sumn2 + prob*N_r(n2) - sum2 = sum2 + prob*N_r(n2)*massr(n2) + sumn2 = sumn2 + prob*N_r + sum2 = sum2 + prob*N_r*massr(n2) endif if ((sum1+sum2).ge.r_r(i)) EXIT enddo @@ -3892,10 +3987,10 @@ subroutine freezeH2O sumn2 = 0.0d0 do n = nbc, 1, -1 vol = massc(n)*orho_w - prob = 1.0D0 - DEXP(-120.0D0*vol*5.2D-4 * Texp) - N_c(n) = N0_c*Dc(n)**nu_c*EXP(-lamc*Dc(n))*dtc(n) - sumn2 = MIN(t_Nc(j), sumn2 + prob*N_c(n)) - sum1 = sum1 + prob*N_c(n)*massc(n) + prob = MAX(0.0D0, 1.0D0 - DEXP(-120.0D0*vol*5.2D-4 * Texp)) + N_c = N0_c*Dc(n)**nu_c*EXP(-lamc*Dc(n))*dtc(n) + sumn2 = MIN(t_Nc(j), sumn2 + prob*N_c) + sum1 = sum1 + prob*N_c*massc(n) if (sum1 .ge. r_c(i)) EXIT enddo tpi_qcfz(i,j,k,m) = sum1 @@ -3903,9 +3998,9 @@ subroutine freezeH2O enddo enddo enddo - enddo end subroutine freezeH2O + !+---+-----------------------------------------------------------------+ !ctrlL !+---+-----------------------------------------------------------------+ @@ -4282,7 +4377,7 @@ subroutine table_ccnAct end subroutine table_ccnAct #endif -!^L +! !+---+-----------------------------------------------------------------+ !..Retrieve fraction of CCN that gets activated given the model temp, !.. vertical velocity, and available CCN concentration. The lookup @@ -4622,7 +4717,7 @@ real function iceDeMott(tempc, qv, qvs, qvsi, rho, nifa) ! mux = hx*p_alpha*n_in*rho ! xni = mux*((6700.*nifa)-200.)/((6700.*5.E5)-200.) ! elseif (satw.ge.0.985 .and. tempc.gt.HGFR-273.15) then - nifa_cc = nifa*RHO_NOT0*1.E-6/rho + nifa_cc = MAX(0.5, nifa*RHO_NOT0*1.E-6/rho) ! xni = 3.*nifa_cc**(1.25)*exp((0.46*(-tempc))-11.6) ! [DeMott, 2015] xni = (5.94e-5*(-tempc)**3.33) & ! [DeMott, 2010] * (nifa_cc**((-0.0264*(tempc))+0.0033)) @@ -4739,7 +4834,7 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & do k = kts, kte rho(k) = 0.622*p1d(k)/(R*t1d(k)*(qv1d(k)+0.622)) rc(k) = MAX(R1, qc1d(k)*rho(k)) - nc(k) = MAX(R2, nc1d(k)*rho(k)) + nc(k) = MAX(2., MIN(nc1d(k)*rho(k), Nt_c_max)) if (.NOT. is_aerosol_aware) nc(k) = Nt_c if (rc(k).gt.R1 .and. nc(k).gt.R2) has_qc = .true. ri(k) = MAX(R1, qi1d(k)*rho(k)) @@ -4751,6 +4846,7 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & if (has_qc) then do k = kts, kte + re_qc1d(k) = 2.49E-6 if (rc(k).le.R1 .or. nc(k).le.R2) CYCLE if (nc(k).lt.100) then inu_c = 15 @@ -4766,14 +4862,16 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & if (has_qi) then do k = kts, kte + re_qi1d(k) = 2.49E-6 if (ri(k).le.R1 .or. ni(k).le.R2) CYCLE lami = (am_i*cig(2)*oig1*ni(k)/ri(k))**obmi - re_qi1d(k) = MAX(5.01E-6, MIN(SNGL(0.5D0 * DBLE(3.+mu_i)/lami), 125.E-6)) + re_qi1d(k) = MAX(2.51E-6, MIN(SNGL(0.5D0 * DBLE(3.+mu_i)/lami), 125.E-6)) enddo endif if (has_qs) then do k = kts, kte + re_qs1d(k) = 4.99E-6 if (rs(k).le.R1) CYCLE tc0 = MIN(-0.1, t1d(k)-273.15) smob = rs(k)*oams @@ -4808,7 +4906,7 @@ subroutine calc_effectRad (t1d, p1d, qv1d, qc1d, nc1d, qi1d, ni1d, qs1d, & & + sb(7)*tc0*tc0*cse(1) + sb(8)*tc0*cse(1)*cse(1) & & + sb(9)*tc0*tc0*tc0 + sb(10)*cse(1)*cse(1)*cse(1) smoc = a_ * smo2**b_ - re_qs1d(k) = MAX(10.E-6, MIN(0.5*(smoc/smob), 999.E-6)) + re_qs1d(k) = MAX(5.01E-6, MIN(0.5*(smoc/smob), 999.E-6)) enddo endif @@ -4909,6 +5007,14 @@ subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & !..Calculate y-intercept, slope, and useful moments for snow. !+---+-----------------------------------------------------------------+ do k = kts, kte + smo2(k) = 0. + smob(k) = 0. + smoc(k) = 0. + smoz(k) = 0. + enddo + if (ANY(L_qs .eqv. .true.)) then + do k = kts, kte + if (.not. L_qs(k)) CYCLE tc0 = MIN(-0.1, temp(k)-273.15) smob(k) = rs(k)*oams @@ -4957,11 +5063,13 @@ subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & & + sb(9)*tc0*tc0*tc0 + sb(10)*cse(3)*cse(3)*cse(3) smoz(k) = a_ * smo2(k)**b_ enddo + endif !+---+-----------------------------------------------------------------+ !..Calculate y-intercept, slope values for graupel. !+---+-----------------------------------------------------------------+ + if (ANY(L_qg .eqv. .true.)) then N0_min = gonv_max k_0 = kts do k = kte, kts, -1 @@ -4984,6 +5092,7 @@ subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & ilamg(k) = 1./lamg N0_g(k) = N0_exp/(cgg(2)*lam_exp) * lamg**cge(2) enddo + endif !+---+-----------------------------------------------------------------+ !..Locate K-level of start of melting (k_0 is level above). diff --git a/src/core_atmosphere/physics/physics_wrf/module_mp_thompson_aerosols.F b/src/core_atmosphere/physics/physics_wrf/module_mp_thompson_aerosols.F new file mode 100644 index 000000000..48fb6fb64 --- /dev/null +++ b/src/core_atmosphere/physics/physics_wrf/module_mp_thompson_aerosols.F @@ -0,0 +1,214 @@ +!================================================================================================================= +!module_mp_thompson_aerosols includes subroutine gt_aod. gt_aod is called from subroutine radiation_sw_from_MPAS +!in mpas_atmphys_driver_radiation_sw.F. gt_aod calculates the 550 nm aerosol optical depth of "water-friendly" +!and "ice-friendly" aerosols from the Thompson cloud microphysics scheme. gt_aod was copied from WRF-4.0.2 (see +!module_radiation_driver.F). +!Laura D. Fowler (laura@ucar.edu) / 2019-01-13. + + module module_mp_thompson_aerosols + use mpas_atmphys_functions,only: rslf + use mpas_atmphys_utilities, only: physics_error_fatal,physics_message +#define FATAL_ERROR(M) call physics_error_fatal(M) +#define WRITE_MESSAGE(M) call physics_message(M) + + implicit none + private + public:: gt_aod + + + contains + + +!================================================================================================================= + SUBROUTINE gt_aod(p_phy,DZ8W,t_phy,qvapor, nwfa,nifa, taod5503d, & + & ims,ime, jms,jme, kms,kme, its,ite, jts,jte, kts,kte) + +! USE module_mp_thompson, only: RSLF + +! IMPLICIT NONE + + INTEGER, INTENT(IN):: ims,ime, jms,jme, kms,kme, & + & its,ite, jts,jte, kts,kte + + REAL, DIMENSION(ims:ime,kms:kme,jms:jme), INTENT(IN) :: & + & t_phy,p_phy, DZ8W, & + & qvapor, nifa, nwfa + REAL,DIMENSION(ims:ime,kms:kme,jms:jme),INTENT(INOUT):: taod5503d + + !..Local variables. + + REAL, DIMENSION(its:ite,kts:kte,jts:jte):: AOD_wfa, AOD_ifa + REAL:: RH, a_RH,b_RH, rh_d,rh_f, rhoa,qvsat, unit_bext1,unit_bext3 + REAL:: ntemp + INTEGER :: i, k, j, RH_idx, RH_idx1, RH_idx2, t_idx + INTEGER, PARAMETER:: rind=8 + REAL, DIMENSION(rind), PARAMETER:: rh_arr = & + & (/10., 60., 70., 80., 85., 90., 95., 99.8/) + REAL, DIMENSION(rind,4,2) :: lookup_tabl ! RH, temp, water-friendly, ice-friendly + + lookup_tabl(1,1,1) = 5.73936E-15 + lookup_tabl(1,1,2) = 2.63577E-12 + lookup_tabl(1,2,1) = 5.73936E-15 + lookup_tabl(1,2,2) = 2.63577E-12 + lookup_tabl(1,3,1) = 5.73936E-15 + lookup_tabl(1,3,2) = 2.63577E-12 + lookup_tabl(1,4,1) = 5.73936E-15 + lookup_tabl(1,4,2) = 2.63577E-12 + + lookup_tabl(2,1,1) = 6.93515E-15 + lookup_tabl(2,1,2) = 2.72095E-12 + lookup_tabl(2,2,1) = 6.93168E-15 + lookup_tabl(2,2,2) = 2.72092E-12 + lookup_tabl(2,3,1) = 6.92570E-15 + lookup_tabl(2,3,2) = 2.72091E-12 + lookup_tabl(2,4,1) = 6.91833E-15 + lookup_tabl(2,4,2) = 2.72087E-12 + + lookup_tabl(3,1,1) = 7.24707E-15 + lookup_tabl(3,1,2) = 2.77219E-12 + lookup_tabl(3,2,1) = 7.23809E-15 + lookup_tabl(3,2,2) = 2.77222E-12 + lookup_tabl(3,3,1) = 7.23108E-15 + lookup_tabl(3,3,2) = 2.77201E-12 + lookup_tabl(3,4,1) = 7.21800E-15 + lookup_tabl(3,4,2) = 2.77111E-12 + + lookup_tabl(4,1,1) = 8.95130E-15 + lookup_tabl(4,1,2) = 2.87263E-12 + lookup_tabl(4,2,1) = 9.01582E-15 + lookup_tabl(4,2,2) = 2.87252E-12 + lookup_tabl(4,3,1) = 9.13216E-15 + lookup_tabl(4,3,2) = 2.87241E-12 + lookup_tabl(4,4,1) = 9.16219E-15 + lookup_tabl(4,4,2) = 2.87211E-12 + + lookup_tabl(5,1,1) = 1.06695E-14 + lookup_tabl(5,1,2) = 2.96752E-12 + lookup_tabl(5,2,1) = 1.06370E-14 + lookup_tabl(5,2,2) = 2.96726E-12 + lookup_tabl(5,3,1) = 1.05999E-14 + lookup_tabl(5,3,2) = 2.96702E-12 + lookup_tabl(5,4,1) = 1.05443E-14 + lookup_tabl(5,4,2) = 2.96603E-12 + + lookup_tabl(6,1,1) = 1.37908E-14 + lookup_tabl(6,1,2) = 3.15081E-12 + lookup_tabl(6,2,1) = 1.37172E-14 + lookup_tabl(6,2,2) = 3.15020E-12 + lookup_tabl(6,3,1) = 1.36362E-14 + lookup_tabl(6,3,2) = 3.14927E-12 + lookup_tabl(6,4,1) = 1.35287E-14 + lookup_tabl(6,4,2) = 3.14817E-12 + + lookup_tabl(7,1,1) = 2.26019E-14 + lookup_tabl(7,1,2) = 3.66798E-12 + lookup_tabl(7,2,1) = 2.24435E-14 + lookup_tabl(7,2,2) = 3.66540E-12 + lookup_tabl(7,3,1) = 2.23254E-14 + lookup_tabl(7,3,2) = 3.66173E-12 + lookup_tabl(7,4,1) = 2.20496E-14 + lookup_tabl(7,4,2) = 3.65796E-12 + + lookup_tabl(8,1,1) = 4.41983E-13 + lookup_tabl(8,1,2) = 7.50091E-11 + lookup_tabl(8,2,1) = 3.93335E-13 + lookup_tabl(8,2,2) = 6.79097E-11 + lookup_tabl(8,3,1) = 3.45569E-13 + lookup_tabl(8,3,2) = 6.07845E-11 + lookup_tabl(8,4,1) = 2.96971E-13 + lookup_tabl(8,4,2) = 5.36085E-11 + + DO j=jts,jte + DO k=kts,kte + DO i=its,ite + AOD_wfa(i,k,j) = 0. + AOD_ifa(i,k,j) = 0. + END DO + END DO + END DO + + DO j=jts,jte + DO k=kts,kte + DO i=its,ite + rhoa = p_phy(i,k,j)/(287.*t_phy(i,k,j)) + t_idx = MAX(1, MIN(nint(10.999-0.0333*t_phy(i,k,j)),4)) + qvsat = rslf(p_phy(i,k,j),t_phy(i,k,j)) + RH = MIN(98., MAX(10.1, qvapor(i,k,j)/qvsat*100.)) + + !..Get the index for the RH array element + + if (RH .lt. 60) then + RH_idx1 = 1 + RH_idx2 = 2 + elseif (RH .ge. 60 .AND. RH.lt.80) then + a_RH = 0.1 + b_RH = -4 + RH_idx = nint(a_RH*RH+b_RH) + rh_d = rh-rh_arr(rh_idx) + if (rh_d .lt. 0) then + RH_idx1 = RH_idx-1 + RH_idx2 = RH_idx + else + RH_idx1 = RH_idx + RH_idx2 = RH_idx+1 + if (RH_idx2.gt.rind) then + RH_idx2 = rind + RH_idx1 = rind-1 + endif + endif + else + a_RH = 0.2 + b_RH = -12. + RH_idx = MIN(rind, nint(a_RH*RH+b_RH)) + rh_d = rh-rh_arr(rh_idx) + if (rh_d .lt. 0) then + RH_idx1 = RH_idx-1 + RH_idx2 = RH_idx + else + RH_idx1 = RH_idx + RH_idx2 = RH_idx+1 + if (RH_idx2.gt.rind) then + RH_idx2 = rind + RH_idx1 = rind-1 + endif + endif + endif + + !..RH fraction to be used + + rh_f = MAX(0., MIN(1.0, (rh/(100-rh)-rh_arr(rh_idx1) & + & /(100-rh_arr(rh_idx1))) & + & /(rh_arr(rh_idx2)/(100-rh_arr(rh_idx2)) & + & -rh_arr(rh_idx1)/(100-rh_arr(rh_idx1))) )) + + + unit_bext1 = lookup_tabl(RH_idx1,t_idx,1) & + & + (lookup_tabl(RH_idx2,t_idx,1) & + & - lookup_tabl(RH_idx1,t_idx,1))*rh_f + unit_bext3 = lookup_tabl(RH_idx1,t_idx,2) & + & + (lookup_tabl(RH_idx2,t_idx,2) & + & - lookup_tabl(RH_idx1,t_idx,2))*rh_f + + ntemp = MAX(1., MIN(99999.E6, nwfa(i,k,j))) + AOD_wfa(i,k,j) = unit_bext1*ntemp*dz8w(i,k,j)*rhoa + + ntemp = MAX(0.01, MIN(9999.E6, nifa(i,k,j))) + AOD_ifa(i,k,j) = unit_bext3*ntemp*dz8w(i,k,j)*rhoa + + END DO + END DO + END DO + + DO j=jts,jte + DO k=kts,kte + DO i=its,ite + taod5503d(i,k,j) = aod_wfa(i,k,j) + aod_ifa(i,k,j) + END DO + END DO + END DO + + END SUBROUTINE gt_aod + +!================================================================================================================= + end module module_mp_thompson_aerosols +!================================================================================================================= diff --git a/src/core_atmosphere/physics/physics_wrf/module_ra_rrtmg_lw.F b/src/core_atmosphere/physics/physics_wrf/module_ra_rrtmg_lw.F index 6d59bcb82..89bc6b00b 100644 --- a/src/core_atmosphere/physics/physics_wrf/module_ra_rrtmg_lw.F +++ b/src/core_atmosphere/physics/physics_wrf/module_ra_rrtmg_lw.F @@ -2079,7 +2079,7 @@ module mcica_subcol_gen_lw use parkind, only : im => kind_im, rb => kind_rb use parrrtm, only : nbndlw, ngptlw - use rrlw_con, only: grav + use rrlw_con, only: grav, pi use rrlw_wvn, only: ngb use rrlw_vsn @@ -2093,10 +2093,13 @@ module mcica_subcol_gen_lw !------------------------------------------------------------------ ! Public subroutines !------------------------------------------------------------------ - +! mji - Add height needed for exponential and exponential-random cloud overlap methods +! (icld=4 and 5, respectively) along with idcor, juldat and lat used to specify +! the decorrelation length for these methods subroutine mcica_subcol_lw(iplon, ncol, nlay, icld, permuteseed, irng, play, & - cldfrac, ciwp, clwp, cswp, rei, rel, res, tauc, cldfmcl, & - ciwpmcl, clwpmcl, cswpmcl, reicmcl, relqmcl, resnmcl, taucmcl) + cldfrac, ciwp, clwp, cswp, rei, rel, res, tauc, & + hgt, idcor, juldat, lat, & + cldfmcl, ciwpmcl, clwpmcl, cswpmcl, reicmcl, relqmcl, resnmcl, taucmcl) ! ----- Input ----- ! Control @@ -2116,6 +2119,9 @@ subroutine mcica_subcol_lw(iplon, ncol, nlay, icld, permuteseed, irng, play, & real(kind=rb), intent(in) :: play(:,:) ! layer pressures (mb) ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: hgt(:,:) ! layer height (m) + ! Dimensions: (ncol,nlay) + ! Atmosphere/clouds - cldprop real(kind=rb), intent(in) :: cldfrac(:,:) ! layer cloud fraction ! Dimensions: (ncol,nlay) @@ -2137,6 +2143,9 @@ subroutine mcica_subcol_lw(iplon, ncol, nlay, icld, permuteseed, irng, play, & ! Dimensions: (ncol,nlay) real(kind=rb), intent(in) :: res(:,:) ! snow particle size ! Dimensions: (ncol,nlay) + integer(kind=im), intent(in) :: idcor ! Decorrelation length type + integer(kind=im), intent(in) :: juldat ! Julian date (day of year, 1-365) + real(kind=rb), intent(in) :: lat ! latitude (degrees, -90 to 90) ! ----- Output ----- ! Atmosphere/clouds - cldprmc [mcica] @@ -2172,10 +2181,18 @@ subroutine mcica_subcol_lw(iplon, ncol, nlay, icld, permuteseed, irng, play, & ! real(kind=rb) :: qi(ncol, nlay) ! ice water (specific humidity) ! real(kind=rb) :: ql(ncol, nlay) ! liq water (specific humidity) +! MJI - For latitude dependent decorrelation length + real(kind=rb), parameter :: am1 = 1.4315_rb + real(kind=rb), parameter :: am2 = 2.1219_rb + real(kind=rb), parameter :: am4 = -25.584_rb + real(kind=rb), parameter :: amr = 7._rb + real(kind=rb) :: am3 + real(kind=rb) :: decorr_len(ncol) ! decorrelation length (meters) + real(kind=rb), parameter :: Zo_default = 2500._rb ! default constant decorrelation length (m) ! Return if clear sky; or stop if icld out of range if (icld.eq.0) return - if (icld.lt.0.or.icld.gt.3) then + if (icld.lt.0.or.icld.gt.5) then stop 'MCICA_SUBCOL: INVALID ICLD' endif @@ -2205,8 +2222,27 @@ subroutine mcica_subcol_lw(iplon, ncol, nlay, icld, permuteseed, irng, play, & ! ql(ilev) = (clwp(ilev) * grav) / (pdel(ilev) * 1000._rb) ! enddo +! MJI - Latitude and day of year dependent decorrelation length + if (idcor .eq. 1) then +! Derive decorrelation length based on day of year and latitude (from NASA GMAO method) +! Result is in meters + if (juldat .gt. 181) then + am3 = -4._rb * amr / 365._rb * (juldat-272) + else + am3 = 4._rb * amr / 365._rb * (juldat-91) + endif +! Latitude in radians, decorrelation length in meters +! decorr_len(:) = ( am1 + am2 * exp(-(lat*180._rb/pi - am3)**2 / (am4*am4)) ) * 1.e3_rb +! Latitude in degrees, decorrelation length in meters + decorr_len(:) = ( am1 + am2 * exp(-(lat - am3)**2 / (am4*am4)) ) * 1.e3_rb + else +! Spatially and temporally constant decorrelation length + decorr_len(:) = Zo_default + endif + ! Generate the stochastic subcolumns of cloud optical properties for the longwave; call generate_stochastic_clouds (ncol, nlay, nsubclw, icld, irng, pmid, cldfrac, clwp, ciwp, cswp, tauc, & + hgt, decorr_len, & cldfmcl, clwpmcl, ciwpmcl, cswpmcl, taucmcl, permuteseed) end subroutine mcica_subcol_lw @@ -2214,6 +2250,7 @@ end subroutine mcica_subcol_lw !------------------------------------------------------------------------------------------------- subroutine generate_stochastic_clouds(ncol, nlay, nsubcol, icld, irng, pmid, cld, clwp, ciwp, cswp, tauc, & + hgt, decorr_len, & cld_stoch, clwp_stoch, ciwp_stoch, cswp_stoch, tauc_stoch, changeSeed) !------------------------------------------------------------------------------------------------- @@ -2223,10 +2260,13 @@ subroutine generate_stochastic_clouds(ncol, nlay, nsubcol, icld, irng, pmid, cld ! ! Original code: Based on Raisanen et al., QJRMS, 2004. ! - ! Modifications: Generalized for use with RRTMG and added Mersenne Twister as the default + ! Modifications: + ! 1) Generalized for use with RRTMG and added Mersenne Twister as the default ! random number generator, which can be changed to the optional kissvec random number generator ! with flag 'irng'. Some extra functionality has been commented or removed. ! Michael J. Iacono, AER, Inc., February 2007 + ! 2) Activated exponential and exponential/random cloud overlap method + ! Michael J. Iacono, AER, November 2017 ! ! Given a profile of cloud fraction, cloud water and cloud ice, we produce a set of subcolumns. ! Each layer within each subcolumn is homogeneous, with cloud fraction equal to zero or one @@ -2235,12 +2275,11 @@ subroutine generate_stochastic_clouds(ncol, nlay, nsubcol, icld, irng, pmid, cld ! and obeys an overlap assumption in the vertical. ! ! Overlap assumption: - ! The cloud are consistent with 4 overlap assumptions: random, maximum, maximum-random and exponential. - ! The default option is maximum-random (option 3) - ! The options are: 1=random overlap, 2=max/random, 3=maximum overlap, 4=exponential overlap - ! This is set with the variable "overlap" - !mji - Exponential overlap option (overlap=4) has been deactivated in this version - ! The exponential overlap uses also a length scale, Zo. (real, parameter :: Zo = 2500. ) + ! The cloud are consistent with 5 overlap assumptions: random, maximum, maximum-random, exponential and exponential random. + ! The default option is maximum-random (option 2) + ! The options are: 1=random overlap, 2=max/random, 3=maximum overlap, 4=exponential overlap, 5=exp/random + ! This is set with the variable "overlap" + ! The exponential overlap uses also a length scale, Zo. (real, parameter :: Zo = 2500. ) ! ! Seed: ! If the stochastic cloud generator is called several times during the same timestep, @@ -2292,6 +2331,8 @@ subroutine generate_stochastic_clouds(ncol, nlay, nsubcol, icld, irng, pmid, cld ! Column state (cloud fraction, cloud water, cloud ice) + variables needed to read physics state real(kind=rb), intent(in) :: pmid(:,:) ! layer pressure (Pa) ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: hgt(:,:) ! layer height (m) + ! Dimensions: (ncol,nlay) real(kind=rb), intent(in) :: cld(:,:) ! cloud fraction ! Dimensions: (ncol,nlay) real(kind=rb), intent(in) :: clwp(:,:) ! in-cloud liquid water path @@ -2308,6 +2349,8 @@ subroutine generate_stochastic_clouds(ncol, nlay, nsubcol, icld, irng, pmid, cld ! real(kind=rb), intent(in) :: asmc(:,:,:) ! in-cloud asymmetry parameter ! Dimensions: (nbndlw,ncol,nlay) ! inactive - for future expansion + real(kind=rb), intent(in) :: decorr_len(:) ! decorrelation length (meters) + ! Dimensions: (ncol) real(kind=rb), intent(out) :: cld_stoch(:,:,:) ! subcolumn cloud fraction ! Dimensions: (ngptlw,ncol,nlay) @@ -2338,11 +2381,11 @@ subroutine generate_stochastic_clouds(ncol, nlay, nsubcol, icld, irng, pmid, cld ! real(kind=rb) :: mean_asmc_stoch(ncol, nlay) ! cloud asymmetry parameter ! Set overlap - integer(kind=im) :: overlap ! 1 = random overlap, 2 = maximum/random, - ! 3 = maximum overlap, -! real(kind=rb), parameter :: Zo = 2500._rb ! length scale (m) -! real(kind=rb) :: zm(ncol,nlay) ! Height of midpoints (above surface) -! real(kind=rb), dimension(nlay) :: alpha=0.0_rb ! overlap parameter + integer(kind=im) :: overlap ! 1 = random overlap, 2 = maximum-random, + ! 3 = maximum overlap, 4 = exponential, + ! 5 = exponential-random + real(kind=rb) :: Zo_inv(ncol) ! inverse of decorrelation length scale (m) + real(kind=rb), dimension(ncol,nlay) :: alpha ! overlap parameter ! Constants (min value for cloud fraction and cloud water and ice) real(kind=rb), parameter :: cldmin = 1.0e-20_rb ! min cloud fraction @@ -2368,6 +2411,7 @@ subroutine generate_stochastic_clouds(ncol, nlay, nsubcol, icld, irng, pmid, cld ! Pass input cloud overlap setting to local variable overlap = icld + Zo_inv(:) = 1._rb / decorr_len(:) ! Ensure that cloud fractions are in bounds do ilev = 1, nlay @@ -2489,39 +2533,106 @@ subroutine generate_stochastic_clouds(ncol, nlay, nsubcol, icld, irng, pmid, cld enddo endif -! case(4) - inactive -! ! Exponential overlap: weighting between maximum and random overlap increases with the distance. -! ! The random numbers for exponential overlap verify: -! ! j=1 RAN(j)=RND1 -! ! j>1 if RND1 < alpha(j,j-1) => RAN(j) = RAN(j-1) -! ! RAN(j) = RND2 -! ! alpha is obtained from the equation -! ! alpha = exp(- (Zi-Zj-1)/Zo) where Zo is a characteristic length scale - - -! ! compute alpha -! zm = state%zm -! alpha(:, 1) = 0. -! do ilev = 2,nlay -! alpha(:, ilev) = exp( -( zm (:, ilev-1) - zm (:, ilev)) / Zo) -! end do + case(4) + ! Exponential overlap: transition from maximum to random cloud overlap increases + ! exponentially with layer thickness and distance through layers + ! + ! The random numbers for exponential overlap verify: + ! j=1 RAN(j)=RND1 + ! j>1 if RND1 < alpha(j,j-1) => RAN(j) = RAN(j-1) + ! RAN(j) = RND2 + ! alpha is obtained from the equation + ! alpha = exp(-(Z(j)-Z(j-1))/Zo) where Zo is a characteristic length scale + + ! compute alpha + ! todo - need to permute this loop after adding vectorized expf() function + do i = 1, ncol + alpha(i, 1) = 0._rb + do ilev = 2,nlay + alpha(i, ilev) = exp( -(hgt(i,ilev) - hgt(i,ilev-1)) * Zo_inv(i)) + enddo + enddo + + ! generate 2 streams of random numbers + if (irng.eq.0) then + do isubcol = 1,nsubcol + do ilev = 1,nlay + call kissvec(seed1, seed2, seed3, seed4, rand_num) + CDF(isubcol, :, ilev) = rand_num + call kissvec(seed1, seed2, seed3, seed4, rand_num) + CDF2(isubcol, :, ilev) = rand_num + enddo + enddo + elseif (irng.eq.1) then + do isubcol = 1, nsubcol + do i = 1, ncol + do ilev = 1, nlay + rand_num_mt = getRandomReal(randomNumbers) + CDF(isubcol,i,ilev) = rand_num_mt + rand_num_mt = getRandomReal(randomNumbers) + CDF2(isubcol,i,ilev) = rand_num_mt + enddo + enddo + enddo + endif + + ! generate random numbers + do ilev = 2,nlay + where (CDF2(:, :, ilev) < spread(alpha (:,ilev), dim=1, nCopies=nsubcol) ) + CDF(:,:,ilev) = CDF(:,:,ilev-1) + end where + end do + + case(5) + ! Exponential_Random overlap: transition from maximum to random cloud overlap increases + ! exponentially with layer thickness and with distance through adjacent cloudy layers. + ! Non-adjacent blocks of clouds are treated randomly, and each block begins a new + ! exponential transition from maximum to random. + ! + ! compute alpha: bottom to top + ! - set alpha to 0 in bottom layer (no layer below for correlation) + do i = 1, ncol + alpha(i, 1) = 0._rb + do ilev = 2,nlay + alpha(i, ilev) = exp( -(hgt(i,ilev) - hgt(i,ilev-1) ) * Zo_inv(i)) + ! Decorrelate layers when clear layer follows a cloudy layer to enforce + ! random correlation between non-adjacent cloudy layers + if (cldf(i,ilev) .eq. 0.0_rb .and. cldf(i,ilev-1) .gt. 0.0_rb) then + alpha(i,ilev) = 0.0_rb + endif + end do + end do -! ! generate 2 streams of random numbers -! do isubcol = 1,nsubcol -! do ilev = 1,nlay -! call kissvec(seed1, seed2, seed3, seed4, rand_num) -! CDF(isubcol, :, ilev) = rand_num -! call kissvec(seed1, seed2, seed3, seed4, rand_num) -! CDF2(isubcol, :, ilev) = rand_num -! end do -! end do - -! ! generate random numbers -! do ilev = 2,nlay -! where (CDF2(:, :, ilev) < spread(alpha (:,ilev), dim=1, nCopies=nsubcol) ) -! CDF(:,:,ilev) = CDF(:,:,ilev-1) -! end where -! end do + ! generate 2 streams of random numbers + ! CDF2 is used to select which sub-columns are vertically correlated relative to alpha + ! CDF is used to select which sub-columns are treated as cloudy relative to cloud fraction + if (irng.eq.0) then + do isubcol = 1,nsubcol + do ilev = 1,nlay + call kissvec(seed1, seed2, seed3, seed4, rand_num) + CDF(isubcol, :, ilev) = rand_num + call kissvec(seed1, seed2, seed3, seed4, rand_num) + CDF2(isubcol, :, ilev) = rand_num + end do + end do + elseif (irng.eq.1) then + do isubcol = 1, nsubcol + do i = 1, ncol + do ilev = 1,nlay + rand_num_mt = getRandomReal(randomNumbers) + CDF(isubcol,i,ilev) = rand_num_mt + rand_num_mt = getRandomReal(randomNumbers) + CDF2(isubcol,i,ilev) = rand_num_mt + enddo + enddo + enddo + endif + ! generate vertical correlations in random number arrays - bottom to top + do ilev = 2,nlay + where (CDF2(:, :, ilev) < spread(alpha (:,ilev), dim=1, nCopies=nsubcol) ) + CDF(:,:,ilev) = CDF(:,:,ilev-1) + end where + end do end select @@ -2634,14 +2745,8 @@ end module mcica_subcol_gen_lw ! module rrtmg_lw_cldprmc -#if defined(mpas) use mpas_atmphys_utilities,only: physics_error_fatal #define FATAL_ERROR(M) call physics_error_fatal( M ) -#else -use module_wrf_error -#define FATAL_ERROR(M) call wrf_error_fatal( M ) -#endif - ! -------------------------------------------------------------------------- ! | | @@ -3187,6 +3292,7 @@ subroutine rtrnmc(nlayers, istart, iend, iout, pz, semiss, ncbands, & icldlyr(lay) = 0 ! Change to band loop? +! todo permute, remove condition, vectorize expf do ig = 1, ngptlw if (cldfmc(ig,lay) .eq. 1._rb) then ib = ngb(ig) @@ -4947,9 +5053,9 @@ subroutine taumol(nlayers, pavel, wx, coldry, & ! ----- Output ----- real(kind=rb), intent(out) :: fracs(:,:) ! planck fractions - ! Dimensions: (nlayers+1,ngptlw) + ! Dimensions: (nlayers,ngptlw) real(kind=rb), intent(out) :: taug(:,:) ! gaseous optical depth - ! Dimensions: (nlayers+1,ngptlw) + ! Dimensions: (nlayers,ngptlw) !jm not thread safe hvrtau = '$Revision: 1.7 $' @@ -6001,10 +6107,12 @@ subroutine taugb6 ! ------- Modules ------- - use parrrtm, only : ng6, ngs5 + use parrrtm, only : ngs5 +! use parrrtm, only : ng6, ngs5 use rrlw_ref, only : chi_mls - use rrlw_kg06, only : fracrefa, absa, ka, ka_mco2, & - selfref, forref, cfc11adj, cfc12 + use rrlw_kg06 +! use rrlw_kg06, only : fracrefa, absa, ka, ka_mco2, & +! selfref, forref, cfc11adj, cfc12 ! ------- Declarations ------- @@ -8779,11 +8887,13 @@ subroutine cmbgb6 ! old band 6: 820-980 cm-1 (low - h2o; high - nothing) !*************************************************************************** - use parrrtm, only : mg, nbndlw, ngptlw, ng6 - use rrlw_kg06, only: fracrefao, kao, kao_mco2, cfc11adjo, cfc12o, & - selfrefo, forrefo, & - fracrefa, absa, ka, ka_mco2, cfc11adj, cfc12, & - selfref, forref + use parrrtm, only : mg, nbndlw, ngptlw +! use parrrtm, only : mg, nbndlw, ngptlw, ng6 + use rrlw_kg06 +! use rrlw_kg06, only: fracrefao, kao, kao_mco2, cfc11adjo, cfc12o, & +! selfrefo, forrefo, & +! fracrefa, absa, ka, ka_mco2, cfc11adj, cfc12, & +! selfref, forref ! ------- Local ------- integer(kind=im) :: jt, jp, igc, ipr, iprsm @@ -10600,7 +10710,8 @@ subroutine rrtmg_lw & inflglw ,iceflglw,liqflglw,cldfmcl , & taucmcl ,ciwpmcl ,clwpmcl , cswpmcl ,reicmcl ,relqmcl , resnmcl , & tauaer , & - uflx ,dflx ,hr ,uflxc ,dflxc, hrc) + uflx ,dflx ,hr ,uflxc ,dflxc, hrc, & + uflxcln ,dflxcln, calc_clean_atm_diag ) ! -------- Description -------- @@ -10699,6 +10810,8 @@ subroutine rrtmg_lw & ! 1: Random ! 2: Maximum/random ! 3: Maximum + ! 4: Exponential + ! 5: Exponential/random real(kind=rb), intent(in) :: play(:,:) ! Layer pressures (hPa, mb) ! Dimensions: (ncol,nlay) real(kind=rb), intent(in) :: plev(:,:) ! Interface pressures (hPa, mb) @@ -10781,6 +10894,7 @@ subroutine rrtmg_lw & ! Dimensions: (ncol,nlay,nbndlw) ! for future expansion ! (lw aerosols/scattering not yet available) + integer, intent(in) :: calc_clean_atm_diag ! Control for clean air diagnositic calls for WRF-Chem ! ----- Output ----- @@ -10796,6 +10910,10 @@ subroutine rrtmg_lw & ! Dimensions: (ncol,nlay+1) real(kind=rb), intent(out) :: hrc(:,:) ! Clear sky longwave radiative heating rate (K/d) ! Dimensions: (ncol,nlay) + real(kind=rb), intent(out) :: uflxcln(:,:) ! Clean sky longwave upward flux (W/m2) + ! Dimensions: (ncol,nlay+1) + real(kind=rb), intent(out) :: dflxcln(:,:) ! Clean sky longwave downward flux (W/m2) + ! Dimensions: (ncol,nlay+1) ! ----- Local ----- @@ -10907,6 +11025,10 @@ subroutine rrtmg_lw & real(kind=rb) :: totdclfl(0:nlay+1) ! clear sky downward longwave flux (w/m2) real(kind=rb) :: fnetc(0:nlay+1) ! clear sky net longwave flux (w/m2) real(kind=rb) :: htrc(0:nlay+1) ! clear sky longwave heating rate (k/day) + real(kind=rb) :: totuclnlfl(0:nlay+1) ! clean sky upward longwave flux (w/m2) + real(kind=rb) :: totdclnlfl(0:nlay+1) ! clean sky downward longwave flux (w/m2) + real(kind=rb) :: fnetcln(0:nlay+1) ! clean sky net longwave flux (w/m2) + real(kind=rb) :: htrcln(0:nlay+1) ! clean sky longwave heating rate (k/day) ! ! Initializations @@ -10930,7 +11052,8 @@ subroutine rrtmg_lw & ! icld = 1, with clouds using random cloud overlap ! icld = 2, with clouds using maximum/random cloud overlap ! icld = 3, with clouds using maximum cloud overlap (McICA only) - if (icld.lt.0.or.icld.gt.3) icld = 2 +! icld = 4, with clouds using exponential cloud overlap (McICA only) +! icld = 5, with clouds using exponential/random cloud overlap (McICA only) ! Set iaer to select aerosol option ! iaer = 0, no aerosols @@ -11021,6 +11144,29 @@ subroutine rrtmg_lw & ! to be used. Clear sky calculation is done simultaneously. ! For McICA, RTRNMC is called for clear and cloudy calculations. +#if (WRF_CHEM == 1) + ! Call the radiative transfer routine for "clean" sky first, + ! passing taug rather than taut so we have no aerosol influence. + ! We will keep totuclnlfl, totdclnlfl, fnetcln, and htrcln, + ! and then overwrite the rest with the second call to rtrnmc. + if(calc_clean_atm_diag .gt. 0)then + call rtrnmc(nlayers, istart, iend, iout, pz, semiss, ncbands, & + cldfmc, taucmc, planklay, planklev, plankbnd, & + pwvcm, fracs, taug, & + totuclnlfl, totdclnlfl, fnetcln, htrcln, & + totuclfl, totdclfl, fnetc, htrc ) + else + do k = 0, nlayers + totuclnlfl(k) = 0.0 + totdclnlfl(k) = 0.0 + end do + end if +#else + do k = 0, nlayers + totuclnlfl(k) = 0.0 + totdclnlfl(k) = 0.0 + end do +#endif call rtrnmc(nlayers, istart, iend, iout, pz, semiss, ncbands, & cldfmc, taucmc, planklay, planklev, plankbnd, & pwvcm, fracs, taut, & @@ -11035,6 +11181,8 @@ subroutine rrtmg_lw & dflx(iplon,k+1) = totdflux(k) uflxc(iplon,k+1) = totuclfl(k) dflxc(iplon,k+1) = totdclfl(k) + uflxcln(iplon,k+1) = totuclnlfl(k) + dflxcln(iplon,k+1) = totdclnlfl(k) enddo do k = 0, nlayers-1 hr(iplon,k+1) = htr(k) @@ -11388,56 +11536,9 @@ end module rrtmg_lw_rad !------------------------------------------------------------------ MODULE module_ra_rrtmg_lw - -#if defined(mpas) -!MPAS specific (Laura D. Fowler): use mpas_atmphys_constants,only : cp,g=>gravity use module_ra_rrtmg_vinterp,only: vinterp_ozn -!> add-ons and modifications to sourcecode: -!> ---------------------------------------- -!> * updated the sourcecode to WRF revision 3.5, except for the implementation -!> of time-varying trace gases: added multiple layers above the model-top -!> following Cavalo et al. (2010). added option to use the ozone climatology -!> from the CAM radiation codes. -!> Laura D. Fowler (birch.mmm.ucar.edu) / 2013-07-17. -!> * in subroutine taugb7, corrected line number 6145 "if (specparm .lt. 0.125_rb) then" -!> with if (specparm1 .lt. 0.125_rb) then, in accordance with the bug fix made in WRF -!> revision 3.7. -!> Laura D. Fowler (birch.mmm.ucar.edu) / 2015-05-04. -!> * at the bottom of subroutine rrtmg_lwrad, changed the definition of the arrays lwupt,lwuptc, -!> lwdnt,and lwdntc so that they are now defined at the top-of-the-atmosphere. -!> Laura D. Fowler (laura@ucar.edu) / 2016-06-23. -!> * cleaned-up the subroutine rrtmg_lwrad in preparation for the implementation of the calculation of the -!> cloud optical properties when the effective radii for cloud water, cloud ice, and snow are provided by -!> the cloud microphysics schemes (note that for now, only the Thompson cloud microphysics scheme has the -!> option to calculate cloud radii). With the -g option, results are exactly the same as the original -!> subroutine. -!> Laura D. Fowler (laura@ucar.edu) / 2016-06-30. -!> * updated module_ra_rrtmg_lw.F using module_ra_rrtmg_lw.F from WRF version 3.8, namely to update the -!> calculation of the cloud optical properties to include the radiative effect of snow. -!> Laura D. Fowler (laura@ucar.edu / 2016-07-05). -!> * added the effective radii for cloud water, cloud ice, and snow calculated in the Thompson cloud -!> microphysics scheme as inputs to the subroutine rrtmg_lwrad. revised the initialization of arrays rel, -!> rei, and res, accordingly. -!> Laura D. Fowler (laura@ucar.edu) / 2016-07-07. -!> * added diagnostics of the effective radii for cloud water, cloud ice, and snow used in rrtmg_lwrad. -!> Laura D. Fowler (laura@ucar.edu) / 2016-07-08. - -!MPAS specific end. - -#else -use module_model_constants, only : cp -use module_wrf_error -#define FATAL_ERROR(M) call wrf_error_fatal( M ) -#if (HWRF == 1) - USE module_state_description, ONLY : FER_MP_HIRES, FER_MP_HIRES_ADVECT, ETAMP_HWRF -#else - USE module_state_description, ONLY : FER_MP_HIRES, FER_MP_HIRES_ADVECT -#endif -!use module_dm -#endif - use parrrtm, only : nbndlw, ngptlw use rrtmg_lw_init, only: rrtmg_lw_ini use rrtmg_lw_rad, only: rrtmg_lw @@ -11463,10 +11564,8 @@ MODULE module_ra_rrtmg_lw 205.728, 214.055, 222.694, 231.661, 240.971, 250.639/ ! save retab -#if !defined(mpas) ! For buffer layer adjustment. Steven Cavallo, Dec 2010. integer , save :: nlayers -#endif real, PARAMETER :: deltap = 4. ! Pressure interval for buffer layer in mb CONTAINS @@ -11475,7 +11574,8 @@ MODULE module_ra_rrtmg_lw subroutine rrtmg_lwrad( & p3d,p8w,pi3d,t3d,t8w,dz8w,qv3d,qc3d,qr3d, & qi3d,qs3d,qg3d,cldfra3d,o33d,tsk,emiss, & - xland,xice,snow,icloud,o3input,noznlevels, & + xland,xice,snow,xlat,julday,icloud, & + cldovrlp,idcor,o3input,noznlevels, & pin,o3clim,glw,olr,lwcf,rthratenlw, & has_reqc,has_reqi,has_reqs,re_cloud, & re_ice,re_snow,rre_cloud,rre_ice,rre_snow, & @@ -11495,10 +11595,13 @@ subroutine rrtmg_lwrad( & integer,intent(in):: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte - integer,intent(in):: icloud,has_reqc,has_reqi,has_reqs + integer,intent(in):: julday + integer,intent(in):: icloud,cldovrlp,idcor + integer,intent(in):: has_reqc,has_reqi,has_reqs integer,intent(in),optional:: o3input - real,intent(in),dimension(ims:ime,jms:jme):: emiss,tsk,snow,xice,xland + real,intent(in),dimension(ims:ime,jms:jme):: emiss,tsk,snow,xice,xland,xlat + real,intent(in),dimension(ims:ime,kms:kme,jms:jme):: t3d,p3d,pi3d real,intent(in),dimension(ims:ime,kms:kme,jms:jme):: dz8w,p8w,t8w @@ -11525,6 +11628,7 @@ subroutine rrtmg_lwrad( & lwupflx,lwupflxc,lwdnflx,lwdnflxc !local variables and arrays: + integer:: calc_clean_atm_diag integer:: nb,ncol,nlay,icld,inflglw,iceflglw,liqflglw integer:: iplon,irng,permuteseed integer:: pcols,pver @@ -11535,6 +11639,7 @@ subroutine rrtmg_lwrad( & real:: corr real:: gliqwp,gicewp,gsnowp,gravmks real:: snow_mass_factor + real:: dzsum,lat real,dimension(1):: tsfc,landfrac,landm,snowh,icefrac real,dimension(1,1:kte-kts+1):: pdel,cliqwp,cicewp,csnowp,reliq,reice,resnow real,dimension(1,nbndlw):: emis @@ -11549,9 +11654,10 @@ subroutine rrtmg_lwrad( & real,dimension(:),allocatable:: o3mmr,varint real,dimension(:,:),allocatable:: & - plev,tlev,play,tlay,h2ovmr,o3vmr,co2vmr,o2vmr,ch4vmr,n2ovmr,cfc11vmr, & + plev,tlev,play,hlay,tlay,h2ovmr,o3vmr,co2vmr,o2vmr,ch4vmr,n2ovmr,cfc11vmr, & cfc12vmr,cfc22vmr,ccl4vmr,clwpth,ciwpth,cswpth,rel,rei,res,cldfrac,relqmcl,reicmcl,resnmcl real,dimension(:,:),allocatable:: uflx,dflx,uflxc,dflxc,hr,hrc + real,dimension(:,:),allocatable:: uflxcln,dflxcln real,dimension(:,:,:),allocatable:: taucld,cldfmcl,clwpmcl,ciwpmcl,cswpmcl,taucmcl,tauaer !--- additional local variables and arrays needed for the CAM ozone climatologyL @@ -11643,18 +11749,27 @@ subroutine rrtmg_lwrad( & !--- all fields are ordered vertically from bottom to top (pressures are in mb): ncol = 1 +!--- select cloud overlap asumption (1=random, 2=maximum-random, 3=maximum, 4=exponential, 5=exponential-random). +! assign namlist variable cldovrlp to existing icld: + icld = cldovrlp + !--- initialize option for the calculation of the cloud optical properties: - icld = 2 ! with clouds using maximum/random cloud overlap in subroutine mcica_subcol_lw. inflglw = 2 iceflglw = 3 liqflglw = 1 +!--- initialize option for the calculation of clean air upward and downward fluxes: + calc_clean_atm_diag = 0 + !--- latitude loop: j_loop: do j = jts,jte !--- longitude loop: i_loop: do i = its,ite + !--- initialize local latitude: + lat = xlat(i,j) + !--- set surface emissivity in each RRTMG longwave band: do nb = 1, nbndlw emis(ncol,nb) = emiss(i,j) @@ -11708,38 +11823,41 @@ subroutine rrtmg_lwrad( & mpas_nlay(i,j) = nlayers-kte ! write(0,101) j,i,kme,kte,nlayers,mpas_nlay(i,j),pw1d(kte+1),pw1d(kte+1)-mpas_nlay(i,j)*deltap ! 101 format(6i9,3(1x,f9.4)) - if(.not.allocated(o3mmr) ) allocate(o3mmr(kts:nlayers) ) - if(.not.allocated(varint) ) allocate(varint(kts:nlayers+1) ) - if(.not.allocated(plev) ) allocate(plev(1,kts:nlayers+1) ) - if(.not.allocated(tlev) ) allocate(tlev(1,kts:nlayers+1) ) - if(.not.allocated(play) ) allocate(play(1,kts:nlayers) ) - if(.not.allocated(tlay) ) allocate(tlay(1,kts:nlayers) ) - if(.not.allocated(h2ovmr) ) allocate(h2ovmr(1,kts:nlayers) ) - if(.not.allocated(o3vmr) ) allocate(o3vmr(1,kts:nlayers) ) - if(.not.allocated(co2vmr) ) allocate(co2vmr(1,kts:nlayers) ) - if(.not.allocated(o2vmr) ) allocate(o2vmr(1,kts:nlayers) ) - if(.not.allocated(ch4vmr) ) allocate(ch4vmr(1,kts:nlayers) ) - if(.not.allocated(n2ovmr) ) allocate(n2ovmr(1,kts:nlayers) ) - if(.not.allocated(cfc11vmr)) allocate(cfc11vmr(1,kts:nlayers)) - if(.not.allocated(cfc12vmr)) allocate(cfc12vmr(1,kts:nlayers)) - if(.not.allocated(cfc22vmr)) allocate(cfc22vmr(1,kts:nlayers)) - if(.not.allocated(ccl4vmr) ) allocate(ccl4vmr(1,kts:nlayers) ) - if(.not.allocated(clwpth) ) allocate(clwpth(1,kts:nlayers) ) - if(.not.allocated(ciwpth) ) allocate(ciwpth(1,kts:nlayers) ) - if(.not.allocated(cswpth) ) allocate(cswpth(1,kts:nlayers) ) - if(.not.allocated(rel) ) allocate(rel(1,kts:nlayers) ) - if(.not.allocated(rei) ) allocate(rei(1,kts:nlayers) ) - if(.not.allocated(res) ) allocate(res(1,kts:nlayers) ) - if(.not.allocated(cldfrac) ) allocate(cldfrac(1,kts:nlayers) ) - if(.not.allocated(relqmcl) ) allocate(relqmcl(1,kts:nlayers) ) - if(.not.allocated(reicmcl) ) allocate(reicmcl(1,kts:nlayers) ) - if(.not.allocated(resnmcl) ) allocate(resnmcl(1,kts:nlayers) ) - if(.not.allocated(uflx) ) allocate(uflx(1,kts:nlayers+1) ) - if(.not.allocated(dflx) ) allocate(dflx(1,kts:nlayers+1) ) - if(.not.allocated(uflxc) ) allocate(uflxc(1,kts:nlayers+1) ) - if(.not.allocated(dflxc) ) allocate(dflxc(1,kts:nlayers+1) ) - if(.not.allocated(hr) ) allocate(hr(1,kts:nlayers) ) - if(.not.allocated(hrc) ) allocate(hrc(1,kts:nlayers) ) + if(.not.allocated(o3mmr) ) allocate(o3mmr(kts:nlayers) ) + if(.not.allocated(varint) ) allocate(varint(kts:nlayers+1) ) + if(.not.allocated(plev) ) allocate(plev(1,kts:nlayers+1) ) + if(.not.allocated(tlev) ) allocate(tlev(1,kts:nlayers+1) ) + if(.not.allocated(play) ) allocate(play(1,kts:nlayers) ) + if(.not.allocated(hlay) ) allocate(hlay(1,kts:nlayers) ) + if(.not.allocated(tlay) ) allocate(tlay(1,kts:nlayers) ) + if(.not.allocated(h2ovmr) ) allocate(h2ovmr(1,kts:nlayers) ) + if(.not.allocated(o3vmr) ) allocate(o3vmr(1,kts:nlayers) ) + if(.not.allocated(co2vmr) ) allocate(co2vmr(1,kts:nlayers) ) + if(.not.allocated(o2vmr) ) allocate(o2vmr(1,kts:nlayers) ) + if(.not.allocated(ch4vmr) ) allocate(ch4vmr(1,kts:nlayers) ) + if(.not.allocated(n2ovmr) ) allocate(n2ovmr(1,kts:nlayers) ) + if(.not.allocated(cfc11vmr)) allocate(cfc11vmr(1,kts:nlayers) ) + if(.not.allocated(cfc12vmr)) allocate(cfc12vmr(1,kts:nlayers) ) + if(.not.allocated(cfc22vmr)) allocate(cfc22vmr(1,kts:nlayers) ) + if(.not.allocated(ccl4vmr) ) allocate(ccl4vmr(1,kts:nlayers) ) + if(.not.allocated(clwpth) ) allocate(clwpth(1,kts:nlayers) ) + if(.not.allocated(ciwpth) ) allocate(ciwpth(1,kts:nlayers) ) + if(.not.allocated(cswpth) ) allocate(cswpth(1,kts:nlayers) ) + if(.not.allocated(rel) ) allocate(rel(1,kts:nlayers) ) + if(.not.allocated(rei) ) allocate(rei(1,kts:nlayers) ) + if(.not.allocated(res) ) allocate(res(1,kts:nlayers) ) + if(.not.allocated(cldfrac) ) allocate(cldfrac(1,kts:nlayers) ) + if(.not.allocated(relqmcl) ) allocate(relqmcl(1,kts:nlayers) ) + if(.not.allocated(reicmcl) ) allocate(reicmcl(1,kts:nlayers) ) + if(.not.allocated(resnmcl) ) allocate(resnmcl(1,kts:nlayers) ) + if(.not.allocated(uflx) ) allocate(uflx(1,kts:nlayers+1) ) + if(.not.allocated(dflx) ) allocate(dflx(1,kts:nlayers+1) ) + if(.not.allocated(uflxc) ) allocate(uflxc(1,kts:nlayers+1) ) + if(.not.allocated(dflxc) ) allocate(dflxc(1,kts:nlayers+1) ) + if(.not.allocated(uflxcln) ) allocate(uflxcln(1,kts:nlayers+1)) + if(.not.allocated(dflxcln) ) allocate(dflxcln(1,kts:nlayers+1)) + if(.not.allocated(hr) ) allocate(hr(1,kts:nlayers) ) + if(.not.allocated(hrc) ) allocate(hrc(1,kts:nlayers) ) if(.not.allocated(taucld) ) allocate(taucld(nbndlw,1,kts:nlayers) ) if(.not.allocated(cldfmcl) ) allocate(cldfmcl(ngptlw,1,kts:nlayers)) if(.not.allocated(clwpmcl) ) allocate(clwpmcl(ngptlw,1,kts:nlayers)) @@ -11777,6 +11895,8 @@ subroutine rrtmg_lwrad( & uflxc(n,k) = 0. dflx(n,k) = 0. dflxc(n,k) = 0. + uflxcln(n,k) = 0. + dflxcln(n,k) = 0. hr(n,k) = 0. hrc(n,k) = 0. taucld(1:nbndlw,n,k) = 0. @@ -11787,10 +11907,12 @@ subroutine rrtmg_lwrad( & cswpmcl(1:ngptlw,n,k) = 0. taucmcl(1:ngptlw,n,k) = 0. enddo - uflx(n,nlayers+1) = 0. - uflxc(n,nlayers+1) = 0. - dflx(n,nlayers+1) = 0. - dflxc(n,nlayers+1) = 0. + uflx(n,nlayers+1) = 0. + uflxc(n,nlayers+1) = 0. + uflxcln(n,nlayers+1) = 0. + dflx(n,nlayers+1) = 0. + dflxc(n,nlayers+1) = 0. + dflxcln(n,nlayers+1) = 0. enddo !--- fill local arrays with input sounding. convert water vapor mass mixing ratio to volume mixing ratio: @@ -11814,6 +11936,19 @@ subroutine rrtmg_lwrad( & ccl4vmr(ncol,k) = ccl4 enddo + !--- compute height of each layer mid-point from layer thickness needed for icl=4 (exponential) and + ! icld=5 (exponential-random) overlap. fill in height array above model top using dz1d from top + ! layer: + dzsum = 0. + do k = kts, kte + hlay(ncol,k) = dzsum + 0.5*dz1d(k) + dzsum = dzsum + dz1d(k) + enddo + do k = kte+1,nlayers + hlay(ncol,k) = dzsum + 0.5*dz1d(kte) + dzsum = dzsum + dz1d(kte) + enddo + !--- the sourcecode below follows Steven Cavallo's method to "fill" the atmospheric layers between the ! top of the model and the top of the atmosphere. check if the pressure at the top of the atmosphere ! is negative. if negative, set it to zero prior to the calculation of temperatures (tlev and tlay): @@ -11872,7 +12007,7 @@ subroutine rrtmg_lwrad( & cfc12vmr(ncol,k) = cfc12vmr(ncol,kte) cfc22vmr(ncol,k) = cfc22vmr(ncol,kte) ccl4vmr(ncol,k) = ccl4vmr(ncol,kte) - enddo + enddo !--- initialize the ozone voume mixing ratio: call inirad(o3mmr,plev,kts,nlayers-1) @@ -12038,7 +12173,7 @@ subroutine rrtmg_lwrad( & do nb = 1, nbndlw taucld(nb,ncol,k) = 0. enddo - enddo + enddo endif @@ -12050,8 +12185,8 @@ subroutine rrtmg_lwrad( & call mcica_subcol_lw & (iplon , ncol , nlay , icld , permuteseed , irng , play , & cldfrac , ciwpth , clwpth , cswpth , rei , rel , res , & - taucld , cldfmcl , ciwpmcl , clwpmcl , cswpmcl , reicmcl , relqmcl , & - resnmcl , taucmcl) + taucld , hlay , idcor , julday , lat , cldfmcl , ciwpmcl , & + clwpmcl , cswpmcl , reicmcl , relqmcl , resnmcl , taucmcl) !--- initialization of aerosol optical depths: do nb = 1, nbndlw @@ -12070,7 +12205,7 @@ subroutine rrtmg_lwrad( & emis , inflglw , iceflglw , liqflglw , cldfmcl , taucmcl , & ciwpmcl , clwpmcl , cswpmcl , reicmcl , relqmcl , resnmcl , & tauaer , uflx , dflx , hr , uflxc , dflxc , & - hrc) + hrc , uflxcln , dflxcln , calc_clean_atm_diag) @@ -12125,6 +12260,7 @@ subroutine rrtmg_lwrad( & if(allocated(plev) ) deallocate(plev ) if(allocated(tlev) ) deallocate(tlev ) if(allocated(play) ) deallocate(play ) + if(allocated(hlay) ) deallocate(hlay ) if(allocated(tlay) ) deallocate(tlay ) if(allocated(h2ovmr) ) deallocate(h2ovmr ) if(allocated(o3vmr) ) deallocate(o3vmr ) @@ -12150,6 +12286,8 @@ subroutine rrtmg_lwrad( & if(allocated(dflx) ) deallocate(dflx ) if(allocated(uflxc) ) deallocate(uflxc ) if(allocated(dflxc) ) deallocate(dflxc ) + if(allocated(uflxcln) ) deallocate(uflxcln ) + if(allocated(dflxcln) ) deallocate(dflxcln ) if(allocated(hr) ) deallocate(hr ) if(allocated(hrc) ) deallocate(hrc ) if(allocated(taucld) ) deallocate(taucld ) @@ -12305,1578 +12443,7 @@ SUBROUTINE O3DATA (O3PROF, Plev, kts, kte) ! END SUBROUTINE O3DATA -!------------------------------------------------------------------ - -!LDF (2013-03-15): This section of the module is moved to module_physics_rrtmg_lwinit.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 of the longwave radiation code. Initialization is handled the same way -!for the shortwave radiation code. - -#if !defined(mpas) - -!==================================================================== - SUBROUTINE rrtmg_lwinit( & - p_top, allowed_to_read , & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) -!-------------------------------------------------------------------- - IMPLICIT NONE -!-------------------------------------------------------------------- - - LOGICAL , INTENT(IN) :: allowed_to_read - INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - REAL, INTENT(IN) :: p_top - -! Steven Cavallo. Added for buffer layer adjustment. December 2010. - NLAYERS = kme + nint(p_top*0.01/deltap)- 1 ! Model levels plus new levels. - ! nlayers will subsequently - ! replace kte+1 - -! Read in absorption coefficients and other data - IF ( allowed_to_read ) THEN - CALL rrtmg_lwlookuptable - ENDIF - -! Perform g-point reduction and other initializations -! Specific heat of dry air (cp) used in flux to heating rate conversion factor. - call rrtmg_lw_ini(cp) - - END SUBROUTINE rrtmg_lwinit - - -! ************************************************************************** - SUBROUTINE rrtmg_lwlookuptable -! ************************************************************************** - -IMPLICIT NONE - -! Local - INTEGER :: i - LOGICAL :: opened - LOGICAL , EXTERNAL :: wrf_dm_on_monitor - - CHARACTER*80 errmess - INTEGER rrtmg_unit - - IF ( wrf_dm_on_monitor() ) THEN - DO i = 10,99 - INQUIRE ( i , OPENED = opened ) - IF ( .NOT. opened ) THEN - rrtmg_unit = i - GOTO 2010 - ENDIF - ENDDO - rrtmg_unit = -1 - 2010 CONTINUE - ENDIF - CALL wrf_dm_bcast_bytes ( rrtmg_unit , IWORDSIZE ) - IF ( rrtmg_unit < 0 ) THEN - CALL wrf_error_fatal ( 'module_ra_rrtmg_lw: rrtm_lwlookuptable: Can not '// & - 'find unused fortran unit to read in lookup table.' ) - ENDIF - - IF ( wrf_dm_on_monitor() ) THEN - OPEN(rrtmg_unit,FILE='RRTMG_LW_DATA', & - FORM='UNFORMATTED',STATUS='OLD',ERR=9009) - ENDIF - - call lw_kgb01(rrtmg_unit) - call lw_kgb02(rrtmg_unit) - call lw_kgb03(rrtmg_unit) - call lw_kgb04(rrtmg_unit) - call lw_kgb05(rrtmg_unit) - call lw_kgb06(rrtmg_unit) - call lw_kgb07(rrtmg_unit) - call lw_kgb08(rrtmg_unit) - call lw_kgb09(rrtmg_unit) - call lw_kgb10(rrtmg_unit) - call lw_kgb11(rrtmg_unit) - call lw_kgb12(rrtmg_unit) - call lw_kgb13(rrtmg_unit) - call lw_kgb14(rrtmg_unit) - call lw_kgb15(rrtmg_unit) - call lw_kgb16(rrtmg_unit) - - IF ( wrf_dm_on_monitor() ) CLOSE (rrtmg_unit) - - RETURN -9009 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_lw: error opening RRTMG_LW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - END SUBROUTINE rrtmg_lwlookuptable - -! ************************************************************************** -! RRTMG Longwave Radiative Transfer Model -! Atmospheric and Environmental Research, Inc., Cambridge, MA -! -! Original version: E. J. Mlawer, et al. -! Revision for GCMs: Michael J. Iacono; October, 2002 -! Revision for F90 formatting: Michael J. Iacono; June 2006 -! -! This file contains 16 READ statements that include the -! absorption coefficients and other data for each of the 16 longwave -! spectral bands used in RRTMG_LW. Here, the data are defined for 16 -! g-points, or sub-intervals, per band. These data are combined and -! weighted using a mapping procedure in module RRTMG_LW_INIT to reduce -! the total number of g-points from 256 to 140 for use in the GCM. -! ************************************************************************** - -! ************************************************************************** - subroutine lw_kgb01(rrtmg_unit) -! ************************************************************************** - - use rrlw_kg01, only : fracrefao, fracrefbo, kao, kbo, kao_mn2, kbo_mn2, & - absa, absb, & - selfrefo, forrefo - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Arrays fracrefao and fracrefbo are the Planck fractions for the lower -! and upper atmosphere. -! Planck fraction mapping levels: P = 212.7250 mbar, T = 223.06 K - -! The array KAO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels > ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the corresponding TREF for this pressure level, -! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, -! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second -! index, JP, runs from 1 to 13 and refers to the corresponding -! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). -! The third index, IG, goes from 1 to 16, and tells us which -! g-interval the absorption coefficients are for. - -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. -! The second index, JP, runs from 13 to 59 and refers to the JPth -! reference pressure level (see taumol.f for the value of these -! pressure levels in mb). The third index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The arrays kao_mn2 and kbo_mn2 contain the coefficients of the -! nitrogen continuum for the upper and lower atmosphere. -! Minor gas mapping levels: -! Lower - n2: P = 142.5490 mbar, T = 215.70 K -! Upper - n2: P = 142.5490 mbar, T = 215.70 K - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - fracrefao, fracrefbo, kao, kbo, kao_mn2, kbo_mn2, selfrefo, forrefo - DM_BCAST_MACRO(fracrefao) - DM_BCAST_MACRO(fracrefbo) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kbo) - DM_BCAST_MACRO(kao_mn2) - DM_BCAST_MACRO(kbo_mn2) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_lw: error reading RRTMG_LW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine lw_kgb01 - -! ************************************************************************** - subroutine lw_kgb02(rrtmg_unit) -! ************************************************************************** - - use rrlw_kg02, only : fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Arrays fracrefao and fracrefbo are the Planck fractions for the lower -! and upper atmosphere. -! Planck fraction mapping levels: -! Lower: P = 1053.630 mbar, T = 294.2 K -! Upper: P = 3.206e-2 mb, T = 197.92 K - -! The array KAO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels > ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the corresponding TREF for this pressure level, -! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, -! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second -! index, JP, runs from 1 to 13 and refers to the corresponding -! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). -! The third index, IG, goes from 1 to 16, and tells us which -! g-interval the absorption coefficients are for. - -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. -! The second index, JP, runs from 13 to 59 and refers to the JPth -! reference pressure level (see taumol.f for the value of these -! pressure levels in mb). The third index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo - DM_BCAST_MACRO(fracrefao) - DM_BCAST_MACRO(fracrefbo) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kbo) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_lw: error reading RRTMG_LW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine lw_kgb02 - -! ************************************************************************** - subroutine lw_kgb03(rrtmg_unit) -! ************************************************************************** - - use rrlw_kg03, only : fracrefao, fracrefbo, kao, kbo, kao_mn2o, & - kbo_mn2o, selfrefo, forrefo - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Arrays fracrefao and fracrefbo are the Planck fractions for the lower -! and upper atmosphere. -! Planck fraction mapping levels: -! Lower: P = 212.7250 mbar, T = 223.06 K -! Upper: P = 95.8 mbar, T = 215.7 k - -! The array KAO contains absorption coefs for each of the 16 g-intervals -! for a range of pressure levels > ~100mb, temperatures, and ratios -! of water vapor to CO2. The first index in the array, JS, runs -! from 1 to 10, and corresponds to different gas column amount ratios, -! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 -! to that of gas2. -! The 2nd index in the array, JT, which runs from 1 to 5, corresponds -! to different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature -! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 -! is for TREF+30. The third index, JP, runs from 1 to 13 and refers -! to the reference pressure level (e.g. JP = 1 is for a -! pressure of 1053.63 mb). The fourth index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. -! The second index, JP, runs from 13 to 59 and refers to the JPth -! reference pressure level (see taumol.f for the value of these -! pressure levels in mb). The third index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. -! The 2nd index in the array, JT, which runs from 1 to 5, corresponds -! to different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature -! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 -! is for TREF+30. The third index, JP, runs from 1 to 13 and refers -! to the reference pressure level (e.g. JP = 1 is for a -! pressure of 1053.63 mb). The fourth index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array KAO_Mxx contains the absorption coefficient for -! a minor species at the 16 chosen g-values for a reference pressure -! level below 100~ mb. The first index in the array, JS, runs -! from 1 to 10, and corresponds to different gas column amount ratios, -! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 -! to that of gas2. The second index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index -! runs over the g-channel (1 to 16). - -! The array KBO_Mxx contains the absorption coefficient for -! a minor species at the 16 chosen g-values for a reference pressure -! level above 100~ mb. The first index in the array, JS, runs -! from 1 to 10, and corresponds to different gas column amounts ratios, -! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 to -! that of gas2. The second index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index -! runs over the g-channel (1 to 16). - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - fracrefao, fracrefbo, kao, kbo, kao_mn2o, kbo_mn2o, selfrefo, forrefo - DM_BCAST_MACRO(fracrefao) - DM_BCAST_MACRO(fracrefbo) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kbo) - DM_BCAST_MACRO(kao_mn2o) - DM_BCAST_MACRO(kbo_mn2o) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_lw: error reading RRTMG_LW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine lw_kgb03 - -! ************************************************************************** - subroutine lw_kgb04(rrtmg_unit) -! ************************************************************************** - - use rrlw_kg04, only : fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Arrays fracrefao and fracrefbo are the Planck fractions for the lower -! and upper atmosphere. -! Planck fraction mapping levels: -! Lower : P = 142.5940 mbar, T = 215.70 K -! Upper : P = 95.58350 mb, T = 215.70 K - -! The array KAO contains absorption coefs for each of the 16 g-intervals -! for a range of pressure levels > ~100mb, temperatures, and ratios -! of water vapor to CO2. The first index in the array, JS, runs -! from 1 to 10, and corresponds to different gas column amount ratios, -! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 -! to that of gas2. -! The 2nd index in the array, JT, which runs from 1 to 5, corresponds -! to different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature -! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 -! is for TREF+30. The third index, JP, runs from 1 to 13 and refers -! to the reference pressure level (e.g. JP = 1 is for a -! pressure of 1053.63 mb). The fourth index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array KBO contains absorption coefs for each of the 16 g-intervals -! for a range of pressure levels < ~100mb, temperatures, and ratios -! of H2O to CO2. The first index in the array, JS, runs -! from 1 to 10, and corresponds to different gas column amount ratios, -! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 -! to that of gas2. The second index, JT, which -! runs from 1 to 5, corresponds to different temperatures. More -! specifically, JT = 3 means that the data are for the corresponding -! reference temperature TREF for this pressure level, JT = 2 refers -! to the TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and -! JT = 5 is for TREF+30. The third index, JP, runs from 13 to 59 and -! refers to the corresponding pressure level in PREF (e.g. JP = 13 is -! for a pressure of 95.5835 mb). The fourth index, IG, goes from 1 to -! 16, and tells us which g-interval the absorption coefficients are for. - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo - DM_BCAST_MACRO(fracrefao) - DM_BCAST_MACRO(fracrefbo) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kbo) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_lw: error reading RRTMG_LW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine lw_kgb04 - -! ************************************************************************** - subroutine lw_kgb05(rrtmg_unit) -! ************************************************************************** - - use rrlw_kg05, only : fracrefao, fracrefbo, kao, kbo, kao_mo3, & - selfrefo, forrefo, ccl4o - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Arrays fracrefao and fracrefbo are the Planck fractions for the lower -! and upper atmosphere. -! Planck fraction mapping levels: -! Lower: P = 473.42 mb, T = 259.83 -! Upper: P = 0.2369280 mbar, T = 253.60 K - -! The arrays kao_mo3 and ccl4o contain the coefficients for -! ozone and ccl4 in the lower atmosphere. -! Minor gas mapping level: -! Lower - o3: P = 317.34 mbar, T = 240.77 k -! Lower - ccl4: - -! The array KAO contains absorption coefs for each of the 16 g-intervals -! for a range of pressure levels > ~100mb, temperatures, and ratios -! of water vapor to CO2. The first index in the array, JS, runs -! from 1 to 10, and corresponds to different gas column amount ratios, -! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 -! to that of gas2. -! The 2nd index in the array, JT, which runs from 1 to 5, corresponds -! to different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature -! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 -! is for TREF+30. The third index, JP, runs from 1 to 13 and refers -! to the reference pressure level (e.g. JP = 1 is for a -! pressure of 1053.63 mb). The fourth index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array KBO contains absorption coefs for each of the 16 g-intervals -! for a range of pressure levels < ~100mb, temperatures, and ratios -! of H2O to CO2. The first index in the array, JS, runs -! from 1 to 10, and corresponds to different gas column amount ratios, -! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 -! to that of gas2. The second index, JT, which -! runs from 1 to 5, corresponds to different temperatures. More -! specifically, JT = 3 means that the data are for the corresponding -! reference temperature TREF for this pressure level, JT = 2 refers -! to the TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and -! JT = 5 is for TREF+30. The third index, JP, runs from 13 to 59 and -! refers to the corresponding pressure level in PREF (e.g. JP = 13 is -! for a pressure of 95.5835 mb). The fourth index, IG, goes from 1 to -! 16, and tells us which g-interval the absorption coefficients are for. - -! The array KAO_Mxx contains the absorption coefficient for -! a minor species at the 16 chosen g-values for a reference pressure -! level below 100~ mb. The first index in the array, JS, runs -! from 1 to 10, and corresponds to different gas column amount ratios, -! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 -! to that of gas2. The second index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index -! runs over the g-channel (1 to 16). - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - fracrefao, fracrefbo, kao, kbo, kao_mo3, ccl4o, selfrefo, forrefo - DM_BCAST_MACRO(fracrefao) - DM_BCAST_MACRO(fracrefbo) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kbo) - DM_BCAST_MACRO(kao_mo3) - DM_BCAST_MACRO(ccl4o) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_lw: error reading RRTMG_LW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine lw_kgb05 - -! ************************************************************************** - subroutine lw_kgb06(rrtmg_unit) -! ************************************************************************** - - use rrlw_kg06, only : fracrefao, kao, kao_mco2, selfrefo, forrefo, & - cfc11adjo, cfc12o - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Arrays fracrefao and fracrefbo are the Planck fractions for the lower -! and upper atmosphere. -! Planck fraction mapping levels: -! Lower: : P = 473.4280 mb, T = 259.83 K - -! The arrays kao_mco2, cfc11adjo and cfc12o contain the coefficients for -! carbon dioxide in the lower atmosphere and cfc11 and cfc12 in the upper -! atmosphere. -! Original cfc11 is multiplied by 1.385 to account for the 1060-1107 cm-1 band. -! Minor gas mapping level: -! Lower - co2: P = 706.2720 mb, T = 294.2 k -! Upper - cfc11, cfc12 - -! The array KAO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels > ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the corresponding TREF for this pressure level, -! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, -! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second -! index, JP, runs from 1 to 13 and refers to the corresponding -! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). -! The third index, IG, goes from 1 to 16, and tells us which -! g-interval the absorption coefficients are for. - -! The array KAO_Mxx contains the absorption coefficient for -! a minor species at the 16 chosen g-values for a reference pressure -! level below 100~ mb. The first index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index -! runs over the g-channel (1 to 16). - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - fracrefao, kao, kao_mco2, cfc11adjo, cfc12o, selfrefo, forrefo - DM_BCAST_MACRO(fracrefao) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kao_mco2) - DM_BCAST_MACRO(cfc11adjo) - DM_BCAST_MACRO(cfc12o) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_lw: error reading RRTMG_LW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine lw_kgb06 - -! ************************************************************************** - subroutine lw_kgb07(rrtmg_unit) -! ************************************************************************** - - use rrlw_kg07, only : fracrefao, fracrefbo, kao, kbo, kao_mco2, & - kbo_mco2, selfrefo, forrefo - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Arrays fracrefao and fracrefbo are the Planck fractions for the lower -! and upper atmosphere. -! Planck fraction mapping levels: -! Lower : P = 706.27 mb, T = 278.94 K -! Upper : P = 95.58 mbar, T= 215.70 K - -! The array KAO contains absorption coefs for each of the 16 g-intervals -! for a range of pressure levels > ~100mb, temperatures, and ratios -! of water vapor to CO2. The first index in the array, JS, runs -! from 1 to 10, and corresponds to different gas column amount ratios, -! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 -! to that of gas2. -! The 2nd index in the array, JT, which runs from 1 to 5, corresponds -! to different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature -! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 -! is for TREF+30. The third index, JP, runs from 1 to 13 and refers -! to the reference pressure level (e.g. JP = 1 is for a -! pressure of 1053.63 mb). The fourth index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. -! The second index, JP, runs from 13 to 59 and refers to the JPth -! reference pressure level (see taumol.f for the value of these -! pressure levels in mb). The third index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array KAO_Mxx contains the absorption coefficient for -! a minor species at the 16 chosen g-values for a reference pressure -! level below 100~ mb. The first index in the array, JS, runs -! from 1 to 10, and corresponds to different gas column amount ratios, -! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 -! to that of gas2. The second index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index -! runs over the g-channel (1 to 16). - -! The array KBO_Mxx contains the absorption coefficient for -! a minor species at the 16 chosen g-values for a reference pressure -! level above 100~ mb. The first index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index -! runs over the g-channel (1 to 16). - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296_rb,260_rb,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - fracrefao, fracrefbo, kao, kbo, kao_mco2, kbo_mco2, selfrefo, forrefo - DM_BCAST_MACRO(fracrefao) - DM_BCAST_MACRO(fracrefbo) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kbo) - DM_BCAST_MACRO(kao_mco2) - DM_BCAST_MACRO(kbo_mco2) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_lw: error reading RRTMG_LW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine lw_kgb07 - -! ************************************************************************** - subroutine lw_kgb08(rrtmg_unit) -! ************************************************************************** - - use rrlw_kg08, only : fracrefao, fracrefbo, kao, kao_mco2, kao_mn2o, & - kao_mo3, kbo, kbo_mco2, kbo_mn2o, selfrefo, forrefo, & - cfc12o, cfc22adjo - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Arrays fracrefao and fracrefbo are the Planck fractions for the lower -! and upper atmosphere. -! Planck fraction mapping levels: -! Lower: P=473.4280 mb, T = 259.83 K -! Upper: P=95.5835 mb, T= 215.7 K - -! The arrays kao_mco2, kbo_mco2, kao_mn2o, kbo_mn2o contain the coefficients for -! carbon dioxide and n2o in the lower and upper atmosphere. -! The array kao_mo3 contains the coefficients for ozone in the lower atmosphere, -! and arrays cfc12o and cfc12adjo contain the coefficients for cfc12 and cfc22. -! Original cfc22 is multiplied by 1.485 to account for the 780-850 cm-1 -! and 1290-1335 cm-1 bands. -! Minor gas mapping level: -! Lower - co2: P = 1053.63 mb, T = 294.2 k -! Lower - o3: P = 317.348 mb, T = 240.77 k -! Lower - n2o: P = 706.2720 mb, T= 278.94 k -! Lower - cfc12, cfc22 -! Upper - co2: P = 35.1632 mb, T = 223.28 k -! Upper - n2o: P = 8.716e-2 mb, T = 226.03 k - -! The array KAO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels > ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the corresponding TREF for this pressure level, -! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, -! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second -! index, JP, runs from 1 to 13 and refers to the corresponding -! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). -! The third index, IG, goes from 1 to 16, and tells us which -! g-interval the absorption coefficients are for. - -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. -! The second index, JP, runs from 13 to 59 and refers to the JPth -! reference pressure level (see taumol.f for the value of these -! pressure levels in mb). The third index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array KAO_Mxx contains the absorption coefficient for -! a minor species at the 16 chosen g-values for a reference pressure -! level below 100~ mb. The first index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index -! runs over the g-channel (1 to 16). - -! The array KBO_Mxx contains the absorption coefficient for -! a minor species at the 16 chosen g-values for a reference pressure -! level above 100~ mb. The first index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index -! runs over the g-channel (1 to 16). - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - fracrefao, fracrefbo, kao, kbo, kao_mco2, kbo_mco2, kao_mn2o, & - kbo_mn2o, kao_mo3, cfc12o, cfc22adjo, selfrefo, forrefo - DM_BCAST_MACRO(fracrefao) - DM_BCAST_MACRO(fracrefbo) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kbo) - DM_BCAST_MACRO(kao_mco2) - DM_BCAST_MACRO(kbo_mco2) - DM_BCAST_MACRO(kao_mn2o) - DM_BCAST_MACRO(kbo_mn2o) - DM_BCAST_MACRO(kao_mo3) - DM_BCAST_MACRO(cfc12o) - DM_BCAST_MACRO(cfc22adjo) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_lw: error reading RRTMG_LW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine lw_kgb08 - -! ************************************************************************** - subroutine lw_kgb09(rrtmg_unit) -! ************************************************************************** - - use rrlw_kg09, only : fracrefao, fracrefbo, kao, kbo, kao_mn2o, & - kbo_mn2o, selfrefo, forrefo - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Arrays fracrefao and fracrefbo are the Planck fractions for the lower -! and upper atmosphere. -! Planck fraction mapping levels: -! Lower: P=212.7250 mb, T = 223.06 K -! Upper: P=3.20e-2 mb, T = 197.92 k - -! The array KAO contains absorption coefs for each of the 16 g-intervals -! for a range of pressure levels > ~100mb, temperatures, and ratios -! of water vapor to CO2. The first index in the array, JS, runs -! from 1 to 10, and corresponds to different gas column amount ratios, -! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 -! to that of gas2. -! The 2nd index in the array, JT, which runs from 1 to 5, corresponds -! to different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature -! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 -! is for TREF+30. The third index, JP, runs from 1 to 13 and refers -! to the reference pressure level (e.g. JP = 1 is for a -! pressure of 1053.63 mb). The fourth index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. -! The second index, JP, runs from 13 to 59 and refers to the JPth -! reference pressure level (see taumol.f for the value of these -! pressure levels in mb). The third index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array KAO_Mxx contains the absorption coefficient for -! a minor species at the 16 chosen g-values for a reference pressure -! level below 100~ mb. The first index in the array, JS, runs -! from 1 to 10, and corresponds to different gas column amount ratios, -! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 -! to that of gas2. The second index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index -! runs over the g-channel (1 to 16). - -! The array KBO_Mxx contains the absorption coefficient for -! a minor species at the 16 chosen g-values for a reference pressure -! level above 100~ mb. The first index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index -! runs over the g-channel (1 to 16). - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - fracrefao, fracrefbo, kao, kbo, kao_mn2o, kbo_mn2o, selfrefo, forrefo - DM_BCAST_MACRO(fracrefao) - DM_BCAST_MACRO(fracrefbo) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kbo) - DM_BCAST_MACRO(kao_mn2o) - DM_BCAST_MACRO(kbo_mn2o) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_lw: error reading RRTMG_LW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine lw_kgb09 - -! ************************************************************************** - subroutine lw_kgb10(rrtmg_unit) -! ************************************************************************** - - use rrlw_kg10, only : fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Arrays fracrefao and fracrefbo are the Planck fractions for the lower -! and upper atmosphere. -! Planck fraction mapping levels: -! Lower: P = 212.7250 mb, T = 223.06 K -! Upper: P = 95.58350 mb, T = 215.70 K - -! The array KAO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels > ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the corresponding TREF for this pressure level, -! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, -! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second -! index, JP, runs from 1 to 13 and refers to the corresponding -! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). -! The third index, IG, goes from 1 to 16, and tells us which -! g-interval the absorption coefficients are for. - -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. -! The second index, JP, runs from 13 to 59 and refers to the JPth -! reference pressure level (see taumol.f for the value of these -! pressure levels in mb). The third index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo - DM_BCAST_MACRO(fracrefao) - DM_BCAST_MACRO(fracrefbo) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kbo) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_lw: error reading RRTMG_LW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine lw_kgb10 - -! ************************************************************************** - subroutine lw_kgb11(rrtmg_unit) -! ************************************************************************** - - use rrlw_kg11, only : fracrefao, fracrefbo, kao, kbo, kao_mo2, & - kbo_mo2, selfrefo, forrefo - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Arrays fracrefao and fracrefbo are the Planck fractions for the lower -! and upper atmosphere. -! Planck fraction mapping levels: -! Lower: P=1053.63 mb, T= 294.2 K -! Upper: P=0.353 mb, T = 262.11 K - -! The array KAO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels > ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the corresponding TREF for this pressure level, -! JT = 2 refers to the temperatureTREF-15, JT = 1 is for TREF-30, -! JT = 4 is for TREF+15, and JT = 5 is for TREF+30. The second -! index, JP, runs from 1 to 13 and refers to the corresponding -! pressure level in PREF (e.g. JP = 1 is for a pressure of 1053.63 mb). -! The third index, IG, goes from 1 to 16, and tells us which -! g-interval the absorption coefficients are for. - -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. -! The second index, JP, runs from 13 to 59 and refers to the JPth -! reference pressure level (see taumol.f for the value of these -! pressure levels in mb). The third index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array KAO_Mxx contains the absorption coefficient for -! a minor species at the 16 chosen g-values for a reference pressure -! level below 100~ mb. The first index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index -! runs over the g-channel (1 to 16). - -! The array KBO_Mxx contains the absorption coefficient for -! a minor species at the 16 chosen g-values for a reference pressure -! level above 100~ mb. The first index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index -! runs over the g-channel (1 to 16). - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - fracrefao, fracrefbo, kao, kbo, kao_mo2, kbo_mo2, selfrefo, forrefo - DM_BCAST_MACRO(fracrefao) - DM_BCAST_MACRO(fracrefbo) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kbo) - DM_BCAST_MACRO(kao_mo2) - DM_BCAST_MACRO(kbo_mo2) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_lw: error reading RRTMG_LW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine lw_kgb11 - -! ************************************************************************** - subroutine lw_kgb12(rrtmg_unit) -! ************************************************************************** - - use rrlw_kg12, only : fracrefao, kao, selfrefo, forrefo - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Arrays fracrefao and fracrefbo are the Planck fractions for the lower -! and upper atmosphere. -! Planck fraction mapping levels: -! Lower: P = 174.1640 mbar, T= 215.78 K - -! The array KAO contains absorption coefs for each of the 16 g-intervals -! for a range of pressure levels > ~100mb, temperatures, and ratios -! of water vapor to CO2. The first index in the array, JS, runs -! from 1 to 10, and corresponds to different gas column amount ratios, -! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 -! to that of gas2. -! The 2nd index in the array, JT, which runs from 1 to 5, corresponds -! to different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature -! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 -! is for TREF+30. The third index, JP, runs from 1 to 13 and refers -! to the reference pressure level (e.g. JP = 1 is for a -! pressure of 1053.63 mb). The fourth index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - fracrefao, kao, selfrefo, forrefo - DM_BCAST_MACRO(fracrefao) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_lw: error reading RRTMG_LW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine lw_kgb12 - -! ************************************************************************** - subroutine lw_kgb13(rrtmg_unit) -! ************************************************************************** - - use rrlw_kg13, only : fracrefao, fracrefbo, kao, kao_mco2, kao_mco, & - kbo_mo3, selfrefo, forrefo - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Arrays fracrefao and fracrefbo are the Planck fractions for the lower -! and upper atmosphere. -! Planck fraction mapping levels: -! Lower: P=473.4280 mb, T = 259.83 K -! Upper: P=4.758820 mb, T = 250.85 K - -! The array KAO contains absorption coefs for each of the 16 g-intervals -! for a range of pressure levels > ~100mb, temperatures, and ratios -! of water vapor to CO2. The first index in the array, JS, runs -! from 1 to 10, and corresponds to different gas column amount ratios, -! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 -! to that of gas2. -! The 2nd index in the array, JT, which runs from 1 to 5, corresponds -! to different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature -! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 -! is for TREF+30. The third index, JP, runs from 1 to 13 and refers -! to the reference pressure level (e.g. JP = 1 is for a -! pressure of 1053.63 mb). The fourth index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array KAO_Mxx contains the absorption coefficient for -! a minor species at the 16 chosen g-values for a reference pressure -! level below 100~ mb. The first index in the array, JS, runs -! from 1 to 10, and corresponds to different gas column amount ratios, -! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 -! to that of gas2. The second index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index -! runs over the g-channel (1 to 16). - -! The array KBO_Mxx contains the absorption coefficient for -! a minor species at the 16 chosen g-values for a reference pressure -! level above 100~ mb. The first index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The second index -! runs over the g-channel (1 to 16). - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - fracrefao, fracrefbo, kao, kao_mco2, kao_mco, kbo_mo3, selfrefo, forrefo - DM_BCAST_MACRO(fracrefao) - DM_BCAST_MACRO(fracrefbo) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kao_mco2) - DM_BCAST_MACRO(kao_mco) - DM_BCAST_MACRO(kbo_mo3) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_lw: error reading RRTMG_LW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine lw_kgb13 - -! ************************************************************************** - subroutine lw_kgb14(rrtmg_unit) -! ************************************************************************** - - use rrlw_kg14, only : fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Arrays fracrefao and fracrefbo are the Planck fractions for the lower -! and upper atmosphere. -! Planck fraction mapping levels: -! Lower: P = 142.5940 mb, T = 215.70 K -! Upper: P = 4.758820 mb, T = 250.85 K - -! The array KAO contains absorption coefs for each of the 16 g-intervals -! for a range of pressure levels > ~100mb, temperatures, and ratios -! of water vapor to CO2. The first index in the array, JS, runs -! from 1 to 10, and corresponds to different gas column amount ratios, -! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 -! to that of gas2. -! The 2nd index in the array, JT, which runs from 1 to 5, corresponds -! to different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature -! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 -! is for TREF+30. The third index, JP, runs from 1 to 13 and refers -! to the reference pressure level (e.g. JP = 1 is for a -! pressure of 1053.63 mb). The fourth index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. -! The second index, JP, runs from 13 to 59 and refers to the JPth -! reference pressure level (see taumol.f for the value of these -! pressure levels in mb). The third index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo - DM_BCAST_MACRO(fracrefao) - DM_BCAST_MACRO(fracrefbo) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kbo) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_lw: error reading RRTMG_LW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine lw_kgb14 - -! ************************************************************************** - subroutine lw_kgb15(rrtmg_unit) -! ************************************************************************** - - use rrlw_kg15, only : fracrefao, kao, kao_mn2, selfrefo, forrefo - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Arrays fracrefao and fracrefbo are the Planck fractions for the lower -! and upper atmosphere. -! Planck fraction mapping levels: -! Lower: P = 1053. mb, T = 294.2 K - -! The array KAO contains absorption coefs for each of the 16 g-intervals -! for a range of pressure levels > ~100mb, temperatures, and ratios -! of water vapor to CO2. The first index in the array, JS, runs -! from 1 to 10, and corresponds to different gas column amount ratios, -! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 -! to that of gas2. -! The 2nd index in the array, JT, which runs from 1 to 5, corresponds -! to different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature -! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 -! is for TREF+30. The third index, JP, runs from 1 to 13 and refers -! to the reference pressure level (e.g. JP = 1 is for a -! pressure of 1053.63 mb). The fourth index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array KA_Mxx contains the absorption coefficient for -! a minor species at the 16 chosen g-values for a reference pressure -! level below 100~ mb. The first index in the array, JS, runs -! from 1 to 10, and corresponds to different gas column amount ratios, -! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 -! to that of gas2. The second index refers to temperature -! in 7.2 degree increments. For instance, JT = 1 refers to a -! temperature of 188.0, JT = 2 refers to 195.2, etc. The third index -! runs over the g-channel (1 to 16). - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - fracrefao, kao, kao_mn2, selfrefo, forrefo - DM_BCAST_MACRO(fracrefao) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kao_mn2) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_lw: error reading RRTMG_LW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine lw_kgb15 - -! ************************************************************************** - subroutine lw_kgb16(rrtmg_unit) -! ************************************************************************** - - use rrlw_kg16, only : fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Arrays fracrefao and fracrefbo are the Planck fractions for the lower -! and upper atmosphere. -! Planck fraction mapping levels: -! Lower: P = 387.6100 mbar, T = 250.17 K -! Upper: P=95.58350 mb, T = 215.70 K - -! The array KAO contains absorption coefs for each of the 16 g-intervals -! for a range of pressure levels > ~100mb, temperatures, and ratios -! of water vapor to CO2. The first index in the array, JS, runs -! from 1 to 10, and corresponds to different gas column amount ratios, -! as expressed through the binary species parameter eta, defined as -! eta = gas1/(gas1 + (rat) * gas2), where rat is the -! ratio of the reference MLS column amount value of gas 1 -! to that of gas2. -! The 2nd index in the array, JT, which runs from 1 to 5, corresponds -! to different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature -! TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 -! is for TREF+30. The third index, JP, runs from 1 to 13 and refers -! to the reference pressure level (e.g. JP = 1 is for a -! pressure of 1053.63 mb). The fourth index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. -! The second index, JP, runs from 13 to 59 and refers to the JPth -! reference pressure level (see taumol.f for the value of these -! pressure levels in mb). The third index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - fracrefao, fracrefbo, kao, kbo, selfrefo, forrefo - DM_BCAST_MACRO(fracrefao) - DM_BCAST_MACRO(fracrefbo) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kbo) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_lw: error reading RRTMG_LW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine lw_kgb16 - -#endif -!ldf end (2013-03-15). - -!=============================================================================== +!----------------------------------------------------------------------- subroutine relcalc(ncol, pcols, pver, t, landfrac, landm, icefrac, rel, snowh) !----------------------------------------------------------------------- ! @@ -13958,7 +12525,7 @@ subroutine reicalc(ncol, pcols, pver, t, re) index = int(t(i,k)-179.) index = min(max(index,1),94) corr = t(i,k) - int(t(i,k)) - re(i,k) = retab(index)*(1.-corr) & + re(i,k) = retab(index)*(1.-corr) & +retab(index+1)*corr ! re(i,k) = amax1(amin1(re(i,k),30.),10.) end do diff --git a/src/core_atmosphere/physics/physics_wrf/module_ra_rrtmg_sw.F b/src/core_atmosphere/physics/physics_wrf/module_ra_rrtmg_sw.F index be36c4afb..faa5761c9 100644 --- a/src/core_atmosphere/physics/physics_wrf/module_ra_rrtmg_sw.F +++ b/src/core_atmosphere/physics/physics_wrf/module_ra_rrtmg_sw.F @@ -1382,7 +1382,7 @@ module mcica_subcol_gen_sw use parkind, only : im => kind_im, rb => kind_rb use parrrsw, only : nbndsw, ngptsw - use rrsw_con, only: grav + use rrsw_con, only: grav, pi use rrsw_wvn, only: ngb use rrsw_vsn @@ -1397,8 +1397,12 @@ module mcica_subcol_gen_sw ! Public subroutines !------------------------------------------------------------------ +! mji - Add height needed for exponential and exponential-random cloud overlap methods +! (icld=4 and 5, respectively) along with idcor, juldat and lat used to specify +! the decorrelation length for these methods subroutine mcica_subcol_sw(iplon, ncol, nlay, icld, permuteseed, irng, play, & cldfrac, ciwp, clwp, cswp, rei, rel, res, tauc, ssac, asmc, fsfc, & + hgt, idcor, juldat, lat, & cldfmcl, ciwpmcl, clwpmcl, cswpmcl, reicmcl, relqmcl, resnmcl, & taucmcl, ssacmcl, asmcmcl, fsfcmcl) @@ -1419,7 +1423,9 @@ subroutine mcica_subcol_sw(iplon, ncol, nlay, icld, permuteseed, irng, play, & ! Atmosphere real(kind=rb), intent(in) :: play(:,:) ! layer pressures (mb) ! Dimensions: (ncol,nlay) - +! mji - Add height + real(kind=rb), intent(in) :: hgt(:,:) ! layer height (m) + ! Dimensions: (ncol,nlay) ! Atmosphere/clouds - cldprop real(kind=rb), intent(in) :: cldfrac(:,:) ! layer cloud fraction ! Dimensions: (ncol,nlay) @@ -1443,6 +1449,9 @@ subroutine mcica_subcol_sw(iplon, ncol, nlay, icld, permuteseed, irng, play, & ! Dimensions: (ncol,nlay) real(kind=rb), intent(in) :: res(:,:) ! cloud snow particle size ! Dimensions: (ncol,nlay) + integer(kind=im), intent(in) :: idcor ! Decorrelation length type + integer(kind=im), intent(in) :: juldat ! Julian date (day of year, 1-365) + real(kind=rb), intent(in) :: lat ! latitude (degrees, -90 to 90) ! ----- Output ----- ! Atmosphere/clouds - cldprmc [mcica] @@ -1480,12 +1489,17 @@ subroutine mcica_subcol_sw(iplon, ncol, nlay, icld, permuteseed, irng, play, & ! real(kind=rb) :: qi(ncol,nlay) ! ice water (specific humidity) ! real(kind=rb) :: ql(ncol,nlay) ! liq water (specific humidity) +! MJI - For latitude dependent decorrelation length + real(kind=rb), parameter :: am1 = 1.4315_rb + real(kind=rb), parameter :: am2 = 2.1219_rb + real(kind=rb), parameter :: am4 = -25.584_rb + real(kind=rb), parameter :: amr = 7._rb + real(kind=rb) :: am3 + real(kind=rb) :: decorr_len(ncol) ! decorrelation length (meters) + real(kind=rb), parameter :: Zo_default = 2500._rb ! default constant decorrelation length (m) -! Return if clear sky; or stop if icld out of range +! Return if clear sky if (icld.eq.0) return - if (icld.lt.0.or.icld.gt.3) then - stop 'MCICA_SUBCOL: INVALID ICLD' - endif ! NOTE: For GCM mode, permuteseed must be offset between LW and SW by at least number of subcolumns @@ -1513,9 +1527,29 @@ subroutine mcica_subcol_sw(iplon, ncol, nlay, icld, permuteseed, irng, play, & ! ql(ilev) = (clwp(ilev) * grav) / (pdel(ilev) * 1000._rb) ! enddo +! MJI - Latitude and day of year dependent decorrelation length + if (idcor .eq. 1) then +! Derive decorrelation length based on day of year and latitude (from NASA GMAO method) +! Result is in meters + if (juldat .gt. 181) then + am3 = -4._rb * amr / 365._rb * (juldat-272) + else + am3 = 4._rb * amr / 365._rb * (juldat-91) + endif +! Latitude in radians, decorrelation length in meters +! decorr_len(:) = ( am1 + am2 * exp(-(lat*180._rb/pi - am3)**2 / (am4*am4)) ) * 1.e3_rb +! Latitude in degrees, decorrelation length in meters + decorr_len(:) = ( am1 + am2 * exp(-(lat - am3)**2 / (am4*am4)) ) * 1.e3_rb + else +! Spatially and temporally constant decorrelation length + decorr_len(:) = Zo_default + endif + ! Generate the stochastic subcolumns of cloud optical properties for the shortwave; call generate_stochastic_clouds_sw (ncol, nlay, nsubcsw, icld, irng, pmid, cldfrac, clwp, ciwp, cswp, & - tauc, ssac, asmc, fsfc, cldfmcl, clwpmcl, ciwpmcl, cswpmcl, & + tauc, ssac, asmc, fsfc, & + hgt, decorr_len, & + cldfmcl, clwpmcl, ciwpmcl, cswpmcl, & taucmcl, ssacmcl, asmcmcl, fsfcmcl, permuteseed) end subroutine mcica_subcol_sw @@ -1523,7 +1557,9 @@ end subroutine mcica_subcol_sw !------------------------------------------------------------------------------------------------- subroutine generate_stochastic_clouds_sw(ncol, nlay, nsubcol, icld, irng, pmid, cld, clwp, ciwp, cswp, & - tauc, ssac, asmc, fsfc, cld_stoch, clwp_stoch, ciwp_stoch, cswp_stoch, & + tauc, ssac, asmc, fsfc, & + hgt, decorr_len, & + cld_stoch, clwp_stoch, ciwp_stoch, cswp_stoch, & tauc_stoch, ssac_stoch, asmc_stoch, fsfc_stoch, changeSeed) !------------------------------------------------------------------------------------------------- @@ -1602,6 +1638,8 @@ subroutine generate_stochastic_clouds_sw(ncol, nlay, nsubcol, icld, irng, pmid, ! Column state (cloud fraction, cloud water, cloud ice) + variables needed to read physics state real(kind=rb), intent(in) :: pmid(:,:) ! layer pressure (Pa) ! Dimensions: (ncol,nlay) + real(kind=rb), intent(in) :: hgt(:,:) ! layer height (m) + ! Dimensions: (ncol,nlay) real(kind=rb), intent(in) :: cld(:,:) ! cloud fraction ! Dimensions: (ncol,nlay) real(kind=rb), intent(in) :: clwp(:,:) ! in-cloud liquid water path (g/m2) @@ -1618,6 +1656,8 @@ subroutine generate_stochastic_clouds_sw(ncol, nlay, nsubcol, icld, irng, pmid, ! Dimensions: (nbndsw,ncol,nlay) real(kind=rb), intent(in) :: fsfc(:,:,:) ! in-cloud forward scattering fraction (non-delta scaled) ! Dimensions: (nbndsw,ncol,nlay) + real(kind=rb), intent(in) :: decorr_len(:) ! decorrelation length (meters) + ! Dimensions: (ncol) real(kind=rb), intent(out) :: cld_stoch(:,:,:) ! subcolumn cloud fraction ! Dimensions: (ngptsw,ncol,nlay) @@ -1650,11 +1690,11 @@ subroutine generate_stochastic_clouds_sw(ncol, nlay, nsubcol, icld, irng, pmid, ! real(kind=rb) :: mean_fsfc_stoch(ncol,nlay) ! cloud forward scattering fraction ! Set overlap - integer(kind=im) :: overlap ! 1 = random overlap, 2 = maximum/random, - ! 3 = maximum overlap, -! real(kind=rb), parameter :: Zo = 2500._rb ! length scale (m) -! real(kind=rb) :: zm(ncon,nlay) ! Height of midpoints (above surface) -! real(kind=rb), dimension(nlay) :: alpha=0.0_rb ! overlap parameter + integer(kind=im) :: overlap ! 1 = random overlap, 2 = maximum-random, + ! 3 = maximum overlap, 4 = exponential, + ! 5 = exponential-random + real(kind=rb) :: Zo_inv(ncol) ! inverse of decorrelation length scale (m) + real(kind=rb), dimension(ncol,nlay) :: alpha ! overlap parameter ! Constants (min value for cloud fraction and cloud water and ice) real(kind=rb), parameter :: cldmin = 1.0e-20_rb ! min cloud fraction @@ -1680,6 +1720,7 @@ subroutine generate_stochastic_clouds_sw(ncol, nlay, nsubcol, icld, irng, pmid, ! Pass input cloud overlap setting to local variable overlap = icld + Zo_inv(:) = 1._rb / decorr_len(:) ! Ensure that cloud fractions are in bounds do ilev = 1, nlay @@ -1801,39 +1842,106 @@ subroutine generate_stochastic_clouds_sw(ncol, nlay, nsubcol, icld, irng, pmid, enddo endif -! case(4) - inactive -! ! Exponential overlap: weighting between maximum and random overlap increases with the distance. -! ! The random numbers for exponential overlap verify: -! ! j=1 RAN(j)=RND1 -! ! j>1 if RND1 < alpha(j,j-1) => RAN(j) = RAN(j-1) -! ! RAN(j) = RND2 -! ! alpha is obtained from the equation -! ! alpha = exp(- (Zi-Zj-1)/Zo) where Zo is a characteristic length scale - - -! ! compute alpha -! zm = state%zm -! alpha(:, 1) = 0._rb -! do ilev = 2,nlay -! alpha(:, ilev) = exp( -( zm (:, ilev-1) - zm (:, ilev)) / Zo) -! end do +! mji - Activate exponential cloud overlap option + case(4) + ! Exponential overlap: transition from maximum to random cloud overlap increases + ! exponentially with layer thickness and distance through layers + ! j=1 RAN(j)=RND1 + ! j>1 if RND1 < alpha(j,j-1) => RAN(j) = RAN(j-1) + ! RAN(j) = RND2 + ! alpha is obtained from the equation + ! alpha = exp(-(Z(j)-Z(j-1))/Zo) where Zo is a characteristic length scale + + ! compute alpha + ! permute this loop + do i = 1, ncol + alpha(i, 1) = 0._rb + do ilev = 2,nlay + alpha(i, ilev) = exp( -(hgt(i,ilev) - hgt(i,ilev-1)) * Zo_inv(i)) + enddo + enddo + + ! generate 2 streams of random numbers + if (irng.eq.0) then + do isubcol = 1,nsubcol + do ilev = 1,nlay + call kissvec(seed1, seed2, seed3, seed4, rand_num) + CDF(isubcol, :, ilev) = rand_num + call kissvec(seed1, seed2, seed3, seed4, rand_num) + CDF2(isubcol, :, ilev) = rand_num + enddo + enddo + elseif (irng.eq.1) then + do isubcol = 1, nsubcol + do i = 1, ncol + do ilev = 1, nlay + rand_num_mt = getRandomReal(randomNumbers) + CDF(isubcol,i,ilev) = rand_num_mt + rand_num_mt = getRandomReal(randomNumbers) + CDF2(isubcol,i,ilev) = rand_num_mt + enddo + enddo + enddo + endif + + ! generate random numbers + do ilev = 2,nlay + where (CDF2(:, :, ilev) < spread(alpha (:,ilev), dim=1, nCopies=nsubcol) ) + CDF(:,:,ilev) = CDF(:,:,ilev-1) + end where + end do + +! mji - Exponential-random cloud overlap option + case(5) + ! Exponential_Random overlap: transition from maximum to random cloud overlap increases + ! exponentially with layer thickness and with distance through adjacent cloudy layers. + ! Non-adjacent blocks of clouds are treated randomly, and each block begins a new + ! exponential transition from maximum to random. + ! + ! compute alpha: bottom to top + ! - set alpha to 0 in bottom layer (no layer below for correlation) + do i = 1, ncol + alpha(i, 1) = 0._rb + do ilev = 2,nlay + alpha(i, ilev) = exp( -(hgt(i,ilev) - hgt(i,ilev-1) ) * Zo_inv(i)) + ! Decorrelate layers when clear layer follows a cloudy layer to enforce + ! random correlation between non-adjacent cloudy layers + if (cldf(i,ilev) .eq. 0.0_rb .and. cldf(i,ilev-1) .gt. 0.0_rb) then + alpha(i,ilev) = 0.0_rb + endif + end do + end do -! ! generate 2 streams of random numbers -! do isubcol = 1,nsubcol -! do ilev = 1,nlay -! call kissvec(seed1, seed2, seed3, seed4, rand_num) -! CDF(isubcol, :, ilev) = rand_num -! call kissvec(seed1, seed2, seed3, seed4, rand_num) -! CDF2(isubcol, :, ilev) = rand_num -! end do -! end do - -! ! generate random numbers -! do ilev = 2,nlay -! where (CDF2(:, :, ilev) < spread(alpha (:,ilev), dim=1, nCopies=nsubcol) ) -! CDF(:,:,ilev) = CDF(:,:,ilev-1) -! end where -! end do + ! generate 2 streams of random numbers + ! CDF2 is used to select which sub-columns are vertically correlated relative to alpha + ! CDF is used to select which sub-columns are treated as cloudy relative to cloud fraction + if (irng.eq.0) then + do isubcol = 1,nsubcol + do ilev = 1,nlay + call kissvec(seed1, seed2, seed3, seed4, rand_num) + CDF(isubcol, :, ilev) = rand_num + call kissvec(seed1, seed2, seed3, seed4, rand_num) + CDF2(isubcol, :, ilev) = rand_num + end do + end do + elseif (irng.eq.1) then + do isubcol = 1, nsubcol + do i = 1, ncol + do ilev = 1,nlay + rand_num_mt = getRandomReal(randomNumbers) + CDF(isubcol,i,ilev) = rand_num_mt + rand_num_mt = getRandomReal(randomNumbers) + CDF2(isubcol,i,ilev) = rand_num_mt + enddo + enddo + enddo + endif + ! generate vertical correlations in random number arrays - bottom to top + do ilev = 2,nlay + where (CDF2(:, :, ilev) < spread(alpha (:,ilev), dim=1, nCopies=nsubcol) ) + CDF(:,:,ilev) = CDF(:,:,ilev-1) + end where + end do end select @@ -1948,13 +2056,8 @@ end module mcica_subcol_gen_sw module rrtmg_sw_cldprmc -#if defined(mpas) use mpas_atmphys_utilities,only: physics_error_fatal #define FATAL_ERROR(M) call physics_error_fatal( M ) -#else -use module_wrf_error -#define FATAL_ERROR(M) call wrf_error_fatal( M ) -#endif ! -------------------------------------------------------------------------- ! | | @@ -2569,9 +2672,10 @@ subroutine reftra_sw(nlayers, lrtchk, pgg, prmuz, ptau, pw, & zgamma4= 1._rb - zgamma3 ! Recompute original s.s.a. to test for conservative solution - !Balwinder.Singh@pnnl.gov: Code added to avoid 'divide by zero' error in zwo computation - denom = max((1._rb - (1._rb - zw) * (zg / (1._rb - zg))**2),1.0E-30_rb) - zwo= zw / denom + zwo = 0._rb + denom = 1._rb + if (zg .ne. 1._rb) denom = (1._rb - (1._rb - zw) * (zg / (1._rb - zg))**2) + if (zw .gt. 0._rb .and. denom .ne. 0._rb) zwo = zw / denom if (zwo >= zwcrit) then ! Conservative scattering @@ -3284,6 +3388,10 @@ subroutine taumol_sw(nlayers, & !jm not thread safe hvrtau = '$Revision: 1.3 $' +! Initialize sfluxzen to 0.0 to prevent junk values when nlayers = laytrop + + sfluxzen(:) = 0.0 + ! Calculate gaseous optical depth and planck fractions for each spectral band. call taumol16 @@ -8501,27 +8609,36 @@ subroutine spcvmc_sw & zdbt_nodel(jk) = zclear*zdbtmc + zcloud*zdbtmo ztdbt_nodel(jk+1) = zdbt_nodel(jk) * ztdbt_nodel(jk) ! /\/\/\ Above code only needed for direct beam calculation + enddo - +! to vectorize the following loop + do jk=1, klev ! Delta scaling - clear zf = zgcc(jk) * zgcc(jk) zwf = zomcc(jk) * zf ztauc(jk) = (1.0_rb - zwf) * ztauc(jk) zomcc(jk) = (zomcc(jk) - zwf) / (1.0_rb - zwf) zgcc (jk) = (zgcc(jk) - zf) / (1.0_rb - zf) + enddo + ! Total sky optical parameters (cloud properties already delta-scaled) ! Use this code if cloud properties are derived in rrtmg_sw_cldprop if (icpr .ge. 1) then + do jk=1,klev + ikl=klev+1-jk ztauo(jk) = ztauc(jk) + ptaucmc(ikl,iw) zomco(jk) = ztauc(jk) * zomcc(jk) + ptaucmc(ikl,iw) * pomgcmc(ikl,iw) zgco (jk) = (ptaucmc(ikl,iw) * pomgcmc(ikl,iw) * pasycmc(ikl,iw) + & ztauc(jk) * zomcc(jk) * zgcc(jk)) / zomco(jk) zomco(jk) = zomco(jk) / ztauo(jk) + enddo ! Total sky optical parameters (if cloud properties not delta scaled) ! Use this code if cloud properties are not derived in rrtmg_sw_cldprop elseif (icpr .eq. 0) then + do jk=1,klev + ikl=klev+1-jk ztauo(jk) = ztaur(ikl,iw) + ztaug(ikl,iw) + ptaua(ikl,ibm) + ptaucmc(ikl,iw) zomco(jk) = ptaua(ikl,ibm) * pomga(ikl,ibm) + ptaucmc(ikl,iw) * pomgcmc(ikl,iw) + & ztaur(ikl,iw) * 1.0_rb @@ -8536,10 +8653,10 @@ subroutine spcvmc_sw & ztauo(jk) = (1._rb - zwf) * ztauo(jk) zomco(jk) = (zomco(jk) - zwf) / (1.0_rb - zwf) zgco (jk) = (zgco(jk) - zf) / (1.0_rb - zf) + enddo endif ! End of layer loop - enddo ! Clear sky reflectivities call reftra_sw (klev, & @@ -8637,22 +8754,27 @@ subroutine spcvmc_sw & pbbcd(ikl) = pbbcd(ikl) + zincflx(iw)*zcd(jk,iw) pbbfddir(ikl) = pbbfddir(ikl) + zincflx(iw)*ztdbt_nodel(jk) pbbcddir(ikl) = pbbcddir(ikl) + zincflx(iw)*ztdbtc_nodel(jk) + enddo ! Accumulate direct fluxes for UV/visible bands if (ibm >= 10 .and. ibm <= 13) then + do jk=1,klev+1 + ikl=klev+2-jk puvcd(ikl) = puvcd(ikl) + zincflx(iw)*zcd(jk,iw) puvfd(ikl) = puvfd(ikl) + zincflx(iw)*zfd(jk,iw) puvcddir(ikl) = puvcddir(ikl) + zincflx(iw)*ztdbtc_nodel(jk) puvfddir(ikl) = puvfddir(ikl) + zincflx(iw)*ztdbt_nodel(jk) + enddo ! Accumulate direct fluxes for near-IR bands else if (ibm == 14 .or. ibm <= 9) then + do jk=1,klev+1 + ikl=klev+2-jk pnicd(ikl) = pnicd(ikl) + zincflx(iw)*zcd(jk,iw) pnifd(ikl) = pnifd(ikl) + zincflx(iw)*zfd(jk,iw) pnicddir(ikl) = pnicddir(ikl) + zincflx(iw)*ztdbtc_nodel(jk) pnifddir(ikl) = pnifddir(ikl) + zincflx(iw)*ztdbt_nodel(jk) - endif - enddo + endif ! End loop on jg, g-point interval enddo @@ -8752,12 +8874,14 @@ subroutine rrtmg_sw & taucmcl ,ssacmcl ,asmcmcl ,fsfcmcl , & ciwpmcl ,clwpmcl ,cswpmcl ,reicmcl ,relqmcl ,resnmcl, & tauaer ,ssaaer ,asmaer ,ecaer , & - swuflx ,swdflx ,swhr ,swuflxc ,swdflxc ,swhrc, aer_opt, & + swuflx ,swdflx ,swhr ,swuflxc ,swdflxc ,swhrc, swuflxcln ,swdflxcln , aer_opt, & ! --------- Add the following four compenants for ssib shortwave down radiation ---! ! ------------------- by Zhenxin 2011-06-20 --------------------------------! sibvisdir, sibvisdif, sibnirdir, sibnirdif, & ! ---------------------- End, Zhenxin 2011-06-20 --------------------------------! - swdkdir,swdkdif & ! jararias, 2013/08/10 + swdkdir,swdkdif, & ! jararias, 2013/08/10 + swdkdirc, & ! PAJ + calc_clean_atm_diag & ) @@ -8868,7 +8992,8 @@ subroutine rrtmg_sw & ! 1: Random ! 2: Maximum/random ! 3: Maximum - + ! 4: Exponential + ! 5: Exponential/random real(kind=rb), intent(in) :: play(:,:) ! Layer pressures (hPa, mb) ! Dimensions: (ncol,nlay) real(kind=rb), intent(in) :: plev(:,:) ! Interface pressures (hPa, mb) @@ -8955,6 +9080,7 @@ subroutine rrtmg_sw & real(kind=rb), intent(in) :: ecaer(:,:,:) ! Aerosol optical depth at 0.55 micron (iaer=6 only) ! Dimensions: (ncol,nlay,naerec) ! (non-delta scaled) + integer, intent(in) :: calc_clean_atm_diag! Control for clean air diagnositic calls for WRF-Chem ! ----- Output ----- @@ -8978,12 +9104,16 @@ subroutine rrtmg_sw & ! Dimensions: (ncol,nlay+1) real(kind=rb), intent(out) :: swhrc(:,:) ! Clear sky shortwave radiative heating rate (K/d) ! Dimensions: (ncol,nlay) + real(kind=rb), intent(out) :: swuflxcln(:,:) ! Clean sky shortwave upward flux (W/m2) + ! Dimensions: (ncol,nlay+1) + real(kind=rb), intent(out) :: swdflxcln(:,:) ! Clean sky shortwave downward flux (W/m2) + ! Dimensions: (ncol,nlay+1) integer, intent(in) :: aer_opt real(kind=rb), intent(out) :: & swdkdir(:,:), & ! Total shortwave downward direct flux (W/m2), Dimensions: (ncol,nlay) jararias, 2013/08/10 - swdkdif(:,:) ! Total shortwave downward diffuse flux (W/m2), Dimensions: (ncol,nlay) jararias, 2013/08/10 - + swdkdif(:,:), & ! Total shortwave downward diffuse flux (W/m2), Dimensions: (ncol,nlay) jararias, 2013/08/10 + swdkdirc(:,:) ! Total shortwave downward direct flux clear sky (W/m2), Dimensions: (ncol,nlay) @@ -9102,6 +9232,7 @@ subroutine rrtmg_sw & ! (first moment of phase function) real(kind=rb) :: zomgc(nlay+1,nbndsw) ! cloud single scattering albedo real(kind=rb) :: ztaua(nlay+1,nbndsw) ! total aerosol optical depth + real(kind=rb) :: ztauacln(nlay+1,nbndsw) ! dummy total aerosol optical depth for clean case (=zero) real(kind=rb) :: zasya(nlay+1,nbndsw) ! total aerosol asymmetry parameter real(kind=rb) :: zomga(nlay+1,nbndsw) ! total aerosol single scattering albedo @@ -9125,6 +9256,13 @@ subroutine rrtmg_sw & real(kind=rb) :: znicd(nlay+2) ! temporary clear sky near-IR downward shortwave flux (w/m2) real(kind=rb) :: znifddir(nlay+2) ! temporary near-IR downward direct shortwave flux (w/m2) real(kind=rb) :: znicddir(nlay+2) ! temporary clear sky near-IR downward direct shortwave flux (w/m2) + real(kind=rb) :: zbbclnu(nlay+2) ! temporary clean sky upward shortwave flux (w/m2) + real(kind=rb) :: zbbclnd(nlay+2) ! temporary clean sky downward shortwave flux (w/m2) + real(kind=rb) :: zbbclnddir(nlay+2) ! temporary clean sky downward direct shortwave flux (w/m2) + real(kind=rb) :: zuvclnd(nlay+2) ! temporary clean sky UV downward shortwave flux (w/m2) + real(kind=rb) :: zuvclnddir(nlay+2) ! temporary clean sky UV downward direct shortwave flux (w/m2) + real(kind=rb) :: zniclnd(nlay+2) ! temporary clean sky near-IR downward shortwave flux (w/m2) + real(kind=rb) :: zniclnddir(nlay+2) ! temporary clean sky near-IR downward direct shortwave flux (w/m2) ! Optional output fields real(kind=rb) :: swnflx(nlay+2) ! Total sky shortwave net flux (W/m2) @@ -9181,7 +9319,8 @@ subroutine rrtmg_sw & ! icld = 1, with clouds using random cloud overlap (McICA only) ! icld = 2, with clouds using maximum/random cloud overlap (McICA only) ! icld = 3, with clouds using maximum cloud overlap (McICA only) - if (icld.lt.0.or.icld.gt.3) icld = 2 +! icld = 4, with clouds using exponential cloud overlap (McICA only) +! icld = 5, with clouds using exponential/random cloud overlap (McICA only) ! Set iaer to select aerosol option ! iaer = 0, no aerosols @@ -9309,8 +9448,8 @@ subroutine rrtmg_sw & ! enddo ! enddo - do i = 1, nlayers - do ib = 1, nbndsw + do ib = 1, nbndsw + do i = 1, nlayers ztaua(i,ib) = 0._rb zasya(i,ib) = 0._rb zomga(i,ib) = 0._rb @@ -9333,9 +9472,10 @@ subroutine rrtmg_sw & ! IAER=10: Direct specification of aerosol optical properties from GCM elseif (iaer.eq.10) then - do i = 1 ,nlayers - do ib = 1 ,nbndsw + do ib = 1 ,nbndsw + do i = 1 ,nlayers ztaua(i,ib) = taua(i,ib) + ztauacln(i,ib) = 0.0 zasya(i,ib) = asma(i,ib) zomga(i,ib) = ssaa(i,ib) enddo @@ -9391,6 +9531,7 @@ subroutine rrtmg_sw & difdflux(i) = swdflx(iplon,i) - dirdflux(i) swdkdir(iplon,i) = dirdflux(i) ! all-sky direct flux jararias, 2013/08/10 swdkdif(iplon,i) = difdflux(i) ! all-sky diffuse flux jararias, 2013/08/10 + swdkdirc(iplon,i) = zbbcddir(i) ! PAJ: clear-sky direct flux ! UV/visible direct/diffuse fluxes dirdnuv(i) = zuvfddir(i) @@ -9423,9 +9564,61 @@ subroutine rrtmg_sw & swhrc(iplon,nlayers) = 0._rb swhr(iplon,nlayers) = 0._rb +#if (WRF_CHEM == 1) + ! Repeat call to 2-stream radiation model using "clean sky" + ! variables and aerosol tau set to 0 + if(calc_clean_atm_diag .gt. 0)then + do i=1,nlayers+1 + zbbcu(i) = 0._rb + zbbcd(i) = 0._rb + zbbclnu(i) = 0._rb + zbbclnd(i) = 0._rb + zbbcddir(i) = 0._rb + zbbclnddir(i) = 0._rb + zuvcd(i) = 0._rb + zuvclnd(i) = 0._rb + zuvcddir(i) = 0._rb + zuvclnddir(i) = 0._rb + znicd(i) = 0._rb + zniclnd(i) = 0._rb + znicddir(i) = 0._rb + zniclnddir(i) = 0._rb + enddo + + call spcvmc_sw & + (nlayers, istart, iend, icpr, iout, & + pavel, tavel, pz, tz, tbound, albdif, albdir, & + zcldfmc, ztaucmc, zasycmc, zomgcmc, ztaormc, & + ztauacln, zasya, zomga, cossza, coldry, wkl, adjflux, & + laytrop, layswtch, laylow, jp, jt, jt1, & + co2mult, colch4, colco2, colh2o, colmol, coln2o, colo2, colo3, & + fac00, fac01, fac10, fac11, & + selffac, selffrac, indself, forfac, forfrac, indfor, & + zbbclnd, zbbclnu, zbbcd, zbbcu, zuvclnd, zuvcd, zniclnd, znicd, & + zbbclnddir, zbbcddir, zuvclnddir, zuvcddir, zniclnddir, znicddir) + + do i = 1, nlayers+1 + swuflxcln(iplon,i) = zbbclnu(i) + swdflxcln(iplon,i) = zbbclnd(i) + enddo + else + do i = 1, nlayers+1 + swuflxcln(iplon,i) = 0.0 + swdflxcln(iplon,i) = 0.0 + enddo + end if + +#else + do i = 1, nlayers+1 + swuflxcln(iplon,i) = 0.0 + swdflxcln(iplon,i) = 0.0 + enddo + +#endif ! End longitude loop enddo + end subroutine rrtmg_sw !************************************************************************* @@ -9755,8 +9948,8 @@ subroutine inatm_sw (iplon, nlay, icld, iaer, & ! modify to reverse layer indexing here if necessary. if (iaer .ge. 1) then - do l = 1, nlayers - do ib = 1, nbndsw + do ib = 1, nbndsw + do l = 1, nlayers taua(l,ib) = tauaer(iplon,l,ib) ssaa(l,ib) = ssaaer(iplon,l,ib) asma(l,ib) = asmaer(iplon,l,ib) @@ -9815,44 +10008,9 @@ end module rrtmg_sw_rad !------------------------------------------------------------------ MODULE module_ra_rrtmg_sw - -#if defined(mpas) -!MPAS specific (Laura D. Fowler): use mpas_atmphys_constants,only : cp,g=>gravity use module_ra_rrtmg_vinterp,only: vinterp_ozn -!> add-ons and modifications to sourcecode: -!> ---------------------------------------- -!> * updated the sourcecode to WRF revision 3.5, except for the implementation -!> of time-varying trace gases: added option to use the ozone climatology -!> from the CAM radiation codes. -!> Laura D. Fowler (birch.mmm.ucar.edu) / 2013-07-08. -!> * cleaned-up the subroutine rrtmg_swrad in preparation for the implementation of the calculation of the -!> cloud optical properties when the effective radii for cloud water, cloud ice, and snow are provided by -!> the cloud microphysics schemes (note that for now, only the Thompson cloud microphysics scheme has the -!> option to calculate cloud radii). With the -g option, results are exactly the same as the original -!> subroutine. -!> Laura D. Fowler (laura@ucar.edu) / 2016-07-05. -!> * updated module_ra_rrtmg_sw.F using module_ra_rrtmg_sw.F from WRF version 3.8, namely to update the -!> calculation of the cloud optical properties to include the radiative effect of snow. -!> Laura D. Fowler (laura@ucar.edu / 2016-07-05). -!> * added the effective radii for cloud water, cloud ice, and snow calculated in the Thompson cloud -!> microphysics scheme as inputs to the subroutine rrtmg_swrad. revised the initialization of arrays rel, -!> rei, and res, accordingly. -!> Laura D. Fowler (laura@ucar.edu) / 2016-07-07. -!MPAS specfic end. - -#else -use module_model_constants,only : cp -USE module_wrf_error -#if (HWRF == 1) -USE module_state_description, ONLY : FER_MP_HIRES, FER_MP_HIRES_ADVECT, ETAMP_HWRF -#else -USE module_state_description, ONLY : FER_MP_HIRES, FER_MP_HIRES_ADVECT -#endif -!USE module_dm -#endif - use parrrsw, only : nbndsw, ngptsw, naerec use rrtmg_sw_init, only: rrtmg_sw_ini use rrtmg_sw_rad, only: rrtmg_sw @@ -9869,10 +10027,12 @@ subroutine rrtmg_swrad( & p3d,p8w,pi3d,t3d,t8w,dz8w,qv3d,qc3d,qr3d, & qi3d,qs3d,qg3d,cldfra3d,o33d,tsk,albedo, & xland,xice,snow,coszr,xtime,gmt,julday,radt, & - degrad,declin,solcon,xlat,xlong,icloud,o3input, & + degrad,declin,solcon,xlat,xlong,icloud, & + cldovrlp,idcor,o3input, & noznlevels,pin,o3clim,gsw,swcf,rthratensw, & has_reqc,has_reqi,has_reqs,re_cloud, & re_ice,re_snow, & + aer_opt,tauaer3d,ssaaer3d,asyaer3d, & swupt,swuptc,swdnt,swdntc, & swupb,swupbc,swdnb,swdnbc, & swupflx, swupflxc, swdnflx, swdnflxc, & @@ -9890,8 +10050,9 @@ subroutine rrtmg_swrad( & integer,intent(in):: ids,ide, jds,jde, kds,kde, & ims,ime, jms,jme, kms,kme, & its,ite, jts,jte, kts,kte - integer,intent(in):: icloud,has_reqc,has_reqi,has_reqs integer,intent(in):: julday + integer,intent(in):: icloud,cldovrlp,idcor + integer,intent(in):: has_reqc,has_reqi,has_reqs integer,intent(in),optional:: o3input real,intent(in):: radt,degrad,xtime,declin,solcon,gmt @@ -9909,6 +10070,12 @@ subroutine rrtmg_swrad( & real,intent(in),dimension(1:noznlevels),optional:: pin real,intent(in),dimension(ims:ime,1:noznlevels,jms:jme),optional:: o3clim +!--- additional input arguments of the aerosol optical depth, single scattering albedo, and asymmetry factor. to +! date, the only kind of aerosols included in MPAS are the "water-friendly" and "ice-friendly" aerosols used +! in the Thompson cloud microphysics scheme: + integer,intent(in),optional:: aer_opt + real,intent(in),dimension(ims:ime,kms:kme,jms:jme,1:nbndsw),optional:: tauaer3d,ssaaer3d,asyaer3d + !--- inout arguments: real,intent(inout),dimension(ims:ime,jms:jme):: coszr,gsw,swcf real,intent(inout),dimension(ims:ime,jms:jme),optional:: & @@ -9925,6 +10092,7 @@ subroutine rrtmg_swrad( & !local variables and arrays: logical:: dorrsw + integer:: calc_clean_atm_diag integer:: na,nb,ncol,nlay,icld,inflgsw,iceflgsw,liqflgsw integer:: dyofyr integer:: iplon,irng,permuteseed @@ -9937,6 +10105,7 @@ subroutine rrtmg_swrad( & real:: corr real:: gliqwp,gicewp,gsnowp,gravmks real:: snow_mass_factor + real:: dzsum,lat real,dimension(1):: tsfc,landfrac,landm,snowh,icefrac real,dimension(1):: asdir,asdif,aldir,aldif,coszen real,dimension(1,1:kte-kts+1):: pdel,cicewp,cliqwp,csnowp,reliq,reice,resnow @@ -9947,14 +10116,15 @@ subroutine rrtmg_swrad( & !--- additional local variables and arrays needed to include additional layers between the model top ! and the top of the atmosphere: - real,dimension(1,kts:kte+1):: play,tlay,h2ovmr,o3vmr,co2vmr,o2vmr,ch4vmr,n2ovmr + real,dimension(1,kts:kte+1):: play,hlay,tlay,h2ovmr,o3vmr,co2vmr,o2vmr,ch4vmr,n2ovmr real,dimension(1,kts:kte+1):: clwpth,ciwpth,cswpth,rel,rei,res,cldfrac,relqmcl,reicmcl,resnmcl real,dimension(1,kts:kte+1):: swhr,swhrc real,dimension(1,kts:kte+2):: plev,tlev real,dimension(1,kts:kte+2):: swuflx,swdflx,swuflxc,swdflxc + real,dimension(1,kts:kte+2):: swuflxcln,swdflxcln real,dimension(1,kts:kte+2):: sibvisdir,sibvisdif,sibnirdir,sibnirdif - real,dimension(1,kts:kte+2):: swdkdir,swdkdif + real,dimension(1,kts:kte+2):: swdkdir,swdkdif,swdkdirc real,dimension(1,kts:kte+1,nbndsw):: tauaer,ssaaer,asmaer @@ -9967,7 +10137,6 @@ subroutine rrtmg_swrad( & !--- additional local variables related to the implementation of aerosols in rrtmg_swrad in WRF 3.8. ! In WRF 3.8, these variables are in the argument list of subroutine rrtmg_swrad, but are made ! local here: - integer:: aer_opt real,dimension(1,kts:kte+1,naerec):: ecaer !--- set trace gas volume mixing ratios, 2005 values, IPCC (2007): @@ -10008,12 +10177,18 @@ subroutine rrtmg_swrad( & !--- all fields are ordered vertically from bottom to top (pressures are in mb): ncol = 1 +!--- select cloud overlap asumption (1=random, 2=maximum-random, 3=maximum, 4=exponential, 5=exponential-random). +! assign namlist variable cldovrlp to existing icld: + icld = cldovrlp + !--- initialize option for the calculation of the cloud optical properties: - icld = 2 ! with clouds using maximum/random cloud overlap in subroutine mcica_subcol_lw. inflgsw = 2 iceflgsw = 3 liqflgsw = 1 +!--- initialize option for the calculation of clean air upward and downward fluxes: + calc_clean_atm_diag = 0 + !--- latitude loop: j_loop: do j = jts,jte @@ -10035,6 +10210,9 @@ subroutine rrtmg_swrad( & if(dorrsw) then + !--- initialize local latitude: + lat = xlat(i,j) + !--- INITIALIZE COLUMN SOUNDING (the call to the short wave radiation code is done one column ! at a time): do k = kts, kte+1 @@ -10090,22 +10268,24 @@ subroutine rrtmg_swrad( & enddo do k = 1, nlay - clwpth(n,k) = 0. - ciwpth(n,k) = 0. - cswpth(n,k) = 0. - rel(n,k) = 0. - rei(n,k) = 0. - res(n,k) = 0. - cldfrac(n,k) = 0. - relqmcl(n,k) = 0. - reicmcl(n,k) = 0. - resnmcl(n,k) = 0. - swuflx(n,k) = 0. - swuflxc(n,k) = 0. - swdflx(n,k) = 0. - swdflxc(n,k) = 0. - swhr(n,k) = 0. - swhrc(n,k) = 0. + clwpth(n,k) = 0. + ciwpth(n,k) = 0. + cswpth(n,k) = 0. + rel(n,k) = 0. + rei(n,k) = 0. + res(n,k) = 0. + cldfrac(n,k) = 0. + relqmcl(n,k) = 0. + reicmcl(n,k) = 0. + resnmcl(n,k) = 0. + swuflx(n,k) = 0. + swuflxc(n,k) = 0. + swuflxcln(n,k) = 0. + swdflx(n,k) = 0. + swdflxc(n,k) = 0. + swdflxcln(n,k) = 0. + swhr(n,k) = 0. + swhrc(n,k) = 0. taucld(1:nbndsw,n,k) = 0. tauaer(n,k,1:nbndsw) = 0. ssaaer(n,k,1:nbndsw) = 0. @@ -10123,15 +10303,17 @@ subroutine rrtmg_swrad( & sibnirdif(ncol,k) = 0. swdkdir(n,k) = 0. swdkdif(n,k) = 0. + swdkdirc(n,k) = 0. enddo - swuflx(n,nlay+1) = 0. - swuflxc(n,nlay+1) = 0. - swdflx(n,nlay+1) = 0. - swdflxc(n,nlay+1) = 0. + swuflx(n,nlay+1) = 0. + swuflxc(n,nlay+1) = 0. + swuflxcln(n,nlay+1) = 0. + swdflx(n,nlay+1) = 0. + swdflxc(n,nlay+1) = 0. + swdflxcln(n,nlay+1) = 0. enddo !--- initialization of aerosol optical properties: - aer_opt = 0 do n = 1, ncol do k = 1, nlay do na = 1, naerec @@ -10167,7 +10349,17 @@ subroutine rrtmg_swrad( & ch4vmr(ncol,kte+1) = ch4vmr(ncol,kte) n2ovmr(ncol,kte+1) = n2ovmr(ncol,kte) - !--- initialize the ozone voume mixing ratio: + !--- compute height of each layer mid-point from layer thickness needed for icl=4 (exponential) and + ! icld=5 (exponential-random) overlap. fill in height array above model top using dz1d from top + ! layer: + dzsum = 0. + do k = kts, kte + hlay(ncol,k) = dzsum + 0.5*dz1d(k) + dzsum = dzsum + dz1d(k) + enddo + hlay(ncol,kte+1) = dzsum + 0.5*dz1d(kte) + + !--- initialize the ozone volume mixing ratio: call inirad(o3mmr,plev,kts,kte) if(o3input .eq. 2) then do k = 1, noznlevels @@ -10362,18 +10554,32 @@ subroutine rrtmg_swrad( & call mcica_subcol_sw & (iplon , ncol , nlay , icld , permuteseed , irng , play , & cldfrac , ciwpth , clwpth , cswpth , rei , rel , res , & - taucld , ssacld , asmcld , fsfcld , cldfmcl , ciwpmcl , clwpmcl , & - cswpmcl , reicmcl , relqmcl , resnmcl , taucmcl , ssacmcl , asmcmcl , & - fsfcmcl) + taucld , ssacld , asmcld , fsfcld , hlay , idcor , julday , & + lat , cldfmcl , ciwpmcl , clwpmcl , cswpmcl , reicmcl , relqmcl , & + resnmcl , taucmcl , ssacmcl , asmcmcl , fsfcmcl) !--- initialization of aerosol optical properties: - do nb = 1, nbndsw - do k = kts, kte+1 + if(present(tauaer3d) .and. present(ssaaer3d) .and. present(asyaer3d)) then + do nb = 1, nbndsw + do k = kts, kte + tauaer(ncol,k,nb) = tauaer3d(i,k,j,nb) + ssaaer(ncol,k,nb) = ssaaer3d(i,k,j,nb) + asmaer(ncol,k,nb) = asyaer3d(i,k,j,nb) + enddo + k = kte+1 tauaer(ncol,k,nb) = 0. ssaaer(ncol,k,nb) = 1. asmaer(ncol,k,nb) = 0. enddo - enddo + else + do nb = 1, nbndsw + do k = kts, kte+1 + tauaer(ncol,k,nb) = 0. + ssaaer(ncol,k,nb) = 1. + asmaer(ncol,k,nb) = 0. + enddo + enddo + endif do na = 1, naerec do k = kts, kte+1 @@ -10385,17 +10591,16 @@ subroutine rrtmg_swrad( & !--- CALL TO THE RRTMG SHORT WAVE RADIATION MODEL: call rrtmg_sw & - (ncol , nlay , icld , play , plev , tlay , & - tlev , tsfc , h2ovmr , o3vmr , co2vmr , ch4vmr , & - n2ovmr , o2vmr , asdir , asdif , aldir , aldif , & - coszen , adjes , dyofyr , scon , inflgsw , iceflgsw , & - liqflgsw , cldfmcl , taucmcl , ssacmcl , asmcmcl , fsfcmcl , & - ciwpmcl , clwpmcl , cswpmcl , reicmcl , relqmcl , resnmcl , & - tauaer , ssaaer , asmaer , ecaer , swuflx , swdflx , & - swhr , swuflxc , swdflxc , swhrc , & - aer_opt , & - sibvisdir , sibvisdif , sibnirdir , sibnirdif , & !added for ssib coupling. - swdkdir , swdkdif) + (ncol , nlay , icld , play , plev , tlay , & + tlev , tsfc , h2ovmr , o3vmr , co2vmr , ch4vmr , & + n2ovmr , o2vmr , asdir , asdif , aldir , aldif , & + coszen , adjes , dyofyr , scon , inflgsw , iceflgsw , & + liqflgsw , cldfmcl , taucmcl , ssacmcl , asmcmcl , fsfcmcl , & + ciwpmcl , clwpmcl , cswpmcl , reicmcl , relqmcl , resnmcl , & + tauaer , ssaaer , asmaer , ecaer , swuflx , swdflx , & + swhr , swuflxc , swdflxc , swhrc , swuflxcln , swdflxcln , & + aer_opt , sibvisdir , sibvisdif , sibnirdir , sibnirdif , swdkdir , & + swdkdif , swdkdirc , calc_clean_atm_diag) !--- OUTPUTS: gsw(i,j) = swdflx(1,1) - swuflx(1,1) @@ -10458,1193 +10663,7 @@ subroutine rrtmg_swrad( & end subroutine rrtmg_swrad -!----------------------------------------------------------------------------------------------------------------- - -!ldf (2013-03-11): This section of the module is moved to module_physics_rrtmg_swinit.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 of the shortwave radiation code. Initialization is handled the same way -!for the longwave radiation code. - -#if !(defined(mpas)) - -!==================================================================== - SUBROUTINE rrtmg_swinit( & - allowed_to_read , & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte ) -!-------------------------------------------------------------------- - IMPLICIT NONE -!-------------------------------------------------------------------- - - LOGICAL , INTENT(IN) :: allowed_to_read - INTEGER , INTENT(IN) :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - its, ite, jts, jte, kts, kte - -! Read in absorption coefficients and other data - IF ( allowed_to_read ) THEN - CALL rrtmg_swlookuptable - ENDIF - -! Perform g-point reduction and other initializations -! Specific heat of dry air (cp) used in flux to heating rate conversion factor. - call rrtmg_sw_ini(cp) - - END SUBROUTINE rrtmg_swinit - - -! ************************************************************************** - SUBROUTINE rrtmg_swlookuptable -! ************************************************************************** - -IMPLICIT NONE - -! Local - INTEGER :: i - LOGICAL :: opened - LOGICAL , EXTERNAL :: wrf_dm_on_monitor - - CHARACTER*80 errmess - INTEGER rrtmg_unit - - IF ( wrf_dm_on_monitor() ) THEN - DO i = 10,99 - INQUIRE ( i , OPENED = opened ) - IF ( .NOT. opened ) THEN - rrtmg_unit = i - GOTO 2010 - ENDIF - ENDDO - rrtmg_unit = -1 - 2010 CONTINUE - ENDIF - CALL wrf_dm_bcast_bytes ( rrtmg_unit , IWORDSIZE ) - IF ( rrtmg_unit < 0 ) THEN - CALL wrf_error_fatal ( 'module_ra_rrtmg_sw: rrtm_swlookuptable: Can not '// & - 'find unused fortran unit to read in lookup table.' ) - ENDIF - - IF ( wrf_dm_on_monitor() ) THEN - OPEN(rrtmg_unit,FILE='RRTMG_SW_DATA', & - FORM='UNFORMATTED',STATUS='OLD',ERR=9009) - ENDIF - - call sw_kgb16(rrtmg_unit) - call sw_kgb17(rrtmg_unit) - call sw_kgb18(rrtmg_unit) - call sw_kgb19(rrtmg_unit) - call sw_kgb20(rrtmg_unit) - call sw_kgb21(rrtmg_unit) - call sw_kgb22(rrtmg_unit) - call sw_kgb23(rrtmg_unit) - call sw_kgb24(rrtmg_unit) - call sw_kgb25(rrtmg_unit) - call sw_kgb26(rrtmg_unit) - call sw_kgb27(rrtmg_unit) - call sw_kgb28(rrtmg_unit) - call sw_kgb29(rrtmg_unit) - - IF ( wrf_dm_on_monitor() ) CLOSE (rrtmg_unit) - - RETURN -9009 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_sw: error opening RRTMG_SW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - END SUBROUTINE rrtmg_swlookuptable - -! ************************************************************************** -! RRTMG Shortwave Radiative Transfer Model -! Atmospheric and Environmental Research, Inc., Cambridge, MA -! -! Original by J.Delamere, Atmospheric & Environmental Research. -! Reformatted for F90: JJMorcrette, ECMWF -! Revision for GCMs: Michael J. Iacono, AER, July 2002 -! Further F90 reformatting: Michael J. Iacono, AER, June 2006 -! -! This file contains 14 READ statements that include the -! absorption coefficients and other data for each of the 14 shortwave -! spectral bands used in RRTMG_SW. Here, the data are defined for 16 -! g-points, or sub-intervals, per band. These data are combined and -! weighted using a mapping procedure in module RRTMG_SW_INIT to reduce -! the total number of g-points from 224 to 112 for use in the GCM. -! ************************************************************************** - -! ************************************************************************** - subroutine sw_kgb16(rrtmg_unit) -! ************************************************************************** - - use rrsw_kg16, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & - rayl, strrat1, layreffr - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Array sfluxrefo contains the Kurucz solar source function for this band. - -! Array rayl contains the Rayleigh extinction coefficient at v = 2925 cm-1. - -! The array KAO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, -! JS = 3 corresponds to the parameter value 2/8, etc. The second index -! in the array, JT, which runs from 1 to 5, corresponds to different -! temperatures. More specifically, JT = 3 means that the data are for -! the reference temperature TREF for this pressure level, JT = 2 refers -! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 -! is for TREF+30. The third index, JP, runs from 1 to 13 and refers -! to the JPth reference pressure level (see taumol.f for these levels -! in mb). The fourth index, IG, goes from 1 to 16, and indicates -! which g-interval the absorption coefficients are for. - -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. -! The second index, JP, runs from 13 to 59 and refers to the JPth -! reference pressure level (see taumol.f for the value of these -! pressure levels in mb). The third index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) -#define DM_BCAST_REAL(A) CALL wrf_dm_bcast_real ( A , 1 ) -#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - rayl, strrat1, layreffr, kao, kbo, selfrefo, forrefo, sfluxrefo - DM_BCAST_REAL(rayl) - DM_BCAST_REAL(strrat1) - DM_BCAST_INTEGER(layreffr) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kbo) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - DM_BCAST_MACRO(sfluxrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_sw: error reading RRTMG_SW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine sw_kgb16 - -! ************************************************************************** - subroutine sw_kgb17(rrtmg_unit) -! ************************************************************************** - - use rrsw_kg17, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & - rayl, strrat, layreffr - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Array sfluxrefo contains the Kurucz solar source function for this band. - -! Array rayl contains the Rayleigh extinction coefficient at v = 3625 cm-1. - -! The array KAO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, -! JS = 3 corresponds to the parameter value 2/8, etc. The second index -! in the array, JT, which runs from 1 to 5, corresponds to different -! temperatures. More specifically, JT = 3 means that the data are for -! the reference temperature TREF for this pressure level, JT = 2 refers -! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 -! is for TREF+30. The third index, JP, runs from 1 to 13 and refers -! to the JPth reference pressure level (see taumol.f for these levels -! in mb). The fourth index, IG, goes from 1 to 16, and indicates -! which g-interval the absorption coefficients are for. - -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. -! The second index, JP, runs from 13 to 59 and refers to the JPth -! reference pressure level (see taumol.f for the value of these -! pressure levels in mb). The third index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) -#define DM_BCAST_REAL(A) CALL wrf_dm_bcast_real ( A , 1 ) -#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - rayl, strrat, layreffr, kao, kbo, selfrefo, forrefo, sfluxrefo - DM_BCAST_REAL(rayl) - DM_BCAST_REAL(strrat) - DM_BCAST_INTEGER(layreffr) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kbo) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - DM_BCAST_MACRO(sfluxrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_sw: error reading RRTMG_SW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine sw_kgb17 - -! ************************************************************************** - subroutine sw_kgb18(rrtmg_unit) -! ************************************************************************** - - use rrsw_kg18, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & - rayl, strrat, layreffr - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Array sfluxrefo contains the Kurucz solar source function for this band. - -! Array rayl contains the Rayleigh extinction coefficient at v = 4325 cm-1. - -! The array KAO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, -! JS = 3 corresponds to the parameter value 2/8, etc. The second index -! in the array, JT, which runs from 1 to 5, corresponds to different -! temperatures. More specifically, JT = 3 means that the data are for -! the reference temperature TREF for this pressure level, JT = 2 refers -! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 -! is for TREF+30. The third index, JP, runs from 1 to 13 and refers -! to the JPth reference pressure level (see taumol.f for these levels -! in mb). The fourth index, IG, goes from 1 to 16, and indicates -! which g-interval the absorption coefficients are for. - -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. -! The second index, JP, runs from 13 to 59 and refers to the JPth -! reference pressure level (see taumol.f for the value of these -! pressure levels in mb). The third index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) -#define DM_BCAST_REAL(A) CALL wrf_dm_bcast_real ( A , 1 ) -#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - rayl, strrat, layreffr, kao, kbo, selfrefo, forrefo, sfluxrefo - DM_BCAST_REAL(rayl) - DM_BCAST_REAL(strrat) - DM_BCAST_INTEGER(layreffr) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kbo) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - DM_BCAST_MACRO(sfluxrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_sw: error reading RRTMG_SW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine sw_kgb18 - -! ************************************************************************** - subroutine sw_kgb19(rrtmg_unit) -! ************************************************************************** - - use rrsw_kg19, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & - rayl, strrat, layreffr - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Array sfluxrefo contains the Kurucz solar source function for this band. - -! Array rayl contains the Rayleigh extinction coefficient at v = 4900 cm-1. - -! The array KAO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, -! JS = 3 corresponds to the parameter value 2/8, etc. The second index -! in the array, JT, which runs from 1 to 5, corresponds to different -! temperatures. More specifically, JT = 3 means that the data are for -! the reference temperature TREF for this pressure level, JT = 2 refers -! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 -! is for TREF+30. The third index, JP, runs from 1 to 13 and refers -! to the JPth reference pressure level (see taumol.f for these levels -! in mb). The fourth index, IG, goes from 1 to 16, and indicates -! which g-interval the absorption coefficients are for. - -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. -! The second index, JP, runs from 13 to 59 and refers to the JPth -! reference pressure level (see taumol.f for the value of these -! pressure levels in mb). The third index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) -#define DM_BCAST_REAL(A) CALL wrf_dm_bcast_real ( A , 1 ) -#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - rayl, strrat, layreffr, kao, kbo, selfrefo, forrefo, sfluxrefo - DM_BCAST_REAL(rayl) - DM_BCAST_REAL(strrat) - DM_BCAST_INTEGER(layreffr) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kbo) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - DM_BCAST_MACRO(sfluxrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_sw: error reading RRTMG_SW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine sw_kgb19 - -! ************************************************************************** - subroutine sw_kgb20(rrtmg_unit) -! ************************************************************************** - - use rrsw_kg20, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & - absch4o, rayl, layreffr - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Array sfluxrefo contains the Kurucz solar source function for this band. - -! Array rayl contains the Rayleigh extinction coefficient at v = 5670 cm-1. - -! Array absch4o contains the absorption coefficients for methane. - -! The array KAO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, -! JS = 3 corresponds to the parameter value 2/8, etc. The second index -! in the array, JT, which runs from 1 to 5, corresponds to different -! temperatures. More specifically, JT = 3 means that the data are for -! the reference temperature TREF for this pressure level, JT = 2 refers -! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 -! is for TREF+30. The third index, JP, runs from 1 to 13 and refers -! to the JPth reference pressure level (see taumol.f for these levels -! in mb). The fourth index, IG, goes from 1 to 16, and indicates -! which g-interval the absorption coefficients are for. - -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. -! The second index, JP, runs from 13 to 59 and refers to the JPth -! reference pressure level (see taumol.f for the value of these -! pressure levels in mb). The third index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) -#define DM_BCAST_REAL(A) CALL wrf_dm_bcast_real ( A , 1 ) -#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - rayl, layreffr, absch4o, kao, kbo, selfrefo, forrefo, sfluxrefo - DM_BCAST_REAL(rayl) - DM_BCAST_INTEGER(layreffr) - DM_BCAST_MACRO(absch4o) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kbo) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - DM_BCAST_MACRO(sfluxrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_sw: error reading RRTMG_SW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine sw_kgb20 - -! ************************************************************************** - subroutine sw_kgb21(rrtmg_unit) -! ************************************************************************** - - use rrsw_kg21, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & - rayl, strrat, layreffr - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Array sfluxrefo contains the Kurucz solar source function for this band. - -! Array rayl contains the Rayleigh extinction coefficient at v = 6925 cm-1. - -! The array KAO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, -! JS = 3 corresponds to the parameter value 2/8, etc. The second index -! in the array, JT, which runs from 1 to 5, corresponds to different -! temperatures. More specifically, JT = 3 means that the data are for -! the reference temperature TREF for this pressure level, JT = 2 refers -! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 -! is for TREF+30. The third index, JP, runs from 1 to 13 and refers -! to the JPth reference pressure level (see taumol.f for these levels -! in mb). The fourth index, IG, goes from 1 to 16, and indicates -! which g-interval the absorption coefficients are for. - -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. -! The second index, JP, runs from 13 to 59 and refers to the JPth -! reference pressure level (see taumol.f for the value of these -! pressure levels in mb). The third index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) -#define DM_BCAST_REAL(A) CALL wrf_dm_bcast_real ( A , 1 ) -#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - rayl, strrat, layreffr, kao, kbo, selfrefo, forrefo, sfluxrefo - DM_BCAST_REAL(rayl) - DM_BCAST_REAL(strrat) - DM_BCAST_INTEGER(layreffr) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kbo) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - DM_BCAST_MACRO(sfluxrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_sw: error reading RRTMG_SW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine sw_kgb21 - -! ************************************************************************** - subroutine sw_kgb22(rrtmg_unit) -! ************************************************************************** - - use rrsw_kg22, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & - rayl, strrat, layreffr - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Array sfluxrefo contains the Kurucz solar source function for this band. - -! Array rayl contains the Rayleigh extinction coefficient at v = 8000 cm-1. - -! The array KAO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, -! JS = 3 corresponds to the parameter value 2/8, etc. The second index -! in the array, JT, which runs from 1 to 5, corresponds to different -! temperatures. More specifically, JT = 3 means that the data are for -! the reference temperature TREF for this pressure level, JT = 2 refers -! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 -! is for TREF+30. The third index, JP, runs from 1 to 13 and refers -! to the JPth reference pressure level (see taumol.f for these levels -! in mb). The fourth index, IG, goes from 1 to 16, and indicates -! which g-interval the absorption coefficients are for. - -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. -! The second index, JP, runs from 13 to 59 and refers to the JPth -! reference pressure level (see taumol.f for the value of these -! pressure levels in mb). The third index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296_rb,260_rb,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) -#define DM_BCAST_REAL(A) CALL wrf_dm_bcast_real ( A , 1 ) -#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - rayl, strrat, layreffr, kao, kbo, selfrefo, forrefo, sfluxrefo - DM_BCAST_REAL(rayl) - DM_BCAST_REAL(strrat) - DM_BCAST_INTEGER(layreffr) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kbo) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - DM_BCAST_MACRO(sfluxrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_sw: error reading RRTMG_SW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine sw_kgb22 - -! ************************************************************************** - subroutine sw_kgb23(rrtmg_unit) -! ************************************************************************** - - use rrsw_kg23, only : kao, selfrefo, forrefo, sfluxrefo, & - raylo, givfac, layreffr - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Array sfluxrefo contains the Kurucz solar source function for this band. - -! Array raylo contains the Rayleigh extinction coefficient at all v for this band - -! Array givfac is the average Giver et al. correction factor for this band. - -! The array KAO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, -! JS = 3 corresponds to the parameter value 2/8, etc. The second index -! in the array, JT, which runs from 1 to 5, corresponds to different -! temperatures. More specifically, JT = 3 means that the data are for -! the reference temperature TREF for this pressure level, JT = 2 refers -! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 -! is for TREF+30. The third index, JP, runs from 1 to 13 and refers -! to the JPth reference pressure level (see taumol.f for these levels -! in mb). The fourth index, IG, goes from 1 to 16, and indicates -! which g-interval the absorption coefficients are for. - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) -#define DM_BCAST_REAL(A) CALL wrf_dm_bcast_real ( A , 1 ) -#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - raylo, givfac, layreffr, kao, selfrefo, forrefo, sfluxrefo - DM_BCAST_MACRO(raylo) - DM_BCAST_REAL(givfac) - DM_BCAST_INTEGER(layreffr) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - DM_BCAST_MACRO(sfluxrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_sw: error reading RRTMG_SW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine sw_kgb23 - -! ************************************************************************** - subroutine sw_kgb24(rrtmg_unit) -! ************************************************************************** - - use rrsw_kg24, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & - raylao, raylbo, abso3ao, abso3bo, strrat, layreffr - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Array sfluxrefo contains the Kurucz solar source function for this band. - -! Arrays raylao and raylbo contain the Rayleigh extinction coefficient at -! all v for this band for the upper and lower atmosphere. - -! Arrays abso3ao and abso3bo contain the ozone absorption coefficient at -! all v for this band for the upper and lower atmosphere. - -! The array KAO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, -! JS = 3 corresponds to the parameter value 2/8, etc. The second index -! in the array, JT, which runs from 1 to 5, corresponds to different -! temperatures. More specifically, JT = 3 means that the data are for -! the reference temperature TREF for this pressure level, JT = 2 refers -! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 -! is for TREF+30. The third index, JP, runs from 1 to 13 and refers -! to the JPth reference pressure level (see taumol.f for these levels -! in mb). The fourth index, IG, goes from 1 to 16, and indicates -! which g-interval the absorption coefficients are for. - -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. -! The second index, JP, runs from 13 to 59 and refers to the JPth -! reference pressure level (see taumol.f for the value of these -! pressure levels in mb). The third index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) -#define DM_BCAST_REAL(A) CALL wrf_dm_bcast_real ( A , 1 ) -#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - raylao, raylbo, strrat, layreffr, abso3ao, abso3bo, kao, kbo, selfrefo, & - forrefo, sfluxrefo - DM_BCAST_MACRO(raylao) - DM_BCAST_MACRO(raylbo) - DM_BCAST_REAL(strrat) - DM_BCAST_INTEGER(layreffr) - DM_BCAST_MACRO(abso3ao) - DM_BCAST_MACRO(abso3bo) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kbo) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - DM_BCAST_MACRO(sfluxrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_sw: error reading RRTMG_SW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine sw_kgb24 - -! ************************************************************************** - subroutine sw_kgb25(rrtmg_unit) -! ************************************************************************** - - use rrsw_kg25, only : kao, sfluxrefo, & - raylo, abso3ao, abso3bo, layreffr - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Array sfluxrefo contains the Kurucz solar source function for this band. - -! Array raylo contains the Rayleigh extinction coefficient at all v = 2925 cm-1. - -! Arrays abso3ao and abso3bo contain the ozone absorption coefficient at -! all v for this band for the upper and lower atmosphere. - -! The array KAO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, -! JS = 3 corresponds to the parameter value 2/8, etc. The second index -! in the array, JT, which runs from 1 to 5, corresponds to different -! temperatures. More specifically, JT = 3 means that the data are for -! the reference temperature TREF for this pressure level, JT = 2 refers -! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 -! is for TREF+30. The third index, JP, runs from 1 to 13 and refers -! to the JPth reference pressure level (see taumol.f for these levels -! in mb). The fourth index, IG, goes from 1 to 16, and indicates -! which g-interval the absorption coefficients are for. - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) -#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - raylo, layreffr, abso3ao, abso3bo, kao, sfluxrefo - DM_BCAST_MACRO(raylo) - DM_BCAST_INTEGER(layreffr) - DM_BCAST_MACRO(abso3ao) - DM_BCAST_MACRO(abso3bo) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(sfluxrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_sw: error reading RRTMG_SW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine sw_kgb25 - -! ************************************************************************** - subroutine sw_kgb26(rrtmg_unit) -! ************************************************************************** - - use rrsw_kg26, only : sfluxrefo, raylo - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Array sfluxrefo contains the Kurucz solar source function for this band. - -! Array raylo contains the Rayleigh extinction coefficient at all v for this band. - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - raylo, sfluxrefo - DM_BCAST_MACRO(raylo) - DM_BCAST_MACRO(sfluxrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_sw: error reading RRTMG_SW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine sw_kgb26 - -! ************************************************************************** - subroutine sw_kgb27(rrtmg_unit) -! ************************************************************************** - - use rrsw_kg27, only : kao, kbo, sfluxrefo, raylo, & - scalekur, layreffr - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Array sfluxrefo contains the Kurucz solar source function for this band. -! The values in array sfluxrefo were obtained using the "low resolution" -! version of the Kurucz solar source function. For unknown reasons, -! the total irradiance in this band differs from the corresponding -! total in the "high-resolution" version of the Kurucz function. -! Therefore, these values are scaled by the factor SCALEKUR. - -! Array raylo contains the Rayleigh extinction coefficient at all v = 2925 cm-1. - -! The array KAO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, -! JS = 3 corresponds to the parameter value 2/8, etc. The second index -! in the array, JT, which runs from 1 to 5, corresponds to different -! temperatures. More specifically, JT = 3 means that the data are for -! the reference temperature TREF for this pressure level, JT = 2 refers -! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 -! is for TREF+30. The third index, JP, runs from 1 to 13 and refers -! to the JPth reference pressure level (see taumol.f for these levels -! in mb). The fourth index, IG, goes from 1 to 16, and indicates -! which g-interval the absorption coefficients are for. - -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. -! The second index, JP, runs from 13 to 59 and refers to the JPth -! reference pressure level (see taumol.f for the value of these -! pressure levels in mb). The third index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) -#define DM_BCAST_REAL(A) CALL wrf_dm_bcast_real ( A , 1 ) -#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - raylo, scalekur, layreffr, kao, kbo, sfluxrefo - DM_BCAST_MACRO(raylo) - DM_BCAST_REAL(scalekur) - DM_BCAST_INTEGER(layreffr) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kbo) - DM_BCAST_MACRO(sfluxrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_sw: error reading RRTMG_SW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine sw_kgb27 - -! ************************************************************************** - subroutine sw_kgb28(rrtmg_unit) -! ************************************************************************** - - use rrsw_kg28, only : kao, kbo, sfluxrefo, & - rayl, strrat, layreffr - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Array sfluxrefo contains the Kurucz solar source function for this band. - -! Array raylo contains the Rayleigh extinction coefficient at all v = ???? cm-1. - -! The array KAO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, -! JS = 3 corresponds to the parameter value 2/8, etc. The second index -! in the array, JT, which runs from 1 to 5, corresponds to different -! temperatures. More specifically, JT = 3 means that the data are for -! the reference temperature TREF for this pressure level, JT = 2 refers -! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 -! is for TREF+30. The third index, JP, runs from 1 to 13 and refers -! to the JPth reference pressure level (see taumol.f for these levels -! in mb). The fourth index, IG, goes from 1 to 16, and indicates -! which g-interval the absorption coefficients are for. - -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. -! The second index, JP, runs from 13 to 59 and refers to the JPth -! reference pressure level (see taumol.f for the value of these -! pressure levels in mb). The third index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) -#define DM_BCAST_REAL(A) CALL wrf_dm_bcast_real ( A , 1 ) -#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - rayl, strrat, layreffr, kao, kbo, sfluxrefo - DM_BCAST_REAL(rayl) - DM_BCAST_REAL(strrat) - DM_BCAST_INTEGER(layreffr) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kbo) - DM_BCAST_MACRO(sfluxrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_sw: error reading RRTMG_SW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine sw_kgb28 - -! ************************************************************************** - subroutine sw_kgb29(rrtmg_unit) -! ************************************************************************** - - use rrsw_kg29, only : kao, kbo, selfrefo, forrefo, sfluxrefo, & - absh2oo, absco2o, rayl, layreffr - - implicit none - save - -! Input - integer, intent(in) :: rrtmg_unit - -! Local - character*80 errmess - logical, external :: wrf_dm_on_monitor - -! Array sfluxrefo contains the Kurucz solar source function for this band. - -! Array rayl contains the Rayleigh extinction coefficient at all v = 2200 cm-1. - -! Array absh2oo contains the water vapor absorption coefficient for this band. - -! Array absco2o contains the carbon dioxide absorption coefficient for this band. - -! The array KAO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels> ~100mb, temperatures, and binary -! species parameters (see taumol.f for definition). The first -! index in the array, JS, runs from 1 to 9, and corresponds to -! different values of the binary species parameter. For instance, -! JS=1 refers to dry air, JS = 2 corresponds to the paramter value 1/8, -! JS = 3 corresponds to the parameter value 2/8, etc. The second index -! in the array, JT, which runs from 1 to 5, corresponds to different -! temperatures. More specifically, JT = 3 means that the data are for -! the reference temperature TREF for this pressure level, JT = 2 refers -! to TREF-15, JT = 1 is for TREF-30, JT = 4 is for TREF+15, and JT = 5 -! is for TREF+30. The third index, JP, runs from 1 to 13 and refers -! to the JPth reference pressure level (see taumol.f for these levels -! in mb). The fourth index, IG, goes from 1 to 16, and indicates -! which g-interval the absorption coefficients are for. - -! The array KBO contains absorption coefs at the 16 chosen g-values -! for a range of pressure levels < ~100mb and temperatures. The first -! index in the array, JT, which runs from 1 to 5, corresponds to -! different temperatures. More specifically, JT = 3 means that the -! data are for the reference temperature TREF for this pressure -! level, JT = 2 refers to the temperature TREF-15, JT = 1 is for -! TREF-30, JT = 4 is for TREF+15, and JT = 5 is for TREF+30. -! The second index, JP, runs from 13 to 59 and refers to the JPth -! reference pressure level (see taumol.f for the value of these -! pressure levels in mb). The third index, IG, goes from 1 to 16, -! and tells us which g-interval the absorption coefficients are for. - -! The array FORREFO contains the coefficient of the water vapor -! foreign-continuum (including the energy term). The first -! index refers to reference temperature (296,260,224,260) and -! pressure (970,475,219,3 mbar) levels. The second index -! runs over the g-channel (1 to 16). - -! The array SELFREFO contains the coefficient of the water vapor -! self-continuum (including the energy term). The first index -! refers to temperature in 7.2 degree increments. For instance, -! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8, -! etc. The second index runs over the g-channel (1 to 16). - -#define DM_BCAST_MACRO(A) CALL wrf_dm_bcast_bytes ( A , size ( A ) * RWORDSIZE ) -#define DM_BCAST_REAL(A) CALL wrf_dm_bcast_real ( A , 1 ) -#define DM_BCAST_INTEGER(A) CALL wrf_dm_bcast_integer ( A , 1 ) - - IF ( wrf_dm_on_monitor() ) READ (rrtmg_unit,ERR=9010) & - rayl, layreffr, absh2oo, absco2o, kao, kbo, selfrefo, forrefo, sfluxrefo - DM_BCAST_REAL(rayl) - DM_BCAST_INTEGER(layreffr) - DM_BCAST_MACRO(absh2oo) - DM_BCAST_MACRO(absco2o) - DM_BCAST_MACRO(kao) - DM_BCAST_MACRO(kbo) - DM_BCAST_MACRO(selfrefo) - DM_BCAST_MACRO(forrefo) - DM_BCAST_MACRO(sfluxrefo) - - RETURN -9010 CONTINUE - WRITE( errmess , '(A,I4)' ) 'module_ra_rrtmg_sw: error reading RRTMG_SW_DATA on unit ',rrtmg_unit - CALL wrf_error_fatal(errmess) - - end subroutine sw_kgb29 - !------------------------------------------------------------------ -#endif -!ldf end (2013-03-11). - END MODULE module_ra_rrtmg_sw +!*********************************************************************** diff --git a/src/core_atmosphere/physics/physics_wrf/module_ra_rrtmg_sw_aerosols.F b/src/core_atmosphere/physics/physics_wrf/module_ra_rrtmg_sw_aerosols.F new file mode 100644 index 000000000..58ba65888 --- /dev/null +++ b/src/core_atmosphere/physics/physics_wrf/module_ra_rrtmg_sw_aerosols.F @@ -0,0 +1,925 @@ +!================================================================================================================= +!module_ra_rrtmg_sw_aerosols includes subroutine calc_aerosol_rrtmg_sw. subroutine calc_aerosol_rrtmg_sw is called +!from subroutine radiation_sw_from_MPAS in mpas_atmphys_driver_radiation_sw.F. calc_aerosol_rrtmg_sw calculates +!the optical properties (aerosol optical depth,asymmetry factor,and single-scattering albedo) of "water-friendly" +!and "ice-friendly" aerosols from the Thompson cloud microphysics scheme. calc_aerosol_rrtmg_sw was copied from +!from WRF-4.0.2 (see module_radiation_driver.F). +!Laura D. Fowler (laura@ucar.edu) / 2024-05-16. + + module module_ra_rrtmg_sw_aerosols + use mpas_log + use mpas_atmphys_functions,only: rslf + use mpas_atmphys_utilities, only: physics_error_fatal,physics_message +#define FATAL_ERROR(M) call physics_error_fatal(M) +#define WRITE_MESSAGE(M) call physics_message(M) + + implicit none + private + public:: calc_aerosol_rrtmg_sw + + + contains + + +!================================================================================================================= +!-------------------------------------------------------------- +! INDICES CONVENTION +!-------------------------------------------------------------- +! kms:kme define the range for full-level indices +! kts:kte define the range for half-level indices +! +! kms=1 is the first full level at surface +! kts=1 is the first half level at surface +! +! kme is the last full level at toa +! kte is the last half level at toa +! +! There is one more full level than half levels. +! Therefore, kme=kte+1. I checked it in one of my +! simulations: +! +! namelist.input: +! s_vert=1 e_vert=28 +! code: +! kms= 1 kts= 1 +! kms=28 kte=27 +! +! In the vertical dimension there is no tiling for +! parallelization as in the horizontal dimensions. +! For i-dim and j-dim, the t-indices define the +! range of indices over which each tile runs. +!-------------------------------------------------------------- +! +! namelist options: +! aer_aod550_opt = [1,2] : +! 1 = input constant value for AOD at 550 nm from namelist. +! In this case, the value is read from aer_aod550_val; +! 2 = input value from auxiliary input 15. It is a time-varying 2D grid in netcdf wrf-compatible +! format. The default operation is aer_aod550_opt=1 and aer_aod550_val=0.12 +! aer_angexp_opt = [1,2,3] : +! 1 = input constant value for Angstrom exponent from namelist. In this case, the value is read +! from aer_angexp_val; +! 2 = input value from auxiliary input 15, as in aer_aod550_opt; +! 3 = Angstrom exponent value estimated from the aerosol type defined in aer_type, and modulated +! with the RH in WRF. Default operation is aer_angexp_opt = 1, and aer_angexp_val=1.3. +! aer_ssa_opt and aer_asy_opt are similar to aer_angexp_opt. +! +! aer_type = [1,2,3] : 1 for rural, 2 is urban and 3 is maritime. +!-------------------------------------------------------------- + +subroutine calc_aerosol_rrtmg_sw(ht,dz8w,p,t3d,qv3d,aer_type, & + aer_aod550_opt, aer_angexp_opt, aer_ssa_opt, aer_asy_opt, & + aer_aod550_val, aer_angexp_val, aer_ssa_val, aer_asy_val, & + aod5502d, angexp2d, aerssa2d, aerasy2d, & + ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte, & + tauaer, ssaaer, asyaer, aod5503d ) + + ! constants + integer, parameter :: N_BANDS=14 + ! local index variables + integer :: i,j,k,nb + + real :: lower_wvl(N_BANDS),upper_wvl(N_BANDS) + data (lower_wvl(i),i=1,N_BANDS) /3.077,2.500,2.150,1.942,1.626,1.299,1.242,0.7782,0.6250,0.4415,0.3448,0.2632,0.2000,3.846/ + data (upper_wvl(i),i=1,N_BANDS) /3.846,3.077,2.500,2.150,1.942,1.626,1.299,1.2420,0.7782,0.6250,0.4415,0.3448,0.2632,12.195/ + + ! I/O variables + integer, intent(in) :: ims,ime,jms,jme,kms,kme, & + its,ite,jts,jte,kts,kte + + real, dimension(ims:ime, kms:kme, jms:jme), intent(in) :: p, & ! pressure (Pa) + t3d, & ! temperature (K) + dz8w, & ! dz between full levels (m) + qv3d ! water vapor mixing ratio (kg/kg) +!-- MPAS modifications: aer_type is a function of the land-sea mask, and set to 1 over land (or rural classification in WRF), +! and set to 0 over oceans (or maritime classification in WRF): +! integer, intent(in) :: aer_type + integer, dimension(ims:ime,jms:jme), intent(in):: aer_type + character(len=256):: wrf_err_message +!-- end MPAS modifications.. + integer, intent(in) :: aer_aod550_opt, aer_angexp_opt, aer_ssa_opt, aer_asy_opt + real, intent(in) :: aer_aod550_val, aer_angexp_val, aer_ssa_val, aer_asy_val + + real, dimension(ims:ime, jms:jme), intent(in) :: ht + real, dimension(ims:ime, jms:jme), optional, intent(inout) :: aod5502d, angexp2d, aerssa2d, aerasy2d + real, dimension(ims:ime, kms:kme, jms:jme, 1:N_BANDS), intent(inout) :: tauaer, ssaaer, asyaer + + real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(in) :: aod5503d ! trude + + ! local variables + real :: angexp_val,aod_rate,x,xy,xx + real, dimension(ims:ime, jms:jme, 1:N_BANDS) :: aod550spc + real, dimension(ims:ime, kms:kme, jms:jme, 1:N_BANDS) :: aod550spc3d ! trude + real, dimension(ims:ime, kms:kme, jms:jme) :: rh ! relative humidity + + call calc_relative_humidity(p,t3d,qv3d, & + ims,ime,jms,jme,kms,kme, & + its,ite,jts,jte,kts,kte, & + rh ) + + aer_aod550_opt_select: select case(aer_aod550_opt) + !case(0) + ! reserved for climatology + case(1) + if (aer_aod550_val .lt. 0) then + write(wrf_err_message,'("aer_aod550_val must be positive. Negative value ",F7.4," found")') aer_aod550_val + FATAL_ERROR(trim(wrf_err_message)) + end if + write( wrf_err_message, '("aer_aod550_opt=",I1,": AOD@550 nm fixed to value ",F6.3)') aer_aod550_opt,aer_aod550_val + WRITE_MESSAGE(trim(wrf_err_message)) + do j=jts,jte + do i=its,ite + aod5502d(i,j)=aer_aod550_val + end do + end do + + case(2) + if (.not.(present(aod5502d))) then + write(wrf_err_message,*) 'Expected gridded total AOD@550 nm, but it is not in the radiation driver' + FATAL_ERROR(trim(wrf_err_message)) + end if + if (minval(aod5502d) .lt. 0) then + FATAL_ERROR('AOD@550 must be positive. Negative value(s) found in auxinput') + end if +! call mpas_log_write('--- aer_aod550_opt = $i: AOD@550 nm read from auxinput min = $r max = $r', & +! intArgs=(/aer_aod550_opt/),realArgs=(/minval(aod5502d(its:ite,jts:jte)), & +! maxval(aod5502d(its:ite,jts:jte))/)) + case default + write(wrf_err_message,*) 'Expected aer_aod550_opt=[1,2]. Got',aer_aod550_opt + FATAL_ERROR(trim(wrf_err_message)) + end select aer_aod550_opt_select + + + ! here, the 3d aod550 is calculated according to the aer_angexp_opt case + aer_angexp_opt_select: select case(aer_angexp_opt) + !case(0) + ! reserved for climatology + case(1) + if (aer_angexp_val .lt. -0.3) then + write(wrf_err_message,'("WARNING: aer_angexp_val limited to -0.3. Illegal value ",F7.4," found")') aer_angexp_val + WRITE_MESSAGE(trim(wrf_err_message)) + end if + if (aer_angexp_val .gt. 2.5) then + write(wrf_err_message,'("WARNING: aer_angexp_val limited to 2.5. Illegal value ",F7.4," found")') aer_angexp_val + WRITE_MESSAGE(trim(wrf_err_message)) + end if + write( wrf_err_message , '("aer_angexp_opt=",I1,": Aerosol Angstrom exponent fixed to value ",F6.3)') & + aer_angexp_opt,aer_angexp_val + WRITE_MESSAGE(trim(wrf_err_message)) + angexp_val=min(2.5,max(-0.3,aer_angexp_val)) + do nb=1,N_BANDS + if ((angexp_val .lt. 0.999) .or. (angexp_val .gt. 1.001)) then + aod_rate=((0.55**angexp_val)*(upper_wvl(nb)**(1.-angexp_val)- & + lower_wvl(nb)**(1.-angexp_val)))/((1.-angexp_val)*(upper_wvl(nb)-lower_wvl(nb))) + else + aod_rate=(0.55/(upper_wvl(nb)-lower_wvl(nb)))*log(upper_wvl(nb)/lower_wvl(nb)) + end if + do j=jts,jte + do i=its,ite + aod550spc(i,j,nb)=aod5502d(i,j)*aod_rate + end do + end do + end do + do j=jts,jte + do i=its,ite + angexp2d(i,j)=angexp_val + end do + end do + case(2) + if (.not.(present(angexp2d))) then + write(wrf_err_message,*) 'Expected gridded aerosol Angstrom exponent, but it is not in the radiation driver' + FATAL_ERROR(trim(wrf_err_message)) + end if + write( wrf_err_message, '("aer_angexp_opt=",I1,": Angstrom exponent read from auxinput (min=",F6.3," max=",F6.3,")")') & + aer_angexp_opt,minval(angexp2d),maxval(angexp2d) + WRITE_MESSAGE(trim(wrf_err_message)) + do j=jts,jte + do i=its,ite + angexp_val=min(2.5,max(-0.3,angexp2d(i,j))) + do nb=1,N_BANDS + if ((angexp_val .lt. 0.999) .or. (angexp_val .gt. 1.001)) then + aod_rate=((0.55**angexp_val)*(upper_wvl(nb)**(1.-angexp_val)- & + lower_wvl(nb)**(1.-angexp_val)))/((1.-angexp_val)*(upper_wvl(nb)-lower_wvl(nb))) + else + aod_rate=(0.55/(upper_wvl(nb)-lower_wvl(nb)))*log(upper_wvl(nb)/lower_wvl(nb)) + end if + aod550spc(i,j,nb)=aod5502d(i,j)*aod_rate + end do + end do + end do + + case(3) + ! spectral disaggregation based on a prescribed aerosol type and relative humidity +! call mpas_log_write('--- aer_angexp_opt = $i: angstrom exponent calculated from RH and aer_type $i', & +! intArgs=(/aer_angexp_opt,aer_type/)) + call calc_spectral_aod_rrtmg_sw(ims,ime,jms,jme,kms,kme, & + its,ite,jts,jte,kts,kte, & + rh,aer_type,aod5502d, & + aod550spc, & + aod5503d, aod550spc3d) ! trude + +!-- MPAS modifications: we do not need the variable angexp2d outside of subroutine calc_aerosol_rrtmg_sw. Since it is +! declared as an optional variable, we simply test if it is present or not (Laura D. Fowler/2019-01-13): + if(present(angexp2d)) then + do j=jts,jte + do i=its,ite + angexp2d(i,j) = 0.0 + enddo + enddo + + if (present(aod5503d)) then + do j=jts,jte + do k=kts,kte + do i=its,ite + xy=0 + xx=0 + do nb=8,N_BANDS-3 ! bands between 0.4 and 1.0 um + ! the slope of a linear regression with intercept=0 is m=E(xy)/E(x^2), where y=m*x + x=log(0.5*(lower_wvl(nb)+upper_wvl(nb))/0.55) + xy=xy+x*log(aod550spc3d(i,k,j,nb)/aod5503d(i,k,j)) + xx=xx+x*x + end do + angexp2d(i,j) = angexp2d(i,j) - (xy/(N_BANDS-3-8+1))/(xx/(N_BANDS-3-8+1)) + enddo + enddo + enddo + else + + ! added July, 16th, 2013: angexp2d is in the wrfout when aer_angexp_opt=3. It is the average + ! value in the spectral bands between 0.4 and 1. um + do j=jts,jte + do i=its,ite + xy=0 + xx=0 + do nb=8,N_BANDS-3 ! bands between 0.4 and 1.0 um + ! the slope of a linear regression with intercept=0 is m=E(xy)/E(x^2), where y=m*x + x=log(0.5*(lower_wvl(nb)+upper_wvl(nb))/0.55) + xy=xy+x*log(aod550spc(i,j,nb)/aod5502d(i,j)) + xx=xx+x*x + end do + angexp2d(i,j)=-(xy/(N_BANDS-3-8+1))/(xx/(N_BANDS-3-8+1)) + end do + end do + endif + endif ! end MPAS modifications. + + case default + write(wrf_err_message,*) 'Expected aer_angexp_opt=[1,2,3]. Got',aer_angexp_opt + FATAL_ERROR(trim(wrf_err_message)) + end select aer_angexp_opt_select + +!..If 3D AOD (at 550nm) was provided explicitly, then no need to assume a +!.. vertical distribution, just use what was provided. (Trude) + + if (present(aod5503d)) then + do nb=1,N_BANDS + do j=jts,jte + do k=kts,kte + do i=its,ite + tauaer(i,k,j,nb) = aod550spc3d(i,k,j,nb) + enddo + enddo + enddo + enddo + else + ! exponental -vertical- profile + call aod_profiler(ht,dz8w,aod550spc,n_bands,ims,ime,jms,jme,kms,kme, & + its,ite,jts,jte,kts,kte,tauaer ) + endif + + aer_ssa_opt_select: select case(aer_ssa_opt) + !case(0) + ! reserved for climatology + case(1) + if ((aer_ssa_val .lt. 0) .or. (aer_ssa_val .gt. 1)) then + write(wrf_err_message,'("aer_ssa_val must be within [0,1]. Illegal value ",F7.4," found")') aer_ssa_val + FATAL_ERROR(trim(wrf_err_message)) + end if + write( wrf_err_message, & + '("aer_ssa_opt=",I1,": single-scattering albedo fixed to value ",F6.3)') aer_ssa_opt,aer_ssa_val + WRITE_MESSAGE(trim(wrf_err_message)) + do j=jts,jte + do i=its,ite + do k=kts,kte + do nb=1,N_BANDS + ! no spectral disaggregation + ssaaer(i,k,j,nb)=aer_ssa_val + end do + end do + end do + end do + do j=jts,jte + do i=its,ite + aerssa2d(i,j)=aer_ssa_val + end do + end do + + case(2) + if (.not.(present(aerssa2d))) then + write(wrf_err_message,*) 'Expected gridded aerosol single-scattering albedo, but it is not in the radiation driver' + FATAL_ERROR(trim(wrf_err_message)) + end if + if ((minval(aerssa2d) .lt. 0) .or. (maxval(aerssa2d) .gt. 1)) then + write(wrf_err_message,*) 'Aerosol single-scattering albedo must be within [0,1]. ' // & + 'Out of bounds value(s) found in auxinput' + FATAL_ERROR(trim(wrf_err_message)) + end if + write( wrf_err_message, '("aer_ssa_opt=",I1,": single-scattering albedo from auxinput (min=",F6.3," max=",F6.3,")")') & + aer_ssa_opt,minval(aerssa2d),maxval(aerssa2d) + WRITE_MESSAGE(trim(wrf_err_message)) + do j=jts,jte + do i=its,ite + do k=kts,kte + do nb=1,N_BANDS + ! no spectral disaggregation + ssaaer(i,k,j,nb)=aerssa2d(i,j) + end do + end do + end do + end do + + case(3) + ! spectral disaggregation based on a prescribed aerosol type and relative humidity +! call mpas_log_write('--- aer_ssa_opt = $i: single-scattering albedo calculated from RH and aer_type $i', & +! intArgs=(/aer_ssa_opt,aer_type/)) + call calc_spectral_ssa_rrtmg_sw(ims,ime,jms,jme,kms,kme, & + its,ite,jts,jte,kts,kte, & + rh,aer_type,ssaaer ) +!-- MPAS modifications: we do not need the variable aerssa2d outside of subroutine calc_aerosol_rrtmg_sw. Since it is +! declared as an optional variable, we simply test if it is present or not (Laura D. Fowler/2018=04-09): + if(present(aerssa2d)) then + ! added July, 16th, 2013: aerssa2d is in the wrfout when aer_ssa_opt=3. It is the average + ! value in the spectral bands between 0.4 and 1. um + do j=jts,jte + do i=its,ite + aerssa2d(i,j)=0 + end do + end do + do j=jts,jte + do i=its,ite + do nb=8,N_BANDS-3 ! bands between 0.4 and 1.0 um + aerssa2d(i,j)=aerssa2d(i,j)+ssaaer(i,kts,j,nb) + end do + aerssa2d(i,j)=aerssa2d(i,j)/(N_BANDS-3-8+1) + end do + end do + endif ! end MPAS modifications. + + case default + write(wrf_err_message,*) 'Expected aer_ssa_opt=[1,2,3]. Got',aer_ssa_opt + FATAL_ERROR(trim(wrf_err_message)) + end select aer_ssa_opt_select + + aer_asy_opt_select: select case(aer_asy_opt) + !case(0) + ! reserved for climatology + case(1) + if ((aer_asy_val .lt. 0) .or. (aer_asy_val .gt. 1)) then + write(wrf_err_message,'("aer_asy_val must be withing [-1,1]. Illegal value ",F7.4," found")') aer_asy_val + FATAL_ERROR(trim(wrf_err_message)) + end if + write( wrf_err_message , '("aer_asy_opt=",I1,": asymmetry parameter fixed to value ",F6.3)') aer_asy_opt,aer_asy_val + WRITE_MESSAGE(trim(wrf_err_message)) + do j=jts,jte + do i=its,ite + do k=kts,kte + do nb=1,N_BANDS + asyaer(i,k,j,nb)=aer_asy_val + end do + end do + end do + end do + do j=jts,jte + do i=its,ite + aerasy2d(i,j)=aer_asy_val + end do + end do + + case(2) + if (.not.(present(aerasy2d))) then + write(wrf_err_message,*) 'Expected gridded aerosol asymmetry parameter, but it is not in the radiation driver' + FATAL_ERROR(trim(wrf_err_message)) + end if + if ((minval(aerasy2d) .lt. -1) .or. (maxval(aerasy2d) .gt. 1)) then + FATAL_ERROR('Aerosol asymmetry parameter must be within [-1,1]. Out of bounds value(s) found in auxinput') + end if + write( wrf_err_message, '("aer_asy_opt=",I1,": asymmetry parameter read from auxinput (min=",F6.3," max=",F6.3,")")') & + aer_asy_opt,minval(aerasy2d),maxval(aerasy2d) + WRITE_MESSAGE(trim(wrf_err_message)) + do j=jts,jte + do i=its,ite + do k=kts,kte + do nb=1,N_BANDS + asyaer(i,k,j,nb)=aerasy2d(i,j) + end do + end do + end do + end do + + case(3) + ! spectral disaggregation based on a prescribed aerosol type and relative humidity +! call mpas_log_write('--- aer_asy_opt = $i: asymmetry parameter calculated from RH and aer_type $i', & +! intArgs=(/aer_asy_opt,aer_type/)) + call calc_spectral_asy_rrtmg_sw(ims,ime,jms,jme,kms,kme, & + its,ite,jts,jte,kts,kte, & + rh,aer_type,asyaer ) +!-- MPAS modifications: we do not need the variable aerasy2d outside of subroutine calc_aerosol_rrtmg_sw. Since it is +! declared as an optional variable, we simply test if it is present or not (Laura D. Fowler/2018=04-09): + if(present(aerasy2d)) then + ! added July, 16th, 2013: aerasy2d is in the wrfout when aer_asy_opt=3. It is the average + ! value in the spectral bands between 0.4 and 1. um + do j=jts,jte + do i=its,ite + aerasy2d(i,j)=0 + end do + end do + do j=jts,jte + do i=its,ite + do nb=8,N_BANDS-3 ! bands between 0.4 and 1.0 um + aerasy2d(i,j)=aerasy2d(i,j)+asyaer(i,kts,j,nb) + end do + aerasy2d(i,j)=aerasy2d(i,j)/(N_BANDS-3-8+1) + end do + end do + endif ! end MPAS modifications. + + case default + write(wrf_err_message,*) 'Expected aer_asy_opt=[1,2,3]. Got',aer_asy_opt + FATAL_ERROR(trim(wrf_err_message)) + end select aer_asy_opt_select + +end subroutine calc_aerosol_rrtmg_sw + +subroutine calc_spectral_aod_rrtmg_sw(ims,ime,jms,jme,kms,kme, & + its,ite,jts,jte,kts,kte, & + rh,aer_type,aod550, & + tauaer, & + aod550_3d, tauaer3d) ! trude + + implicit none + + ! constants + integer, parameter :: N_AER_TYPES=3 + integer, parameter :: N_RH=8 + integer, parameter :: N_BANDS=14 + integer, parameter :: N_INT_POINTS=4 + + ! I/O variables + integer, intent(in) :: ims,ime,jms,jme,kms,kme, & + its,ite,jts,jte,kts,kte +!- MPAS modifications: aer_type is a function of the land-sea mask, and set to 1 over land (or rural classification in WRF), +! and set to 0 over oceans (or maritime classification in WRF): +! integer, intent(in) :: aer_type + integer:: aer_t + integer, dimension(ims:ime,jms:jme), intent(in):: aer_type +!- end MPAS modifications (Laura D. Fowler/2018=04-09). + + real, dimension(ims:ime, kms:kme, jms:jme), intent(in) :: rh ! relative humidity + real, dimension(ims:ime, jms:jme), intent(in) :: aod550 ! Total AOD at 550 nm at surface + real, dimension(ims:ime, jms:jme, 1:N_BANDS), intent(inout) :: tauaer ! Total spectral aerosol optical depth at surface + + ! ++ Trude + real, dimension(ims:ime, kms:kme, jms:jme), optional, intent(in) :: aod550_3d ! 3D AOD at 550 nm + real, dimension(ims:ime, kms:kme, jms:jme, 1:N_BANDS), optional, intent(inout) :: tauaer3d ! + ! -- Trude + + ! local variables + integer :: i,j,k,ib,imax,imin,ii,jj,kk + real :: rhs(N_RH),lj + real :: raod_lut(N_AER_TYPES,N_BANDS,N_RH) + + ! relative humidity steps + data (rhs(i),i=1,8) /0.,50.,70.,80.,90.,95.,98.,99./ + + ! aer_type = 1 : rural (SF79) + data (raod_lut(1,ib,1),ib=1,N_BANDS) /0.0735,0.0997,0.1281,0.1529,0.1882,0.2512,0.3010,0.4550,0.7159,1.0357, & + 1.3582,1.6760,2.2523,0.0582/ + data (raod_lut(1,ib,2),ib=1,N_BANDS) /0.0741,0.1004,0.1289,0.1537,0.1891,0.2522,0.3021,0.4560,0.7166,1.0351, & + 1.3547,1.6687,2.2371,0.0587/ + data (raod_lut(1,ib,3),ib=1,N_BANDS) /0.0752,0.1017,0.1304,0.1554,0.1909,0.2542,0.3042,0.4580,0.7179,1.0342, & + 1.3485,1.6559,2.2102,0.0596/ + data (raod_lut(1,ib,4),ib=1,N_BANDS) /0.0766,0.1034,0.1323,0.1575,0.1932,0.2567,0.3068,0.4605,0.7196,1.0332, & + 1.3411,1.6407,2.1785,0.0608/ + data (raod_lut(1,ib,5),ib=1,N_BANDS) /0.0807,0.1083,0.1379,0.1635,0.1998,0.2639,0.3143,0.4677,0.7244,1.0305, & + 1.3227,1.6031,2.1006,0.0644/ + data (raod_lut(1,ib,6),ib=1,N_BANDS) /0.0884,0.1174,0.1482,0.1746,0.2118,0.2769,0.3277,0.4805,0.7328,1.0272, & + 1.2977,1.5525,1.9976,0.0712/ + data (raod_lut(1,ib,7),ib=1,N_BANDS) /0.1072,0.1391,0.1724,0.2006,0.2396,0.3066,0.3581,0.5087,0.7510,1.0231, & + 1.2622,1.4818,1.8565,0.0878/ + data (raod_lut(1,ib,8),ib=1,N_BANDS) /0.1286,0.1635,0.1991,0.2288,0.2693,0.3377,0.3895,0.5372,0.7686,1.0213, & + 1.2407,1.4394,1.7739,0.1072/ + + ! aer_type = 2 : urban (SF79) + data (raod_lut(2,ib,1),ib=1,N_BANDS) /0.1244,0.1587,0.1939,0.2233,0.2635,0.3317,0.3835,0.5318,0.7653,1.0344, & + 1.3155,1.5885,2.0706,0.1033/ + data (raod_lut(2,ib,2),ib=1,N_BANDS) /0.1159,0.1491,0.1834,0.2122,0.2518,0.3195,0.3712,0.5207,0.7585,1.0331, & + 1.3130,1.5833,2.0601,0.0956/ + data (raod_lut(2,ib,3),ib=1,N_BANDS) /0.1093,0.1416,0.1752,0.2035,0.2427,0.3099,0.3615,0.5118,0.7529,1.0316, & + 1.3083,1.5739,2.0408,0.0898/ + data (raod_lut(2,ib,4),ib=1,N_BANDS) /0.1062,0.1381,0.1712,0.1993,0.2382,0.3052,0.3567,0.5074,0.7501,1.0302, & + 1.3025,1.5620,2.0168,0.0870/ + data (raod_lut(2,ib,5),ib=1,N_BANDS) /0.1045,0.1361,0.1690,0.1970,0.2357,0.3025,0.3540,0.5049,0.7486,1.0271, & + 1.2864,1.5297,1.9518,0.0854/ + data (raod_lut(2,ib,6),ib=1,N_BANDS) /0.1065,0.1384,0.1716,0.1997,0.2386,0.3056,0.3571,0.5078,0.7504,1.0227, & + 1.2603,1.4780,1.8492,0.0872/ + data (raod_lut(2,ib,7),ib=1,N_BANDS) /0.1147,0.1478,0.1820,0.2107,0.2503,0.3179,0.3696,0.5192,0.7575,1.0146, & + 1.2116,1.3830,1.6658,0.0946/ + data (raod_lut(2,ib,8),ib=1,N_BANDS) /0.1247,0.1590,0.1943,0.2237,0.2639,0.3322,0.3840,0.5322,0.7656,1.0082, & + 1.1719,1.3075,1.5252,0.1036/ + + ! aer_type = 3 : maritime (SF79) + data (raod_lut(3,ib,1),ib=1,N_BANDS) /0.3053,0.3507,0.3932,0.4261,0.4681,0.5334,0.5797,0.6962,0.8583,1.0187, & + 1.1705,1.3049,1.5205,0.2748/ + data (raod_lut(3,ib,2),ib=1,N_BANDS) /0.3566,0.4023,0.4443,0.4765,0.5170,0.5792,0.6227,0.7298,0.8756,1.0162, & + 1.1472,1.2614,1.4415,0.3256/ + data (raod_lut(3,ib,3),ib=1,N_BANDS) /0.4359,0.4803,0.5203,0.5505,0.5879,0.6441,0.6828,0.7756,0.8985,1.0135, & + 1.1198,1.2109,1.3518,0.4051/ + data (raod_lut(3,ib,4),ib=1,N_BANDS) /0.5128,0.5544,0.5913,0.6187,0.6523,0.7020,0.7358,0.8149,0.9174,1.0115, & + 1.0995,1.1740,1.2875,0.4835/ + data (raod_lut(3,ib,5),ib=1,N_BANDS) /0.6479,0.6816,0.7108,0.7320,0.7575,0.7946,0.8193,0.8752,0.9455,1.0092, & + 1.0728,1.1263,1.2061,0.6236/ + data (raod_lut(3,ib,6),ib=1,N_BANDS) /0.7582,0.7831,0.8043,0.8196,0.8377,0.8636,0.8806,0.9184,0.9649,1.0080, & + 1.0564,1.0973,1.1576,0.7399/ + data (raod_lut(3,ib,7),ib=1,N_BANDS) /0.8482,0.8647,0.8785,0.8884,0.9000,0.9164,0.9272,0.9506,0.9789,1.0072, & + 1.0454,1.0780,1.1256,0.8360/ + data (raod_lut(3,ib,8),ib=1,N_BANDS) /0.8836,0.8965,0.9073,0.9149,0.9239,0.9365,0.9448,0.9626,0.9841,1.0069, & + 1.0415,1.0712,1.1145,0.8741/ + +! ++ Trude ; if 3D AOD, disaggreaget at all levels. + if (present(aod550_3d)) then + do j=jts,jte + do i=its,ite + !-- initialization of aerosol type: + aer_t = aer_type(i,j) + ! common part of the Lagrange's interpolator + ! only depends on the relative humidity value + do kk = kts,kte + ii=1 + do while ( (ii.le.N_RH) .and. (rh(i,kk,j).gt.rhs(ii)) ) + ii=ii+1 + end do + imin=max(1,ii-N_INT_POINTS/2-1) + imax=min(N_RH,ii+N_INT_POINTS/2) + + do ib=1,N_BANDS + tauaer3d(i,kk,j,ib)=0. + do jj=imin,imax + lj=1. + do k=imin,imax + if (k.ne.jj) lj=lj*(rh(i,kk,j)-rhs(k))/(rhs(jj)-rhs(k)) + end do + tauaer3d(i,kk,j,ib)=tauaer3d(i,kk,j,ib)+lj*raod_lut(aer_t,ib,jj)*aod550_3d(i,kk,j) + end do + end do + end do + end do + end do + else +! -- Trude + + do j=jts,jte + do i=its,ite + !-- initialization of aerosol type: + aer_t = aer_type(i,j) + ! common part of the Lagrange's interpolator + ! only depends on the relative humidity value + ii=1 + do while ( (ii.le.N_RH) .and. (rh(i,kts,j).gt.rhs(ii)) ) + ii=ii+1 + end do + imin=max(1,ii-N_INT_POINTS/2-1) + imax=min(N_RH,ii+N_INT_POINTS/2) + + do ib=1,N_BANDS + tauaer(i,j,ib)=0. + do jj=imin,imax + lj=1. + do k=imin,imax + if (k.ne.jj) lj=lj*(rh(i,kts,j)-rhs(k))/(rhs(jj)-rhs(k)) + end do + tauaer(i,j,ib)=tauaer(i,j,ib)+lj*raod_lut(aer_t,ib,jj)*aod550(i,j) + end do + end do + end do + end do + endif + +end subroutine calc_spectral_aod_rrtmg_sw + +subroutine calc_spectral_ssa_rrtmg_sw(ims,ime,jms,jme,kms,kme, & + its,ite,jts,jte,kts,kte, & + rh,aer_type, & + ssaaer ) + implicit none + + ! constants + integer, parameter :: N_AER_TYPES=3 + integer, parameter :: N_RH=8 + integer, parameter :: N_BANDS=14 + integer, parameter :: N_INT_POINTS=4 + + ! I/O variables + integer, intent(in) :: ims,ime,jms,jme,kms,kme, & + its,ite,jts,jte,kts,kte +!- MPAS modifications: aer_type is a function of the land-sea mask, and set to 1 over land (or rural classification in WRF), +! and set to 0 over oceans (or maritime classification in WRF): +! integer, intent(in) :: aer_type + integer:: aer_t + integer, dimension(ims:ime,jms:jme), intent(in):: aer_type +!- end MPAS modifications (Laura D. Fowler/2018=04-09). + real, dimension(ims:ime, kms:kme, jms:jme), intent(in) :: rh ! surface relative humidity + real, dimension(ims:ime, kms:kme, jms:jme, 1:N_BANDS), intent(inout) :: ssaaer ! aerosol single-scattering albedo at surface + + ! local variables + integer :: i,j,k,kk,ib,imax,imin,ii,jj + real :: rhs(N_RH),lj + real :: ssa_lut(N_AER_TYPES,N_BANDS,N_RH) + + ! relative humidity steps + data (rhs(i),i=1,8) /0.,50.,70.,80.,90.,95.,98.,99./ + + ! aer_type = 1 : rural (SF79) + data (ssa_lut(1,ib,1),ib=1,N_BANDS) /0.8730,0.6695,0.8530,0.8601,0.8365,0.7949,0.8113,0.8810,0.9305,0.9436, & + 0.9532,0.9395,0.8007,0.8634/ + data (ssa_lut(1,ib,2),ib=1,N_BANDS) /0.8428,0.6395,0.8571,0.8645,0.8408,0.8007,0.8167,0.8845,0.9326,0.9454, & + 0.9545,0.9416,0.8070,0.8589/ + data (ssa_lut(1,ib,3),ib=1,N_BANDS) /0.8000,0.6025,0.8668,0.8740,0.8503,0.8140,0.8309,0.8943,0.9370,0.9489, & + 0.9577,0.9451,0.8146,0.8548/ + data (ssa_lut(1,ib,4),ib=1,N_BANDS) /0.7298,0.5666,0.9030,0.9049,0.8863,0.8591,0.8701,0.9178,0.9524,0.9612, & + 0.9677,0.9576,0.8476,0.8578/ + data (ssa_lut(1,ib,5),ib=1,N_BANDS) /0.7010,0.5606,0.9312,0.9288,0.9183,0.9031,0.9112,0.9439,0.9677,0.9733, & + 0.9772,0.9699,0.8829,0.8590/ + data (ssa_lut(1,ib,6),ib=1,N_BANDS) /0.6933,0.5620,0.9465,0.9393,0.9346,0.9290,0.9332,0.9549,0.9738,0.9782, & + 0.9813,0.9750,0.8980,0.8594/ + data (ssa_lut(1,ib,7),ib=1,N_BANDS) /0.6842,0.5843,0.9597,0.9488,0.9462,0.9470,0.9518,0.9679,0.9808,0.9839, & + 0.9864,0.9794,0.9113,0.8648/ + data (ssa_lut(1,ib,8),ib=1,N_BANDS) /0.6786,0.5897,0.9658,0.9522,0.9530,0.9610,0.9651,0.9757,0.9852,0.9871, & + 0.9883,0.9835,0.9236,0.8618/ + + ! aer_type = 2: urban (SF79) + data (ssa_lut(2,ib,1),ib=1,N_BANDS) /0.4063,0.3663,0.4093,0.4205,0.4487,0.4912,0.5184,0.5743,0.6233,0.6392, & + 0.6442,0.6408,0.6105,0.4094/ + data (ssa_lut(2,ib,2),ib=1,N_BANDS) /0.4113,0.3654,0.4215,0.4330,0.4604,0.5022,0.5293,0.5848,0.6336,0.6493, & + 0.6542,0.6507,0.6205,0.4196/ + data (ssa_lut(2,ib,3),ib=1,N_BANDS) /0.4500,0.3781,0.4924,0.5050,0.5265,0.5713,0.6048,0.6274,0.6912,0.7714, & + 0.7308,0.7027,0.6772,0.4820/ + data (ssa_lut(2,ib,4),ib=1,N_BANDS) /0.5075,0.4139,0.5994,0.6127,0.6350,0.6669,0.6888,0.7333,0.7704,0.7809, & + 0.7821,0.7762,0.7454,0.5709/ + data (ssa_lut(2,ib,5),ib=1,N_BANDS) /0.5596,0.4570,0.7009,0.7118,0.7317,0.7583,0.7757,0.8093,0.8361,0.8422, & + 0.8406,0.8337,0.8036,0.6525/ + data (ssa_lut(2,ib,6),ib=1,N_BANDS) /0.6008,0.4971,0.7845,0.7906,0.8075,0.8290,0.8418,0.8649,0.8824,0.8849, & + 0.8815,0.8739,0.8455,0.7179/ + data (ssa_lut(2,ib,7),ib=1,N_BANDS) /0.6401,0.5407,0.8681,0.8664,0.8796,0.8968,0.9043,0.9159,0.9244,0.9234, & + 0.9182,0.9105,0.8849,0.7796/ + data (ssa_lut(2,ib,8),ib=1,N_BANDS) /0.6567,0.5618,0.9073,0.9077,0.9182,0.9279,0.9325,0.9398,0.9440,0.9413, & + 0.9355,0.9278,0.9039,0.8040/ + + ! aer_type = 3 : maritime (SF79) + data (ssa_lut(3,ib,1),ib=1,N_BANDS) /0.9697,0.9183,0.9749,0.9820,0.9780,0.9712,0.9708,0.9778,0.9831,0.9827, & + 0.9826,0.9723,0.8763,0.9716/ + data (ssa_lut(3,ib,2),ib=1,N_BANDS) /0.9070,0.8491,0.9730,0.9816,0.9804,0.9742,0.9738,0.9802,0.9847,0.9841, & + 0.9838,0.9744,0.8836,0.9546/ + data (ssa_lut(3,ib,3),ib=1,N_BANDS) /0.8378,0.7761,0.9797,0.9827,0.9829,0.9814,0.9812,0.9852,0.9882,0.9875, & + 0.9871,0.9791,0.9006,0.9348/ + data (ssa_lut(3,ib,4),ib=1,N_BANDS) /0.7866,0.7249,0.9890,0.9822,0.9856,0.9917,0.9924,0.9932,0.9943,0.9938, & + 0.9933,0.9887,0.9393,0.9204/ + data (ssa_lut(3,ib,5),ib=1,N_BANDS) /0.7761,0.7164,0.9959,0.9822,0.9834,0.9941,0.9955,0.9952,0.9960,0.9956, & + 0.9951,0.9922,0.9538,0.9152/ + data (ssa_lut(3,ib,6),ib=1,N_BANDS) /0.7671,0.7114,0.9902,0.9786,0.9838,0.9954,0.9970,0.9965,0.9971,0.9968, & + 0.9964,0.9943,0.9644,0.9158/ + data (ssa_lut(3,ib,7),ib=1,N_BANDS) /0.7551,0.7060,0.9890,0.9743,0.9807,0.9966,0.9989,0.9978,0.9982,0.9980, & + 0.9978,0.9964,0.9757,0.9122/ + data (ssa_lut(3,ib,8),ib=1,N_BANDS) /0.7439,0.7000,0.9870,0.9695,0.9769,0.9970,1.0000,0.9984,0.9988,0.9986, & + 0.9984,0.9975,0.9825,0.9076/ + + do j=jts,jte + do i=its,ite + !-- initialization of aerosol type: + aer_t = aer_type(i,j) + do k=kts,kte + ! common part of the Lagrange's interpolator + ! only depends on the relative humidity value + ii=1 + do while ( (ii.le.N_RH) .and. (rh(i,k,j).gt.rhs(ii)) ) + ii=ii+1 + end do + imin=max(1,ii-N_INT_POINTS/2-1) + imax=min(N_RH,ii+N_INT_POINTS/2) + + do ib=1,N_BANDS + ssaaer(i,k,j,ib)=0. + do jj=imin,imax + lj=1. + do kk=imin,imax + if (kk.ne.jj) lj=lj*(rh(i,k,j)-rhs(kk))/(rhs(jj)-rhs(kk)) + end do + ssaaer(i,k,j,ib)=ssaaer(i,k,j,ib)+lj*ssa_lut(aer_t,ib,jj) + end do + end do + end do + end do + end do +end subroutine calc_spectral_ssa_rrtmg_sw + +subroutine calc_spectral_asy_rrtmg_sw(ims,ime,jms,jme,kms,kme, & + its,ite,jts,jte,kts,kte, & + rh,aer_type, & + asyaer ) + implicit none + + ! constants + integer, parameter :: N_AER_TYPES=3 + integer, parameter :: N_RH=8 + integer, parameter :: N_BANDS=14 + integer, parameter :: N_INT_POINTS=4 + + ! I/O variables + integer, intent(in) :: ims,ime,jms,jme,kms,kme, & + its,ite,jts,jte,kts,kte +!- MPAS modifications: aer_type is a function of the land-sea mask, and set to 1 over land (or rural classification in WRF), +! and set to 0 over oceans (or maritime classification in WRF): +! integer, intent(in) :: aer_type + integer:: aer_t + integer, dimension(ims:ime,jms:jme), intent(in):: aer_type +!- end MPAS modifications (Laura D. Fowler/2018=04-09). + real, dimension(ims:ime, kms:kme, jms:jme), intent(in) :: rh ! surface relative humidity + real, dimension(ims:ime, kms:kme, jms:jme, 1:N_BANDS), intent(inout) :: asyaer ! aerosol asymmetry parameter at surface + + ! local variables + integer :: i,j,k,kk,ib,imax,imin,ii,jj + real :: rhs(N_RH),lj + real :: asy_lut(N_AER_TYPES,N_BANDS,N_RH) + + ! relative humidity steps + data (rhs(i),i=1,8) /0.,50.,70.,80.,90.,95.,98.,99./ + + ! aer_type = 1 : rural (SF79) + data (asy_lut(1,ib,1),ib=1,N_BANDS) /0.7444,0.7711,0.7306,0.7103,0.6693,0.6267,0.6169,0.6207,0.6341,0.6497, & + 0.6630,0.6748,0.7208,0.7419/ + data (asy_lut(1,ib,2),ib=1,N_BANDS) /0.7444,0.7747,0.7314,0.7110,0.6711,0.6301,0.6210,0.6251,0.6392,0.6551, & + 0.6680,0.6799,0.7244,0.7436/ + data (asy_lut(1,ib,3),ib=1,N_BANDS) /0.7438,0.7845,0.7341,0.7137,0.6760,0.6381,0.6298,0.6350,0.6497,0.6657, & + 0.6790,0.6896,0.7300,0.7477/ + data (asy_lut(1,ib,4),ib=1,N_BANDS) /0.7336,0.7934,0.7425,0.7217,0.6925,0.6665,0.6616,0.6693,0.6857,0.7016, & + 0.7139,0.7218,0.7495,0.7574/ + data (asy_lut(1,ib,5),ib=1,N_BANDS) /0.7111,0.7865,0.7384,0.7198,0.6995,0.6864,0.6864,0.6987,0.7176,0.7326, & + 0.7427,0.7489,0.7644,0.7547/ + data (asy_lut(1,ib,6),ib=1,N_BANDS) /0.7009,0.7828,0.7366,0.7196,0.7034,0.6958,0.6979,0.7118,0.7310,0.7452, & + 0.7542,0.7593,0.7692,0.7522/ + data (asy_lut(1,ib,7),ib=1,N_BANDS) /0.7226,0.8127,0.7621,0.7434,0.7271,0.7231,0.7248,0.7351,0.7506,0.7622, & + 0.7688,0.7719,0.7756,0.7706/ + data (asy_lut(1,ib,8),ib=1,N_BANDS) /0.7296,0.8219,0.7651,0.7513,0.7404,0.7369,0.7386,0.7485,0.7626,0.7724, & + 0.7771,0.7789,0.7790,0.7760/ + + ! aer_type = 2: urban (SF79) + data (asy_lut(2,ib,1),ib=1,N_BANDS) /0.7399,0.7372,0.7110,0.6916,0.6582,0.6230,0.6147,0.6214,0.6412,0.6655, & + 0.6910,0.7124,0.7538,0.7395/ + data (asy_lut(2,ib,2),ib=1,N_BANDS) /0.7400,0.7419,0.7146,0.6952,0.6626,0.6287,0.6209,0.6280,0.6481,0.6723, & + 0.6974,0.7180,0.7575,0.7432/ + data (asy_lut(2,ib,3),ib=1,N_BANDS) /0.7363,0.7614,0.7303,0.7100,0.6815,0.6550,0.6498,0.6590,0.6802,0.7032, & + 0.7255,0.7430,0.7735,0.7580/ + data (asy_lut(2,ib,4),ib=1,N_BANDS) /0.7180,0.7701,0.7358,0.7163,0.6952,0.6807,0.6801,0.6935,0.7160,0.7370, & + 0.7553,0.7681,0.7862,0.7623/ + data (asy_lut(2,ib,5),ib=1,N_BANDS) /0.7013,0.7733,0.7374,0.7203,0.7057,0.7006,0.7035,0.7192,0.7415,0.7596, & + 0.7739,0.7827,0.7906,0.7596/ + data (asy_lut(2,ib,6),ib=1,N_BANDS) /0.6922,0.7773,0.7404,0.7264,0.7170,0.7179,0.7228,0.7389,0.7595,0.7746, & + 0.7851,0.7909,0.7918,0.7562/ + data (asy_lut(2,ib,7),ib=1,N_BANDS) /0.6928,0.7875,0.7491,0.7393,0.7345,0.7397,0.7455,0.7602,0.7773,0.7883, & + 0.7944,0.7970,0.7912,0.7555/ + data (asy_lut(2,ib,8),ib=1,N_BANDS) /0.7021,0.7989,0.7590,0.7512,0.7613,0.7746,0.7718,0.7727,0.7867,0.7953, & + 0.7988,0.7994,0.7906,0.7600/ + + ! aer_type = 3 : maritime (SF79) + data (asy_lut(3,ib,1),ib=1,N_BANDS) /0.6620,0.7011,0.7111,0.7068,0.6990,0.6918,0.6883,0.6827,0.6768,0.6773, & + 0.6863,0.6940,0.7245,0.6719/ + data (asy_lut(3,ib,2),ib=1,N_BANDS) /0.6880,0.7394,0.7297,0.7240,0.7162,0.7083,0.7038,0.6957,0.6908,0.6917, & + 0.6952,0.7035,0.7356,0.6977/ + data (asy_lut(3,ib,3),ib=1,N_BANDS) /0.7266,0.7970,0.7666,0.7593,0.7505,0.7427,0.7391,0.7293,0.7214,0.7210, & + 0.7212,0.7265,0.7519,0.7340/ + data (asy_lut(3,ib,4),ib=1,N_BANDS) /0.7683,0.8608,0.8120,0.8030,0.7826,0.7679,0.7713,0.7760,0.7723,0.7716, & + 0.7726,0.7767,0.7884,0.7768/ + data (asy_lut(3,ib,5),ib=1,N_BANDS) /0.7776,0.8727,0.8182,0.8083,0.7985,0.7939,0.7953,0.7913,0.7846,0.7870, & + 0.7899,0.7918,0.7969,0.7870/ + data (asy_lut(3,ib,6),ib=1,N_BANDS) /0.7878,0.8839,0.8231,0.8130,0.8050,0.7977,0.7945,0.7932,0.7955,0.7992, & + 0.8025,0.8035,0.8055,0.7956/ + data (asy_lut(3,ib,7),ib=1,N_BANDS) /0.8005,0.8957,0.8273,0.8179,0.8105,0.8035,0.8010,0.8030,0.8081,0.8108, & + 0.8143,0.8174,0.8174,0.8042/ + data (asy_lut(3,ib,8),ib=1,N_BANDS) /0.8104,0.9034,0.8294,0.8212,0.8144,0.8087,0.8077,0.8118,0.8175,0.8202, & + 0.8239,0.8265,0.8246,0.8095/ + + do j=jts,jte + do i=its,ite + !-- initialization of aerosol type: + aer_t = aer_type(i,j) + do k=kts,kte + ! common part of the Lagrange's interpolator + ! only depends on the relative humidity value + ii=1 + do while ( (ii.le.N_RH) .and. (rh(i,k,j).gt.rhs(ii)) ) + ii=ii+1 + end do + imin=max(1,ii-N_INT_POINTS/2-1) + imax=min(N_RH,ii+N_INT_POINTS/2) + + do ib=1,N_BANDS + asyaer(i,k,j,ib)=0. + do jj=imin,imax + lj=1. + do kk=imin,imax + if (kk.ne.jj) lj=lj*(rh(i,k,j)-rhs(kk))/(rhs(jj)-rhs(kk)) + end do + asyaer(i,k,j,ib)=asyaer(i,k,j,ib)+lj*asy_lut(aer_t,ib,jj) + end do + end do + end do + end do + end do +end subroutine calc_spectral_asy_rrtmg_sw + +subroutine aod_profiler(ht,dz8w,taod550,n_bands, & + ims,ime,jms,jme,kms,kme, & + its,ite,jts,jte,kts,kte, & + aod550 & + ) + implicit none + + ! constants + real, parameter :: scale_height=2500. ! meters + + ! I/O variables + integer, intent(in) :: n_bands + integer, intent(in) :: ims,ime,jms,jme,kms,kme, & + its,ite,jts,jte,kts,kte + real, dimension( ims:ime, jms:jme), intent(in) :: ht + real, dimension( ims:ime, kms:kme, jms:jme ), intent(in) :: dz8w + real, dimension( ims:ime, jms:jme, 1:n_bands), intent(in) :: taod550 + real, dimension( ims:ime, kms:kme, jms:jme, 1:n_bands ), intent(inout) :: aod550 + + ! local variables + real, dimension(its:ite,kts:kte) :: z2d,aod5502d + real, dimension(its:ite) :: htoa + real :: aod_scale + real :: aod_acum + integer :: i,j,k,nb + + ! input variables from driver are defined such as kms is sfc and + ! kme is toa. Equivalently, kts is sfc and kte is toa + do j=jts,jte + ! heigth profile + ! kts=surface, kte=toa + do i=its,ite + z2d(i,kts)=ht(i,j)+0.5*dz8w(i,kts,j) + do k=kts+1,kte + z2d(i,k)=z2d(i,k-1)+0.5*(dz8w(i,k-1,j)+dz8w(i,k,j)) + end do + htoa(i)=z2d(i,kte)+0.5*dz8w(i,kte,j) + end do + + do nb=1,n_bands + ! AOD exponential profile + do i=its,ite + aod_scale=taod550(i,j,nb)/(scale_height*(exp(-ht(i,j)/scale_height)-exp(-htoa(i)/scale_height))) + do k=kts,kte + aod550(i,k,j,nb)=aod_scale*dz8w(i,k,j)*exp(-z2d(i,k)/scale_height) + end do + end do + end do ! nb-loop + end do ! j-loop +end subroutine aod_profiler + +subroutine calc_relative_humidity(p,t3d,qv3d, & + ims,ime,jms,jme,kms,kme, & + its,ite,jts,jte,kts,kte, & + rh ) + implicit none + + ! I/O variables + integer, intent(in) :: ims,ime,jms,jme,kms,kme,its,ite,jts,jte,kts,kte + ! Naming convention: 8~at => p8w reads as "p-at-w" (w=full levels) + real, dimension(ims:ime, kms:kme, jms:jme), intent(in) :: p, & ! pressure (Pa) + t3d, & ! temperature (K) + qv3d ! water vapor mixing ratio (kg/kg) + real, dimension(ims:ime, kms:kme, jms:jme), intent(inout) :: rh ! relative humidity at surface + + ! local variables + real :: tc,rv,es,e + integer :: i,j,k + + do j=jts,jte + do i=its,ite + do k=kts,kte ! only calculations at surface level + tc=t3d(i,k,j)-273.15 ! temperature (C) + rv=max(0.,qv3d(i,k,j)) ! water vapor mixing ration (kg kg-1) + es=6.112*exp((17.6*tc)/(tc+243.5)) ! saturation vapor pressure, hPa, Bolton (1980) + e =0.01*rv*p(i,k,j)/(rv+0.62197) ! vapor pressure, hPa, (ECMWF handouts, page 6, Atmosph. Thermdyn.) + ! rv=eps * e/(p-e) -> e=p * rv/(rv+eps), eps=0.62197 + rh(i,k,j)=min(99.,max(0.,100.*e/es)) ! relative humidity (%) + end do + end do + end do + +end subroutine calc_relative_humidity + +!================================================================================================================= + end module module_ra_rrtmg_sw_aerosols +!================================================================================================================= diff --git a/src/core_atmosphere/physics/physics_wrf/module_sf_mynn.F b/src/core_atmosphere/physics/physics_wrf/module_sf_mynn.F index 34442438d..8affcd839 100644 --- a/src/core_atmosphere/physics/physics_wrf/module_sf_mynn.F +++ b/src/core_atmosphere/physics/physics_wrf/module_sf_mynn.F @@ -32,7 +32,7 @@ subroutine sfclay_mynn( & ids,ide,jds,jde,kds,kde, & ims,ime,jms,jme,kms,kme, & its,ite,jts,jte,kts,kte & - ) + ) !------------------------------------------------------------------- !-- u3d 3d u-velocity interpolated to theta points (m/s) !-- v3d 3d v-velocity interpolated to theta points (m/s) diff --git a/src/core_atmosphere/physics/physics_wrf/module_sf_sfclayrev.F b/src/core_atmosphere/physics/physics_wrf/module_sf_sfclayrev.F index ce6e71bff..ac7088298 100644 --- a/src/core_atmosphere/physics/physics_wrf/module_sf_sfclayrev.F +++ b/src/core_atmosphere/physics/physics_wrf/module_sf_sfclayrev.F @@ -1,11 +1,9 @@ !================================================================================================================= module module_sf_sfclayrev - use mpas_log - use ccpp_kinds,only: kind_phys - - use sf_sfclayrev,only: sf_sfclayrev_run, & - sf_sfclayrev_timestep_init + use mpas_kind_types,only: kind_phys => RKIND + use sf_sfclayrev,only: sf_sfclayrev_run + use sf_sfclayrev_pre,only: sf_sfclayrev_pre_run implicit none private @@ -24,13 +22,12 @@ subroutine sfclayrev(u3d,v3d,t3d,qv3d,p3d,dz8w, & u10,v10,th2,t2,q2, & gz1oz0,wspd,br,isfflx,dx, & svp1,svp2,svp3,svpt0,ep1,ep2, & - karman,eomeg,stbolt, & - p1000mb, & + karman,p1000mb,lakemask, & 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, & - shalwater_z0,water_depth,shalwater_depth, & + shalwater_z0,water_depth, & scm_force_flux,errmsg,errflg) !================================================================================================================= @@ -45,10 +42,9 @@ subroutine sfclayrev(u3d,v3d,t3d,qv3d,p3d,dz8w, & integer,intent(in),optional:: scm_force_flux real(kind=kind_phys),intent(in):: svp1,svp2,svp3,svpt0 - real(kind=kind_phys),intent(in):: ep1,ep2,karman,eomeg,stbolt - real(kind=kind_phys),intent(in):: P1000mb + real(kind=kind_phys),intent(in):: ep1,ep2,karman + real(kind=kind_phys),intent(in):: p1000mb real(kind=kind_phys),intent(in):: cp,g,rovcp,r,xlv - real(kind=kind_phys),intent(in):: shalwater_depth real(kind=kind_phys),intent(in),dimension(ims:ime,jms:jme):: & dx, & @@ -57,6 +53,7 @@ subroutine sfclayrev(u3d,v3d,t3d,qv3d,p3d,dz8w, & psfc, & tsk, & xland, & + lakemask, & water_depth real(kind=kind_phys),intent(in),dimension(ims:ime,kms:kme,jms:jme):: & @@ -115,11 +112,15 @@ subroutine sfclayrev(u3d,v3d,t3d,qv3d,p3d,dz8w, & ustm !--- local variables and arrays: + logical:: l_isfflx + logical:: l_shalwater_z0 + logical:: l_scm_force_flux + integer:: i,j,k real(kind=kind_phys),dimension(its:ite):: dz1d,u1d,v1d,qv1d,p1d,t1d real(kind=kind_phys),dimension(its:ite):: & - dx_hv,mavail_hv,pblh_hv,psfc_hv,tsk_hv,xland_hv,water_depth_hv + dx_hv,mavail_hv,pblh_hv,psfc_hv,tsk_hv,xland_hv,water_depth_hv,lakemask_hv real(kind=kind_phys),dimension(its:ite,kts:kte):: & dz_hv,u_hv,v_hv,qv_hv,p_hv,t_hv @@ -137,6 +138,13 @@ subroutine sfclayrev(u3d,v3d,t3d,qv3d,p3d,dz8w, & !----------------------------------------------------------------------------------------------------------------- + l_isfflx = .false. + l_shalwater_z0 = .false. + l_scm_force_flux = .false. + if(isfflx .eq. 1) l_isfflx = .true. + if(shalwater_z0 .eq. 1) l_shalwater_z0 = .true. + if(scm_force_flux .eq. 1) l_scm_force_flux = .true. + do j = jts,jte do i = its,ite @@ -147,6 +155,7 @@ subroutine sfclayrev(u3d,v3d,t3d,qv3d,p3d,dz8w, & psfc_hv(i) = psfc(i,j) tsk_hv(i) = tsk(i,j) xland_hv(i) = xland(i,j) + lakemask_hv(i) = lakemask(i,j) water_depth_hv(i) = water_depth(i,j) do k = kts,kte @@ -190,7 +199,7 @@ subroutine sfclayrev(u3d,v3d,t3d,qv3d,p3d,dz8w, & enddo endif - call sf_sfclayrev_timestep_init(dz2d=dz_hv,u2d=u_hv,v2d=v_hv,qv2d=qv_hv,p2d=p_hv,t2d=t_hv, & + call sf_sfclayrev_pre_run(dz2d=dz_hv,u2d=u_hv,v2d=v_hv,qv2d=qv_hv,p2d=p_hv,t2d=t_hv, & dz1d=dz1d,u1d=u1d,v1d=v1d,qv1d=qv1d,p1d=p1d,t1d=t1d, & its=its,ite=ite,kts=kts,kte=kte,errmsg=errmsg,errflg=errflg) @@ -199,20 +208,16 @@ subroutine sfclayrev(u3d,v3d,t3d,qv3d,p3d,dz8w, & chs2=chs2_hv,cqs2=cqs2_hv,cpm=cpm_hv,pblh=pblh_hv, & rmol=rmol_hv,znt=znt_hv,ust=ust_hv,mavail=mavail_hv, & zol=zol_hv,mol=mol_hv,regime=regime_hv,psim=psim_hv, & - psih=psih_hv,fm=fm_hv,fh=fh_hv,xland=xland_hv, & + psih=psih_hv,fm=fm_hv,fh=fh_hv,xland=xland_hv,lakemask=lakemask_hv, & hfx=hfx_hv,qfx=qfx_hv,tsk=tsk_hv,u10=u10_hv, & v10=v10_hv,th2=th2_hv,t2=t2_hv,q2=q2_hv,flhc=flhc_hv, & flqc=flqc_hv,qgh=qgh_hv,qsfc=qsfc_hv,lh=lh_hv, & - gz1oz0=gz1oz0_hv,wspd=wspd_hv,br=br_hv,isfflx=isfflx,dx=dx_hv, & + gz1oz0=gz1oz0_hv,wspd=wspd_hv,br=br_hv,isfflx=l_isfflx,dx=dx_hv, & svp1=svp1,svp2=svp2,svp3=svp3,svpt0=svpt0,ep1=ep1,ep2=ep2,karman=karman, & - eomeg=eomeg,stbolt=stbolt,p1000mb=p1000mb, & - shalwater_z0=shalwater_z0,water_depth=water_depth_hv, & - shalwater_depth=shalwater_depth, & + p1000mb=p1000mb,shalwater_z0=l_shalwater_z0,water_depth=water_depth_hv, & + isftcflx=isftcflx,iz0tlnd=iz0tlnd,scm_force_flux=l_scm_force_flux, & + ustm=ustm_hv,ck=ck_hv,cka=cka_hv,cd=cd_hv,cda=cda_hv, & its=its,ite=ite,errmsg=errmsg,errflg=errflg & -#if ( ( EM_CORE == 1 ) || ( defined(mpas) ) ) - ,isftcflx=isftcflx,iz0tlnd=iz0tlnd,scm_force_flux=scm_force_flux, & - ustm=ustm_hv,ck=ck_hv,cka=cka_hv,cd=cd_hv,cda=cda_hv & -#endif ) do i = its,ite diff --git a/src/core_atmosphere/physics/physics_wrf/sf_mynn_pre.F b/src/core_atmosphere/physics/physics_wrf/sf_mynn_pre.F index e4d07a85d..5e9ab3f61 100644 --- a/src/core_atmosphere/physics/physics_wrf/sf_mynn_pre.F +++ b/src/core_atmosphere/physics/physics_wrf/sf_mynn_pre.F @@ -1,6 +1,6 @@ !================================================================================================================= module sf_mynn_pre - use ccpp_kinds,only: kind_phys + use ccpp_kind_types,only: kind_phys implicit none private diff --git a/src/core_atmosphere/physics/physics_wrf/sf_sfclayrev_pre.F b/src/core_atmosphere/physics/physics_wrf/sf_sfclayrev_pre.F new file mode 100644 index 000000000..bff574dca --- /dev/null +++ b/src/core_atmosphere/physics/physics_wrf/sf_sfclayrev_pre.F @@ -0,0 +1,101 @@ +!================================================================================================================= + module sf_sfclayrev_pre + use ccpp_kind_types,only: kind_phys + + implicit none + private + public:: sf_sfclayrev_pre_init, & + sf_sfclayrev_pre_finalize, & + sf_sfclayrev_pre_run + + + contains + + +!================================================================================================================= +!>\section arg_table_sf_sfclayrev_pre_init +!!\html\include sf_sfclayrev_pre_init.html +!! + subroutine sf_sfclayrev_pre_init(errmsg,errflg) +!================================================================================================================= + +!--- output arguments: + character(len=*),intent(out):: & + errmsg ! output error message (-). + + integer,intent(out):: & + errflg ! output error flag (-). + +!----------------------------------------------------------------------------------------------------------------- + +!--- output error flag and message: + errflg = 0 + errmsg = " " + + end subroutine sf_sfclayrev_pre_init + +!================================================================================================================= +!>\section arg_table_sf_sfclayrev_pre_finalize +!!\html\include sf_sfclayrev_pre_finalize.html +!! + subroutine sf_sfclayrev_pre_finalize(errmsg,errflg) +!================================================================================================================= + +!--- output arguments: + character(len=*),intent(out):: & + errmsg ! output error message (-). + + integer,intent(out):: & + errflg ! output error flag (-). + +!----------------------------------------------------------------------------------------------------------------- + +!--- output error flag and message: + errflg = 0 + errmsg = " " + + end subroutine sf_sfclayrev_pre_finalize + +!================================================================================================================= +!>\section arg_table_sf_sfclayrev_pre_run +!!\html\include sf_sfclayrev_pre_run.html +!! + subroutine sf_sfclayrev_pre_run(dz2d,u2d,v2d,qv2d,p2d,t2d,dz1d,u1d,v1d,qv1d,p1d,t1d, & + its,ite,kts,kte,errmsg,errflg) +!================================================================================================================= + +!--- input arguments: + integer,intent(in):: its,ite,kts,kte + + real(kind=kind_phys),intent(in),dimension(its:ite,kts:kte):: & + dz2d,u2d,v2d,qv2d,p2d,t2d + +!--- output arguments: + character(len=*),intent(out):: errmsg + integer,intent(out):: errflg + + real(kind=kind_phys),intent(out),dimension(its:ite):: & + dz1d,u1d,v1d,qv1d,p1d,t1d + +!--- local variables: + integer:: i + +!----------------------------------------------------------------------------------------------------------------- + + do i = its,ite + dz1d(i) = dz2d(i,kts) + u1d(i) = u2d(i,kts) + v1d(i) = v2d(i,kts) + qv1d(i) = qv2d(i,kts) + p1d(i) = p2d(i,kts) + t1d(i) = t2d(i,kts) + enddo + + errmsg = 'sf_sfclayrev_pre_run OK' + errflg = 0 + + end subroutine sf_sfclayrev_pre_run + +!================================================================================================================= + end module sf_sfclayrev_pre +!================================================================================================================= diff --git a/src/core_atmosphere/tools/manage_externals/.gitignore b/src/core_atmosphere/tools/manage_externals/.gitignore new file mode 100644 index 000000000..a71ac0cd7 --- /dev/null +++ b/src/core_atmosphere/tools/manage_externals/.gitignore @@ -0,0 +1,17 @@ +# directories that are checked out by the tool +cime/ +cime_config/ +components/ + +# generated local files +*.log + +# editor files +*~ +*.bak + +# generated python files +*.pyc + +# test tmp file +test/tmp diff --git a/src/core_atmosphere/tools/manage_externals/LICENSE.txt b/src/core_atmosphere/tools/manage_externals/LICENSE.txt new file mode 100644 index 000000000..665ee03fb --- /dev/null +++ b/src/core_atmosphere/tools/manage_externals/LICENSE.txt @@ -0,0 +1,34 @@ +Copyright (c) 2017-2018, University Corporation for Atmospheric Research (UCAR) +All rights reserved. + +Developed by: + University Corporation for Atmospheric Research - National Center for Atmospheric Research + https://www2.cesm.ucar.edu/working-groups/sewg + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the "Software"), +to deal with the Software without restriction, including without limitation +the rights to use, copy, modify, merge, publish, distribute, sublicense, +and/or sell copies of the Software, and to permit persons to whom +the Software is furnished to do so, subject to the following conditions: + + - Redistributions of source code must retain the above copyright notice, + this list of conditions and the following disclaimers. + - Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimers in the documentation + and/or other materials provided with the distribution. + - Neither the names of [Name of Development Group, UCAR], + nor the names of its contributors may be used to endorse or promote + products derived from this Software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +POSSIBILITY OF SUCH DAMAGE. diff --git a/src/core_atmosphere/tools/manage_externals/README.md b/src/core_atmosphere/tools/manage_externals/README.md new file mode 100644 index 000000000..9475301b5 --- /dev/null +++ b/src/core_atmosphere/tools/manage_externals/README.md @@ -0,0 +1,231 @@ +-- AUTOMATICALLY GENERATED FILE. DO NOT EDIT -- + +[![Build Status](https://travis-ci.org/ESMCI/manage_externals.svg?branch=master)](https://travis-ci.org/ESMCI/manage_externals)[![Coverage Status](https://coveralls.io/repos/github/ESMCI/manage_externals/badge.svg?branch=master)](https://coveralls.io/github/ESMCI/manage_externals?branch=master) +``` +usage: checkout_externals [-h] [-e [EXTERNALS]] [-o] [-S] [-v] [--backtrace] + [-d] [--no-logging] + +checkout_externals manages checking out groups of externals from revision +control based on a externals description file. By default only the +required externals are checkout out. + +Operations performed by manage_externals utilities are explicit and +data driven. checkout_externals will always make the working copy *exactly* +match what is in the externals file when modifying the working copy of +a repository. + +If checkout_externals isn't doing what you expected, double check the contents +of the externals description file. + +Running checkout_externals without the '--status' option will always attempt to +synchronize the working copy to exactly match the externals description. + +optional arguments: + -h, --help show this help message and exit + -e [EXTERNALS], --externals [EXTERNALS] + The externals description filename. Default: + Externals.cfg. + -o, --optional By default only the required externals are checked + out. This flag will also checkout the optional + externals. + -S, --status Output status of the repositories managed by + checkout_externals. By default only summary + information is provided. Use verbose output to see + details. + -v, --verbose Output additional information to the screen and log + file. This flag can be used up to two times, + increasing the verbosity level each time. + --backtrace DEVELOPER: show exception backtraces as extra + debugging output + -d, --debug DEVELOPER: output additional debugging information to + the screen and log file. + --no-logging DEVELOPER: disable logging. + +``` +NOTE: checkout_externals *MUST* be run from the root of the source tree it +is managing. For example, if you cloned a repository with: + + $ git clone git@github.com/{SOME_ORG}/some-project some-project-dev + +Then the root of the source tree is /path/to/some-project-dev. If you +obtained a sub-project via a checkout of another project: + + $ git clone git@github.com/{SOME_ORG}/some-project some-project-dev + +and you need to checkout the sub-project externals, then the root of the +source tree is /path/to/some-project-dev. Do *NOT* run checkout_externals +from within /path/to/some-project-dev/sub-project + +The root of the source tree will be referred to as `${SRC_ROOT}` below. + +# Supported workflows + + * Checkout all required components from the default externals + description file: + + $ cd ${SRC_ROOT} + $ ./manage_externals/checkout_externals + + * To update all required components to the current values in the + externals description file, re-run checkout_externals: + + $ cd ${SRC_ROOT} + $ ./manage_externals/checkout_externals + + If there are *any* modifications to *any* working copy according + to the git or svn 'status' command, checkout_externals + will not update any external repositories. Modifications + include: modified files, added files, removed files, or missing + files. + + To avoid this safety check, edit the externals description file + and comment out the modified external block. + + * Checkout all required components from a user specified externals + description file: + + $ cd ${SRC_ROOT} + $ ./manage_externals/checkout_externals --externals my-externals.cfg + + * Status summary of the repositories managed by checkout_externals: + + $ cd ${SRC_ROOT} + $ ./manage_externals/checkout_externals --status + + ./cime + s ./components/cism + ./components/mosart + e-o ./components/rtm + M ./src/fates + e-o ./tools/PTCLM + + where: + * column one indicates the status of the repository in relation + to the externals description file. + * column two indicates whether the working copy has modified files. + * column three shows how the repository is managed, optional or required + + Column one will be one of these values: + * s : out-of-sync : repository is checked out at a different commit + compared with the externals description + * e : empty : directory does not exist - checkout_externals has not been run + * ? : unknown : directory exists but .git or .svn directories are missing + + Column two will be one of these values: + * M : Modified : modified, added, deleted or missing files + * : blank / space : clean + * - : dash : no meaningful state, for empty repositories + + Column three will be one of these values: + * o : optional : optionally repository + * : blank / space : required repository + + * Detailed git or svn status of the repositories managed by checkout_externals: + + $ cd ${SRC_ROOT} + $ ./manage_externals/checkout_externals --status --verbose + +# Externals description file + + The externals description contains a list of the external + repositories that are used and their version control locations. The + file format is the standard ini/cfg configuration file format. Each + external is defined by a section containing the component name in + square brackets: + + * name (string) : component name, e.g. [cime], [cism], etc. + + Each section has the following keyword-value pairs: + + * required (boolean) : whether the component is a required checkout, + 'true' or 'false'. + + * local_path (string) : component path *relative* to where + checkout_externals is called. + + * protoctol (string) : version control protocol that is used to + manage the component. Valid values are 'git', 'svn', + 'externals_only'. + + Switching an external between different protocols is not + supported, e.g. from svn to git. To switch protocols, you need to + manually move the old working copy to a new location. + + Note: 'externals_only' will only process the external's own + external description file without trying to manage a repository + for the component. This is used for retreiving externals for + standalone components like cam and clm. If the source root of the + externals_only component is the same as the main source root, then + the local path must be set to '.', the unix current working + directory, e. g. 'local_path = .' + + * repo_url (string) : URL for the repository location, examples: + * https://svn-ccsm-models.cgd.ucar.edu/glc + * git@github.com:esmci/cime.git + * /path/to/local/repository + * . + + NOTE: To operate on only the local clone and and ignore remote + repositories, set the url to '.' (the unix current path), + i.e. 'repo_url = .' . This can be used to checkout a local branch + instead of the upstream branch. + + If a repo url is determined to be a local path (not a network url) + then user expansion, e.g. ~/, and environment variable expansion, + e.g. $HOME or $REPO_ROOT, will be performed. + + Relative paths are difficult to get correct, especially for mixed + use repos. It is advised that local paths expand to absolute paths. + If relative paths are used, they should be relative to one level + above local_path. If local path is 'src/foo', the the relative url + should be relative to 'src'. + + * tag (string) : tag to checkout + + * hash (string) : the git hash to checkout. Only applies to git + repositories. + + * branch (string) : branch to checkout from the specified + repository. Specifying a branch on a remote repository means that + checkout_externals will checkout the version of the branch in the remote, + not the the version in the local repository (if it exists). + + Note: one and only one of tag, branch hash must be supplied. + + * externals (string) : used to make manage_externals aware of + sub-externals required by an external. This is a relative path to + the external's root directory. For example, the main externals + description has an external checkout out at 'src/useful_library'. + useful_library requires additional externals to be complete. + Those additional externals are managed from the source root by the + externals description file pointed 'useful_library/sub-xternals.cfg', + Then the main 'externals' field in the top level repo should point to + 'sub-externals.cfg'. + Note that by default, `checkout_externals` will clone an external's + submodules. As a special case, the entry, `externals = None`, will + prevent this behavior. For more control over which externals are + checked out, create an externals file (and see the `from_submodule` + configuration entry below). + + * from_submodule (True / False) : used to pull the repo_url, local_path, + and hash properties for this external from the .gitmodules file in + this repository. Note that the section name (the entry in square + brackets) must match the name in the .gitmodules file. + If from_submodule is True, the protocol must be git and no repo_url, + local_path, hash, branch, or tag entries are allowed. + Default: False + + * sparse (string) : used to control a sparse checkout. This optional + entry should point to a filename (path relative to local_path) that + contains instructions on which repository paths to include (or + exclude) from the working tree. + See the "SPARSE CHECKOUT" section of https://git-scm.com/docs/git-read-tree + Default: sparse checkout is disabled + + * Lines begining with '#' or ';' are comments and will be ignored. + +# Obtaining this tool, reporting issues, etc. + + The master repository for manage_externals is + https://github.com/ESMCI/manage_externals. Any issues with this tool + should be reported there. diff --git a/src/core_atmosphere/tools/manage_externals/README_FIRST b/src/core_atmosphere/tools/manage_externals/README_FIRST new file mode 100644 index 000000000..c8a47d780 --- /dev/null +++ b/src/core_atmosphere/tools/manage_externals/README_FIRST @@ -0,0 +1,54 @@ +CESM is comprised of a number of different components that are +developed and managed independently. Each component may have +additional 'external' dependancies and optional parts that are also +developed and managed independently. + +The checkout_externals.py tool manages retreiving and updating the +components and their externals so you have a complete set of source +files for the model. + +checkout_externals.py relies on a model description file that +describes what components are needed, where to find them and where to +put them in the source tree. The default file is called "CESM.xml" +regardless of whether you are checking out CESM or a standalone +component. + +checkout_externals requires access to git and svn repositories that +require authentication. checkout_externals may pass through +authentication requests, but it will not cache them for you. For the +best and most robust user experience, you should have svn and git +working without password authentication. See: + + https://help.github.com/articles/connecting-to-github-with-ssh/ + + ?svn ref? + +NOTE: checkout_externals.py *MUST* be run from the root of the source +tree it is managing. For example, if you cloned CLM with: + + $ git clone git@github.com/ncar/clm clm-dev + +Then the root of the source tree is /path/to/cesm-dev. If you obtained +CLM via an svn checkout of CESM and you need to checkout the CLM +externals, then the root of the source tree for CLM is: + + /path/to/cesm-dev/components/clm + +The root of the source tree will be referred to as ${SRC_ROOT} below. + +To get started quickly, checkout all required components from the +default model description file: + + $ cd ${SRC_ROOT} + $ ./checkout_cesm/checkout_externals.py + +For additional information about using checkout model, please see: + + ${SRC_ROOT}/checkout_cesm/README + +or run: + + $ cd ${SRC_ROOT} + $ ./checkout_cesm/checkout_externals.py --help + + diff --git a/src/core_atmosphere/tools/manage_externals/checkout_externals b/src/core_atmosphere/tools/manage_externals/checkout_externals new file mode 100755 index 000000000..536c64eb6 --- /dev/null +++ b/src/core_atmosphere/tools/manage_externals/checkout_externals @@ -0,0 +1,43 @@ +#!/usr/bin/env python3 + +"""Main driver wrapper around the manic/checkout utility. + +Tool to assemble external respositories represented in an externals +description file. + +""" +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +import sys +import traceback +import os +import manic + +if sys.hexversion < 0x02070000: + print(70 * '*') + print('ERROR: {0} requires python >= 2.7.x. '.format(sys.argv[0])) + print('It appears that you are running python {0}'.format( + '.'.join(str(x) for x in sys.version_info[0:3]))) + print(70 * '*') + sys.exit(1) + + +if __name__ == '__main__': + ARGS = manic.checkout.commandline_arguments() + if ARGS.version: + version_info = '' + version_file_path = os.path.join(os.path.dirname(__file__),'version.txt') + with open(version_file_path) as f: + version_info = f.readlines()[0].strip() + print(version_info) + sys.exit(0) + try: + RET_STATUS, _ = manic.checkout.main(ARGS) + sys.exit(RET_STATUS) + except Exception as error: # pylint: disable=broad-except + manic.printlog(str(error)) + if ARGS.backtrace: + traceback.print_exc() + sys.exit(1) diff --git a/src/core_atmosphere/tools/manage_externals/manic/__init__.py b/src/core_atmosphere/tools/manage_externals/manic/__init__.py new file mode 100644 index 000000000..11badedd3 --- /dev/null +++ b/src/core_atmosphere/tools/manage_externals/manic/__init__.py @@ -0,0 +1,9 @@ +"""Public API for the manage_externals library +""" + +from manic import checkout +from manic.utils import printlog + +__all__ = [ + 'checkout', 'printlog', +] diff --git a/src/core_atmosphere/tools/manage_externals/manic/checkout.py b/src/core_atmosphere/tools/manage_externals/manic/checkout.py new file mode 100755 index 000000000..25c05ea23 --- /dev/null +++ b/src/core_atmosphere/tools/manage_externals/manic/checkout.py @@ -0,0 +1,449 @@ +#!/usr/bin/env python3 + +""" +Tool to assemble repositories represented in a model-description file. + +If loaded as a module (e.g., in a component's buildcpp), it can be used +to check the validity of existing subdirectories and load missing sources. +""" +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +import argparse +import logging +import os +import os.path +import sys + +from manic.externals_description import create_externals_description +from manic.externals_description import read_externals_description_file +from manic.externals_status import check_safe_to_update_repos +from manic.sourcetree import SourceTree +from manic.utils import printlog, fatal_error +from manic.global_constants import VERSION_SEPERATOR, LOG_FILE_NAME + +if sys.hexversion < 0x02070000: + print(70 * '*') + print('ERROR: {0} requires python >= 2.7.x. '.format(sys.argv[0])) + print('It appears that you are running python {0}'.format( + VERSION_SEPERATOR.join(str(x) for x in sys.version_info[0:3]))) + print(70 * '*') + sys.exit(1) + + +# --------------------------------------------------------------------- +# +# User input +# +# --------------------------------------------------------------------- +def commandline_arguments(args=None): + """Process the command line arguments + + Params: args - optional args. Should only be used during systems + testing. + + Returns: processed command line arguments + """ + description = ''' + +%(prog)s manages checking out groups of externals from revision +control based on an externals description file. By default only the +required externals are checkout out. + +Running %(prog)s without the '--status' option will always attempt to +synchronize the working copy to exactly match the externals description. +''' + + epilog = ''' +``` +NOTE: %(prog)s *MUST* be run from the root of the source tree it +is managing. For example, if you cloned a repository with: + + $ git clone git@github.com/{SOME_ORG}/some-project some-project-dev + +Then the root of the source tree is /path/to/some-project-dev. If you +obtained a sub-project via a checkout of another project: + + $ git clone git@github.com/{SOME_ORG}/some-project some-project-dev + +and you need to checkout the sub-project externals, then the root of the +source tree remains /path/to/some-project-dev. Do *NOT* run %(prog)s +from within /path/to/some-project-dev/sub-project + +The root of the source tree will be referred to as `${SRC_ROOT}` below. + + +# Supported workflows + + * Checkout all required components from the default externals + description file: + + $ cd ${SRC_ROOT} + $ ./manage_externals/%(prog)s + + * To update all required components to the current values in the + externals description file, re-run %(prog)s: + + $ cd ${SRC_ROOT} + $ ./manage_externals/%(prog)s + + If there are *any* modifications to *any* working copy according + to the git or svn 'status' command, %(prog)s + will not update any external repositories. Modifications + include: modified files, added files, removed files, or missing + files. + + To avoid this safety check, edit the externals description file + and comment out the modified external block. + + * Checkout all required components from a user specified externals + description file: + + $ cd ${SRC_ROOT} + $ ./manage_externals/%(prog)s --externals my-externals.cfg + + * Status summary of the repositories managed by %(prog)s: + + $ cd ${SRC_ROOT} + $ ./manage_externals/%(prog)s --status + + ./cime + s ./components/cism + ./components/mosart + e-o ./components/rtm + M ./src/fates + e-o ./tools/PTCLM + + + where: + * column one indicates the status of the repository in relation + to the externals description file. + * column two indicates whether the working copy has modified files. + * column three shows how the repository is managed, optional or required + + Column one will be one of these values: + * s : out-of-sync : repository is checked out at a different commit + compared with the externals description + * e : empty : directory does not exist - %(prog)s has not been run + * ? : unknown : directory exists but .git or .svn directories are missing + + Column two will be one of these values: + * M : Modified : modified, added, deleted or missing files + * : blank / space : clean + * - : dash : no meaningful state, for empty repositories + + Column three will be one of these values: + * o : optional : optionally repository + * : blank / space : required repository + + * Detailed git or svn status of the repositories managed by %(prog)s: + + $ cd ${SRC_ROOT} + $ ./manage_externals/%(prog)s --status --verbose + +# Externals description file + + The externals description contains a list of the external + repositories that are used and their version control locations. The + file format is the standard ini/cfg configuration file format. Each + external is defined by a section containing the component name in + square brackets: + + * name (string) : component name, e.g. [cime], [cism], etc. + + Each section has the following keyword-value pairs: + + * required (boolean) : whether the component is a required checkout, + 'true' or 'false'. + + * local_path (string) : component path *relative* to where + %(prog)s is called. + + * protoctol (string) : version control protocol that is used to + manage the component. Valid values are 'git', 'svn', + 'externals_only'. + + Switching an external between different protocols is not + supported, e.g. from svn to git. To switch protocols, you need to + manually move the old working copy to a new location. + + Note: 'externals_only' will only process the external's own + external description file without trying to manage a repository + for the component. This is used for retrieving externals for + standalone components like cam and ctsm which also serve as + sub-components within a larger project. If the source root of the + externals_only component is the same as the main source root, then + the local path must be set to '.', the unix current working + directory, e. g. 'local_path = .' + + * repo_url (string) : URL for the repository location, examples: + * https://svn-ccsm-models.cgd.ucar.edu/glc + * git@github.com:esmci/cime.git + * /path/to/local/repository + * . + + NOTE: To operate on only the local clone and and ignore remote + repositories, set the url to '.' (the unix current path), + i.e. 'repo_url = .' . This can be used to checkout a local branch + instead of the upstream branch. + + If a repo url is determined to be a local path (not a network url) + then user expansion, e.g. ~/, and environment variable expansion, + e.g. $HOME or $REPO_ROOT, will be performed. + + Relative paths are difficult to get correct, especially for mixed + use repos. It is advised that local paths expand to absolute paths. + If relative paths are used, they should be relative to one level + above local_path. If local path is 'src/foo', the the relative url + should be relative to 'src'. + + * tag (string) : tag to checkout + + * hash (string) : the git hash to checkout. Only applies to git + repositories. + + * branch (string) : branch to checkout from the specified + repository. Specifying a branch on a remote repository means that + %(prog)s will checkout the version of the branch in the remote, + not the the version in the local repository (if it exists). + + Note: one and only one of tag, branch hash must be supplied. + + * externals (string) : used to make manage_externals aware of + sub-externals required by an external. This is a relative path to + the external's root directory. For example, if LIBX is often used + as a sub-external, it might have an externals file (for its + externals) called Externals_LIBX.cfg. To use libx as a standalone + checkout, it would have another file, Externals.cfg with the + following entry: + + [ libx ] + local_path = . + protocol = externals_only + externals = Externals_LIBX.cfg + required = True + + Now, %(prog)s will process Externals.cfg and also process + Externals_LIBX.cfg as if it was a sub-external. + + Note that by default, checkout_externals will clone an external's + submodules. As a special case, the entry, "externals = None", will + prevent this behavior. For more control over which externals are + checked out, create an externals file (and see the from_submodule + configuration entry below). + + * from_submodule (True / False) : used to pull the repo_url, local_path, + and hash properties for this external from the .gitmodules file in + this repository. Note that the section name (the entry in square + brackets) must match the name in the .gitmodules file. + If from_submodule is True, the protocol must be git and no repo_url, + local_path, hash, branch, or tag entries are allowed. + Default: False + + * sparse (string) : used to control a sparse checkout. This optional + entry should point to a filename (path relative to local_path) that + contains instructions on which repository paths to include (or + exclude) from the working tree. + See the "SPARSE CHECKOUT" section of https://git-scm.com/docs/git-read-tree + Default: sparse checkout is disabled + + * Lines beginning with '#' or ';' are comments and will be ignored. + +# Obtaining this tool, reporting issues, etc. + + The master repository for manage_externals is + https://github.com/ESMCI/manage_externals. Any issues with this tool + should be reported there. + +# Troubleshooting + +Operations performed by manage_externals utilities are explicit and +data driven. %(prog)s will always attempt to make the working copy +*exactly* match what is in the externals file when modifying the +working copy of a repository. + +If %(prog)s is not doing what you expected, double check the contents +of the externals description file or examine the output of +./manage_externals/%(prog)s --status + +''' + + parser = argparse.ArgumentParser( + description=description, epilog=epilog, + formatter_class=argparse.RawDescriptionHelpFormatter) + + # + # user options + # + parser.add_argument("components", nargs="*", + help="Specific component(s) to checkout. By default, " + "all required externals are checked out.") + + parser.add_argument('-e', '--externals', nargs='?', + default='Externals.cfg', + help='The externals description filename. ' + 'Default: %(default)s.') + + parser.add_argument('-x', '--exclude', nargs='*', + help='Component(s) listed in the externals file which should be ignored.') + + parser.add_argument('-o', '--optional', action='store_true', default=False, + help='By default only the required externals ' + 'are checked out. This flag will also checkout the ' + 'optional externals.') + + parser.add_argument('-S', '--status', action='store_true', default=False, + help='Output the status of the repositories managed by ' + '%(prog)s. By default only summary information ' + 'is provided. Use the verbose option to see details.') + + parser.add_argument('-v', '--verbose', action='count', default=0, + help='Output additional information to ' + 'the screen and log file. This flag can be ' + 'used up to two times, increasing the ' + 'verbosity level each time.') + + parser.add_argument('--version', action='store_true', default=False, + help='Print manage_externals version and exit.') + + parser.add_argument('--svn-ignore-ancestry', action='store_true', default=False, + help='By default, subversion will abort if a component is ' + 'already checked out and there is no common ancestry with ' + 'the new URL. This flag passes the "--ignore-ancestry" flag ' + 'to the svn switch call. (This is not recommended unless ' + 'you are sure about what you are doing.)') + + # + # developer options + # + parser.add_argument('--backtrace', action='store_true', + help='DEVELOPER: show exception backtraces as extra ' + 'debugging output') + + parser.add_argument('-d', '--debug', action='store_true', default=False, + help='DEVELOPER: output additional debugging ' + 'information to the screen and log file.') + + logging_group = parser.add_mutually_exclusive_group() + + logging_group.add_argument('--logging', dest='do_logging', + action='store_true', + help='DEVELOPER: enable logging.') + logging_group.add_argument('--no-logging', dest='do_logging', + action='store_false', default=False, + help='DEVELOPER: disable logging ' + '(this is the default)') + + if args: + options = parser.parse_args(args) + else: + options = parser.parse_args() + return options + +def _dirty_local_repo_msg(program_name, config_file): + return """The external repositories labeled with 'M' above are not in a clean state. +The following are four options for how to proceed: +(1) Go into each external that is not in a clean state and issue either a 'git status' or + an 'svn status' command (depending on whether the external is managed by git or + svn). Either revert or commit your changes so that all externals are in a clean + state. (To revert changes in git, follow the instructions given when you run 'git + status'.) (Note, though, that it is okay to have untracked files in your working + directory.) Then rerun {program_name}. +(2) Alternatively, you do not have to rely on {program_name}. Instead, you can manually + update out-of-sync externals (labeled with 's' above) as described in the + configuration file {config_file}. (For example, run 'git fetch' and 'git checkout' + commands to checkout the appropriate tags for each external, as given in + {config_file}.) +(3) You can also use {program_name} to manage most, but not all externals: You can specify + one or more externals to ignore using the '-x' or '--exclude' argument to + {program_name}. Excluding externals labeled with 'M' will allow {program_name} to + update the other, non-excluded externals. +(4) As a last resort, if you are confident that there is no work that needs to be saved + from a given external, you can remove that external (via "rm -rf [directory]") and + then rerun the {program_name} tool. This option is mainly useful as a workaround for + issues with this tool (such as https://github.com/ESMCI/manage_externals/issues/157). +The external repositories labeled with '?' above are not under version +control using the expected protocol. If you are sure you want to switch +protocols, and you don't have any work you need to save from this +directory, then run "rm -rf [directory]" before rerunning the +{program_name} tool. +""".format(program_name=program_name, config_file=config_file) +# --------------------------------------------------------------------- +# +# main +# +# --------------------------------------------------------------------- +def main(args): + """ + Function to call when module is called from the command line. + Parse externals file and load required repositories or all repositories if + the --all option is passed. + + Returns a tuple (overall_status, tree_status). overall_status is 0 + on success, non-zero on failure. tree_status is a dict mapping local path + to ExternalStatus -- if no checkout is happening. If checkout is happening, tree_status + is None. + """ + if args.do_logging: + logging.basicConfig(filename=LOG_FILE_NAME, + format='%(levelname)s : %(asctime)s : %(message)s', + datefmt='%Y-%m-%d %H:%M:%S', + level=logging.DEBUG) + + program_name = os.path.basename(sys.argv[0]) + logging.info('Beginning of %s', program_name) + + load_all = False + if args.optional: + load_all = True + + root_dir = os.path.abspath(os.getcwd()) + model_data = read_externals_description_file(root_dir, args.externals) + ext_description = create_externals_description( + model_data, components=args.components, exclude=args.exclude) + + for comp in args.components: + if comp not in ext_description.keys(): + # Note we can't print out the list of found externals because + # they were filtered in create_externals_description above. + fatal_error( + "No component {} found in {}".format( + comp, args.externals)) + + source_tree = SourceTree(root_dir, ext_description, svn_ignore_ancestry=args.svn_ignore_ancestry) + if args.components: + components_str = 'specified components' + else: + components_str = 'required & optional components' + printlog('Checking local status of ' + components_str + ': ', end='') + tree_status = source_tree.status(print_progress=True) + printlog('') + + if args.status: + # user requested status-only + for comp in sorted(tree_status): + tree_status[comp].log_status_message(args.verbose) + else: + # checkout / update the external repositories. + safe_to_update = check_safe_to_update_repos(tree_status) + if not safe_to_update: + # print status + for comp in sorted(tree_status): + tree_status[comp].log_status_message(args.verbose) + # exit gracefully + printlog('-' * 70) + printlog(_dirty_local_repo_msg(program_name, args.externals)) + printlog('-' * 70) + else: + if not args.components: + source_tree.checkout(args.verbose, load_all) + for comp in args.components: + source_tree.checkout(args.verbose, load_all, load_comp=comp) + printlog('') + # New tree status is unknown, don't return anything. + tree_status = None + + logging.info('%s completed without exceptions.', program_name) + # NOTE(bja, 2017-11) tree status is used by the systems tests + return 0, tree_status diff --git a/src/core_atmosphere/tools/manage_externals/manic/externals_description.py b/src/core_atmosphere/tools/manage_externals/manic/externals_description.py new file mode 100644 index 000000000..546e7fdcb --- /dev/null +++ b/src/core_atmosphere/tools/manage_externals/manic/externals_description.py @@ -0,0 +1,830 @@ +#!/usr/bin/env python3 + +"""Model description + +Model description is the representation of the various externals +included in the model. It processes in input data structure, and +converts it into a standard interface that is used by the rest of the +system. + +To maintain backward compatibility, externals description files should +follow semantic versioning rules, http://semver.org/ + + + +""" +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +import logging +import os +import os.path +import re + +# ConfigParser in python2 was renamed to configparser in python3. +# In python2, ConfigParser returns byte strings, str, instead of unicode. +# We need unicode to be compatible with xml and json parser and python3. +try: + # python2 + from ConfigParser import SafeConfigParser as config_parser + from ConfigParser import MissingSectionHeaderError + from ConfigParser import NoSectionError, NoOptionError + + USE_PYTHON2 = True + + def config_string_cleaner(text): + """convert strings into unicode + """ + return text.decode('utf-8') +except ImportError: + # python3 + from configparser import ConfigParser as config_parser + from configparser import MissingSectionHeaderError + from configparser import NoSectionError, NoOptionError + + USE_PYTHON2 = False + + def config_string_cleaner(text): + """Python3 already uses unicode strings, so just return the string + without modification. + + """ + return text + +from .utils import printlog, fatal_error, str_to_bool, expand_local_url +from .utils import execute_subprocess +from .global_constants import EMPTY_STR, PPRINTER, VERSION_SEPERATOR + +# +# Globals +# +DESCRIPTION_SECTION = 'externals_description' +VERSION_ITEM = 'schema_version' + + +def read_externals_description_file(root_dir, file_name): + """Read a file containing an externals description and + create its internal representation. + + """ + root_dir = os.path.abspath(root_dir) + msg = 'In directory : {0}'.format(root_dir) + logging.info(msg) + printlog('Processing externals description file : {0} ({1})'.format(file_name, + root_dir)) + + file_path = os.path.join(root_dir, file_name) + if not os.path.exists(file_name): + if file_name.lower() == "none": + msg = ('INTERNAL ERROR: Attempt to read externals file ' + 'from {0} when not configured'.format(file_path)) + else: + msg = ('ERROR: Model description file, "{0}", does not ' + 'exist at path:\n {1}\nDid you run from the root of ' + 'the source tree?'.format(file_name, file_path)) + + fatal_error(msg) + + externals_description = None + if file_name == ExternalsDescription.GIT_SUBMODULES_FILENAME: + externals_description = _read_gitmodules_file(root_dir, file_name) + else: + try: + config = config_parser() + config.read(file_path) + externals_description = config + except MissingSectionHeaderError: + # not a cfg file + pass + + if externals_description is None: + msg = 'Unknown file format!' + fatal_error(msg) + + return externals_description + +class LstripReader(object): + "LstripReader formats .gitmodules files to be acceptable for configparser" + def __init__(self, filename): + with open(filename, 'r') as infile: + lines = infile.readlines() + self._lines = list() + self._num_lines = len(lines) + self._index = 0 + for line in lines: + self._lines.append(line.lstrip()) + + def readlines(self): + """Return all the lines from this object's file""" + return self._lines + + def readline(self, size=-1): + """Format and return the next line or raise StopIteration""" + try: + line = self.next() + except StopIteration: + line = '' + + if (size > 0) and (len(line) < size): + return line[0:size] + + return line + + def __iter__(self): + """Begin an iteration""" + self._index = 0 + return self + + def next(self): + """Return the next line or raise StopIteration""" + if self._index >= self._num_lines: + raise StopIteration + + self._index = self._index + 1 + return self._lines[self._index - 1] + + def __next__(self): + return self.next() + +def git_submodule_status(repo_dir): + """Run the git submodule status command to obtain submodule hashes. + """ + # This function is here instead of GitRepository to avoid a dependency loop + cmd = 'git -C {repo_dir} submodule status'.format( + repo_dir=repo_dir).split() + git_output = execute_subprocess(cmd, output_to_caller=True) + submodules = {} + submods = git_output.split('\n') + for submod in submods: + if submod: + status = submod[0] + items = submod[1:].split(' ') + if len(items) > 2: + tag = items[2] + else: + tag = None + + submodules[items[1]] = {'hash':items[0], 'status':status, 'tag':tag} + + return submodules + +def parse_submodules_desc_section(section_items, file_path): + """Find the path and url for this submodule description""" + path = None + url = None + for item in section_items: + name = item[0].strip().lower() + if name == 'path': + path = item[1].strip() + elif name == 'url': + url = item[1].strip() + elif name == 'branch': + # We do not care about branch since we have a hash - silently ignore + pass + else: + msg = 'WARNING: Ignoring unknown {} property, in {}' + msg = msg.format(item[0], file_path) # fool pylint + logging.warning(msg) + + return path, url + +def _read_gitmodules_file(root_dir, file_name): + # pylint: disable=deprecated-method + # Disabling this check because the method is only used for python2 + # pylint: disable=too-many-locals + # pylint: disable=too-many-branches + # pylint: disable=too-many-statements + """Read a .gitmodules file and convert it to be compatible with an + externals description. + """ + root_dir = os.path.abspath(root_dir) + msg = 'In directory : {0}'.format(root_dir) + logging.info(msg) + + file_path = os.path.join(root_dir, file_name) + if not os.path.exists(file_name): + msg = ('ERROR: submodules description file, "{0}", does not ' + 'exist in dir:\n {1}'.format(file_name, root_dir)) + fatal_error(msg) + + submodules_description = None + externals_description = None + try: + config = config_parser() + if USE_PYTHON2: + config.readfp(LstripReader(file_path), filename=file_name) + else: + config.read_file(LstripReader(file_path), source=file_name) + + submodules_description = config + except MissingSectionHeaderError: + # not a cfg file + pass + + if submodules_description is None: + msg = 'Unknown file format!' + fatal_error(msg) + else: + # Convert the submodules description to an externals description + externals_description = config_parser() + # We need to grab all the commit hashes for this repo + submods = git_submodule_status(root_dir) + for section in submodules_description.sections(): + if section[0:9] == 'submodule': + sec_name = section[9:].strip(' "') + externals_description.add_section(sec_name) + section_items = submodules_description.items(section) + path, url = parse_submodules_desc_section(section_items, + file_path) + + if path is None: + msg = 'Submodule {} missing path'.format(sec_name) + fatal_error(msg) + + if url is None: + msg = 'Submodule {} missing url'.format(sec_name) + fatal_error(msg) + + externals_description.set(sec_name, + ExternalsDescription.PATH, path) + externals_description.set(sec_name, + ExternalsDescription.PROTOCOL, 'git') + externals_description.set(sec_name, + ExternalsDescription.REPO_URL, url) + externals_description.set(sec_name, + ExternalsDescription.REQUIRED, 'True') + if sec_name in submods: + submod_name = sec_name + else: + # The section name does not have to match the path + submod_name = path + + if submod_name in submods: + git_hash = submods[submod_name]['hash'] + externals_description.set(sec_name, + ExternalsDescription.HASH, + git_hash) + else: + emsg = "submodule status has no section, '{}'" + emsg += "\nCheck section names in externals config file" + fatal_error(emsg.format(submod_name)) + + # Required items + externals_description.add_section(DESCRIPTION_SECTION) + externals_description.set(DESCRIPTION_SECTION, VERSION_ITEM, '1.0.0') + + return externals_description + +def create_externals_description( + model_data, model_format='cfg', components=None, exclude=None, parent_repo=None): + """Create the a externals description object from the provided data + + components: list of component names to include, None to include all. If a + name isn't found, it is silently omitted from the return value. + exclude: list of component names to skip. + """ + externals_description = None + if model_format == 'dict': + externals_description = ExternalsDescriptionDict( + model_data, components=components, exclude=exclude) + elif model_format == 'cfg': + major, _, _ = get_cfg_schema_version(model_data) + if major == 1: + externals_description = ExternalsDescriptionConfigV1( + model_data, components=components, exclude=exclude, parent_repo=parent_repo) + else: + msg = ('Externals description file has unsupported schema ' + 'version "{0}".'.format(major)) + fatal_error(msg) + else: + msg = 'Unknown model data format "{0}"'.format(model_format) + fatal_error(msg) + return externals_description + + +def get_cfg_schema_version(model_cfg): + """Extract the major, minor, patch version of the config file schema + + Params: + model_cfg - config parser object containing the externas description data + + Returns: + major = integer major version + minor = integer minor version + patch = integer patch version + """ + semver_str = '' + try: + semver_str = model_cfg.get(DESCRIPTION_SECTION, VERSION_ITEM) + except (NoSectionError, NoOptionError): + msg = ('externals description file must have the required ' + 'section: "{0}" and item "{1}"'.format(DESCRIPTION_SECTION, + VERSION_ITEM)) + fatal_error(msg) + + # NOTE(bja, 2017-11) Assume we don't care about the + # build/pre-release metadata for now! + version_list = re.split(r'[-+]', semver_str) + version_str = version_list[0] + version = version_str.split(VERSION_SEPERATOR) + try: + major = int(version[0].strip()) + minor = int(version[1].strip()) + patch = int(version[2].strip()) + except ValueError: + msg = ('Config file schema version must have integer digits for ' + 'major, minor and patch versions. ' + 'Received "{0}"'.format(version_str)) + fatal_error(msg) + return major, minor, patch + + +class ExternalsDescription(dict): + """Base externals description class that is independent of the user input + format. Different input formats can all be converted to this + representation to provide a consistent represtentation for the + rest of the objects in the system. + + NOTE(bja, 2018-03): do NOT define _schema_major etc at the class + level in the base class. The nested/recursive nature of externals + means different schema versions may be present in a single run! + + All inheriting classes must overwrite: + self._schema_major and self._input_major + self._schema_minor and self._input_minor + self._schema_patch and self._input_patch + + where _schema_x is the supported schema, _input_x is the user + input value. + + """ + # keywords defining the interface into the externals description data; these + # are brought together by the schema below. + EXTERNALS = 'externals' # path to externals file. + BRANCH = 'branch' + SUBMODULE = 'from_submodule' + HASH = 'hash' + NAME = 'name' + PATH = 'local_path' + PROTOCOL = 'protocol' + REPO = 'repo' + REPO_URL = 'repo_url' + REQUIRED = 'required' + TAG = 'tag' + SPARSE = 'sparse' + + PROTOCOL_EXTERNALS_ONLY = 'externals_only' + PROTOCOL_GIT = 'git' + PROTOCOL_SVN = 'svn' + GIT_SUBMODULES_FILENAME = '.gitmodules' + KNOWN_PRROTOCOLS = [PROTOCOL_GIT, PROTOCOL_SVN, PROTOCOL_EXTERNALS_ONLY] + + # v1 xml keywords + _V1_TREE_PATH = 'TREE_PATH' + _V1_ROOT = 'ROOT' + _V1_TAG = 'TAG' + _V1_BRANCH = 'BRANCH' + _V1_REQ_SOURCE = 'REQ_SOURCE' + + # Dictionary keys are component names. The corresponding values are laid out + # according to this schema. + _source_schema = {REQUIRED: True, + PATH: 'string', + EXTERNALS: 'string', + SUBMODULE : True, + REPO: {PROTOCOL: 'string', + REPO_URL: 'string', + TAG: 'string', + BRANCH: 'string', + HASH: 'string', + SPARSE: 'string', + } + } + + def __init__(self, parent_repo=None): + """Convert the xml into a standardized dict that can be used to + construct the source objects + + """ + dict.__init__(self) + + self._schema_major = None + self._schema_minor = None + self._schema_patch = None + self._input_major = None + self._input_minor = None + self._input_patch = None + self._parent_repo = parent_repo + + def _verify_schema_version(self): + """Use semantic versioning rules to verify we can process this schema. + + """ + known = '{0}.{1}.{2}'.format(self._schema_major, + self._schema_minor, + self._schema_patch) + received = '{0}.{1}.{2}'.format(self._input_major, + self._input_minor, + self._input_patch) + + if self._input_major != self._schema_major: + # should never get here, the factory should handle this correctly! + msg = ('DEV_ERROR: version "{0}" parser received ' + 'version "{1}" input.'.format(known, received)) + fatal_error(msg) + + if self._input_minor > self._schema_minor: + msg = ('Incompatible schema version:\n' + ' User supplied schema version "{0}" is too new."\n' + ' Can only process version "{1}" files and ' + 'older.'.format(received, known)) + fatal_error(msg) + + if self._input_patch > self._schema_patch: + # NOTE(bja, 2018-03) ignoring for now... Not clear what + # conditions the test is needed. + pass + + def _check_user_input(self): + """Run a series of checks to attempt to validate the user input and + detect errors as soon as possible. + + NOTE(bja, 2018-03) These checks are called *after* the file is + read. That means the schema check can not occur here. + + Note: the order is important. check_optional will create + optional with null data. run check_data first to ensure + required data was provided correctly by the user. + + """ + self._check_data() + self._check_optional() + self._validate() + + def _check_data(self): + # pylint: disable=too-many-branches,too-many-statements + """Check user supplied data is valid where possible. + """ + for ext_name in self.keys(): + if (self[ext_name][self.REPO][self.PROTOCOL] + not in self.KNOWN_PRROTOCOLS): + msg = 'Unknown repository protocol "{0}" in "{1}".'.format( + self[ext_name][self.REPO][self.PROTOCOL], ext_name) + fatal_error(msg) + + if (self[ext_name][self.REPO][self.PROTOCOL] == + self.PROTOCOL_SVN): + if self.HASH in self[ext_name][self.REPO]: + msg = ('In repo description for "{0}". svn repositories ' + 'may not include the "hash" keyword.'.format( + ext_name)) + fatal_error(msg) + + if ((self[ext_name][self.REPO][self.PROTOCOL] != self.PROTOCOL_GIT) + and (self.SUBMODULE in self[ext_name])): + msg = ('self.SUBMODULE is only supported with {0} protocol, ' + '"{1}" is defined as an {2} repository') + fatal_error(msg.format(self.PROTOCOL_GIT, ext_name, + self[ext_name][self.REPO][self.PROTOCOL])) + + if (self[ext_name][self.REPO][self.PROTOCOL] != + self.PROTOCOL_EXTERNALS_ONLY): + ref_count = 0 + found_refs = '' + if self.TAG in self[ext_name][self.REPO]: + ref_count += 1 + found_refs = '"{0} = {1}", {2}'.format( + self.TAG, self[ext_name][self.REPO][self.TAG], + found_refs) + if self.BRANCH in self[ext_name][self.REPO]: + ref_count += 1 + found_refs = '"{0} = {1}", {2}'.format( + self.BRANCH, self[ext_name][self.REPO][self.BRANCH], + found_refs) + if self.HASH in self[ext_name][self.REPO]: + ref_count += 1 + found_refs = '"{0} = {1}", {2}'.format( + self.HASH, self[ext_name][self.REPO][self.HASH], + found_refs) + if (self.SUBMODULE in self[ext_name] and + self[ext_name][self.SUBMODULE]): + ref_count += 1 + found_refs = '"{0} = {1}", {2}'.format( + self.SUBMODULE, + self[ext_name][self.SUBMODULE], found_refs) + + if ref_count > 1: + msg = 'Model description is over specified! ' + if self.SUBMODULE in self[ext_name]: + msg += ('from_submodule is not compatible with ' + '"tag", "branch", or "hash" ') + else: + msg += (' Only one of "tag", "branch", or "hash" ' + 'may be specified ') + + msg += 'for repo description of "{0}".'.format(ext_name) + msg = '{0}\nFound: {1}'.format(msg, found_refs) + fatal_error(msg) + elif ref_count < 1: + msg = ('Model description is under specified! One of ' + '"tag", "branch", or "hash" must be specified for ' + 'repo description of "{0}"'.format(ext_name)) + fatal_error(msg) + + if (self.REPO_URL not in self[ext_name][self.REPO] and + (self.SUBMODULE not in self[ext_name] or + not self[ext_name][self.SUBMODULE])): + msg = ('Model description is under specified! Must have ' + '"repo_url" in repo ' + 'description for "{0}"'.format(ext_name)) + fatal_error(msg) + + if (self.SUBMODULE in self[ext_name] and + self[ext_name][self.SUBMODULE]): + if self.REPO_URL in self[ext_name][self.REPO]: + msg = ('Model description is over specified! ' + 'from_submodule keyword is not compatible ' + 'with {0} keyword for'.format(self.REPO_URL)) + msg = '{0} repo description of "{1}"'.format(msg, + ext_name) + fatal_error(msg) + + if self.PATH in self[ext_name]: + msg = ('Model description is over specified! ' + 'from_submodule keyword is not compatible with ' + '{0} keyword for'.format(self.PATH)) + msg = '{0} repo description of "{1}"'.format(msg, + ext_name) + fatal_error(msg) + + if self.REPO_URL in self[ext_name][self.REPO]: + url = expand_local_url( + self[ext_name][self.REPO][self.REPO_URL], ext_name) + self[ext_name][self.REPO][self.REPO_URL] = url + + def _check_optional(self): + # pylint: disable=too-many-branches + """Some fields like externals, repo:tag repo:branch are + (conditionally) optional. We don't want the user to be + required to enter them in every externals description file, but + still want to validate the input. Check conditions and add + default values if appropriate. + + """ + submod_desc = None # Only load submodules info once + for field in self: + # truely optional + if self.EXTERNALS not in self[field]: + self[field][self.EXTERNALS] = EMPTY_STR + + # git and svn repos must tags and branches for validation purposes. + if self.TAG not in self[field][self.REPO]: + self[field][self.REPO][self.TAG] = EMPTY_STR + if self.BRANCH not in self[field][self.REPO]: + self[field][self.REPO][self.BRANCH] = EMPTY_STR + if self.HASH not in self[field][self.REPO]: + self[field][self.REPO][self.HASH] = EMPTY_STR + if self.REPO_URL not in self[field][self.REPO]: + self[field][self.REPO][self.REPO_URL] = EMPTY_STR + if self.SPARSE not in self[field][self.REPO]: + self[field][self.REPO][self.SPARSE] = EMPTY_STR + + # from_submodule has a complex relationship with other fields + if self.SUBMODULE in self[field]: + # User wants to use submodule information, is it available? + if self._parent_repo is None: + # No parent == no submodule information + PPRINTER.pprint(self[field]) + msg = 'No parent submodule for "{0}"'.format(field) + fatal_error(msg) + elif self._parent_repo.protocol() != self.PROTOCOL_GIT: + PPRINTER.pprint(self[field]) + msg = 'Parent protocol, "{0}", does not support submodules' + fatal_error(msg.format(self._parent_repo.protocol())) + else: + args = self._repo_config_from_submodule(field, submod_desc) + repo_url, repo_path, ref_hash, submod_desc = args + + if repo_url is None: + msg = ('Cannot checkout "{0}" as a submodule, ' + 'repo not found in {1} file') + fatal_error(msg.format(field, + self.GIT_SUBMODULES_FILENAME)) + # Fill in submodule fields + self[field][self.REPO][self.REPO_URL] = repo_url + self[field][self.REPO][self.HASH] = ref_hash + self[field][self.PATH] = repo_path + + if self[field][self.SUBMODULE]: + # We should get everything from the parent submodule + # configuration. + pass + # No else (from _submodule = False is the default) + else: + # Add the default value (not using submodule information) + self[field][self.SUBMODULE] = False + + def _repo_config_from_submodule(self, field, submod_desc): + """Find the external config information for a repository from + its submodule configuration information. + """ + if submod_desc is None: + repo_path = os.getcwd() # Is this always correct? + submod_file = self._parent_repo.submodules_file(repo_path=repo_path) + if submod_file is None: + msg = ('Cannot checkout "{0}" from submodule information\n' + ' Parent repo, "{1}" does not have submodules') + fatal_error(msg.format(field, self._parent_repo.name())) + + printlog( + 'Processing submodules description file : {0} ({1})'.format( + submod_file, repo_path)) + submod_model_data= _read_gitmodules_file(repo_path, submod_file) + submod_desc = create_externals_description(submod_model_data) + + # Can we find our external? + repo_url = None + repo_path = None + ref_hash = None + for ext_field in submod_desc: + if field == ext_field: + ext = submod_desc[ext_field] + repo_url = ext[self.REPO][self.REPO_URL] + repo_path = ext[self.PATH] + ref_hash = ext[self.REPO][self.HASH] + break + + return repo_url, repo_path, ref_hash, submod_desc + + def _validate(self): + """Validate that the parsed externals description contains all necessary + fields. + + """ + def print_compare_difference(data_a, data_b, loc_a, loc_b): + """Look through the data structures and print the differences. + + """ + for item in data_a: + if item in data_b: + if not isinstance(data_b[item], type(data_a[item])): + printlog(" {item}: {loc} = {val} ({val_type})".format( + item=item, loc=loc_a, val=data_a[item], + val_type=type(data_a[item]))) + printlog(" {item} {loc} = {val} ({val_type})".format( + item=' ' * len(item), loc=loc_b, val=data_b[item], + val_type=type(data_b[item]))) + else: + printlog(" {item}: {loc} = {val} ({val_type})".format( + item=item, loc=loc_a, val=data_a[item], + val_type=type(data_a[item]))) + printlog(" {item} {loc} missing".format( + item=' ' * len(item), loc=loc_b)) + + def validate_data_struct(schema, data): + """Compare a data structure against a schema and validate all required + fields are present. + + """ + is_valid = False + in_ref = True + valid = True + if isinstance(schema, dict) and isinstance(data, dict): + # Both are dicts, recursively verify that all fields + # in schema are present in the data. + for key in schema: + in_ref = in_ref and (key in data) + if in_ref: + valid = valid and ( + validate_data_struct(schema[key], data[key])) + + is_valid = in_ref and valid + else: + # non-recursive structure. verify data and schema have + # the same type. + is_valid = isinstance(data, type(schema)) + + if not is_valid: + printlog(" Unmatched schema and input:") + if isinstance(schema, dict): + print_compare_difference(schema, data, 'schema', 'input') + print_compare_difference(data, schema, 'input', 'schema') + else: + printlog(" schema = {0} ({1})".format( + schema, type(schema))) + printlog(" input = {0} ({1})".format(data, type(data))) + + return is_valid + + for field in self: + valid = validate_data_struct(self._source_schema, self[field]) + if not valid: + PPRINTER.pprint(self._source_schema) + PPRINTER.pprint(self[field]) + msg = 'ERROR: source for "{0}" did not validate'.format(field) + fatal_error(msg) + + +class ExternalsDescriptionDict(ExternalsDescription): + """Create a externals description object from a dictionary using the API + representations. Primarily used to simplify creating model + description files for unit testing. + + """ + + def __init__(self, model_data, components=None, exclude=None): + """Parse a native dictionary into a externals description. + """ + ExternalsDescription.__init__(self) + self._schema_major = 1 + self._schema_minor = 0 + self._schema_patch = 0 + self._input_major = 1 + self._input_minor = 0 + self._input_patch = 0 + self._verify_schema_version() + if components: + for key in list(model_data.keys()): + if key not in components: + del model_data[key] + + if exclude: + for key in list(model_data.keys()): + if key in exclude: + del model_data[key] + + self.update(model_data) + self._check_user_input() + + +class ExternalsDescriptionConfigV1(ExternalsDescription): + """Create a externals description object from a config_parser object, + schema version 1. + + """ + + def __init__(self, model_data, components=None, exclude=None, parent_repo=None): + """Convert the config data into a standardized dict that can be used to + construct the source objects + + components: list of component names to include, None to include all. + exclude: list of component names to skip. + """ + ExternalsDescription.__init__(self, parent_repo=parent_repo) + self._schema_major = 1 + self._schema_minor = 1 + self._schema_patch = 0 + self._input_major, self._input_minor, self._input_patch = \ + get_cfg_schema_version(model_data) + self._verify_schema_version() + self._remove_metadata(model_data) + self._parse_cfg(model_data, components=components, exclude=exclude) + self._check_user_input() + + @staticmethod + def _remove_metadata(model_data): + """Remove the metadata section from the model configuration file so + that it is simpler to look through the file and construct the + externals description. + + """ + model_data.remove_section(DESCRIPTION_SECTION) + + def _parse_cfg(self, cfg_data, components=None, exclude=None): + """Parse a config_parser object into a externals description. + + components: list of component names to include, None to include all. + exclude: list of component names to skip. + """ + def list_to_dict(input_list, convert_to_lower_case=True): + """Convert a list of key-value pairs into a dictionary. + """ + output_dict = {} + for item in input_list: + key = config_string_cleaner(item[0].strip()) + value = config_string_cleaner(item[1].strip()) + if convert_to_lower_case: + key = key.lower() + output_dict[key] = value + return output_dict + + for section in cfg_data.sections(): + name = config_string_cleaner(section.lower().strip()) + if (components and name not in components) or (exclude and name in exclude): + continue + self[name] = {} + self[name].update(list_to_dict(cfg_data.items(section))) + self[name][self.REPO] = {} + loop_keys = self[name].copy().keys() + for item in loop_keys: + if item in self._source_schema: + if isinstance(self._source_schema[item], bool): + self[name][item] = str_to_bool(self[name][item]) + elif item in self._source_schema[self.REPO]: + self[name][self.REPO][item] = self[name][item] + del self[name][item] + else: + msg = ('Invalid input: "{sect}" contains unknown ' + 'item "{item}".'.format(sect=name, item=item)) + fatal_error(msg) diff --git a/src/core_atmosphere/tools/manage_externals/manic/externals_status.py b/src/core_atmosphere/tools/manage_externals/manic/externals_status.py new file mode 100644 index 000000000..6bc29e973 --- /dev/null +++ b/src/core_atmosphere/tools/manage_externals/manic/externals_status.py @@ -0,0 +1,164 @@ +"""ExternalStatus + +Class to store status and state information about repositories and +create a string representation. + +""" +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +from .global_constants import EMPTY_STR +from .utils import printlog, indent_string +from .global_constants import VERBOSITY_VERBOSE, VERBOSITY_DUMP + + +class ExternalStatus(object): + """Class to represent the status of a given source repository or tree. + + Individual repositories determine their own status in the + Repository objects. This object is just resposible for storing the + information and passing it up to a higher level for reporting or + global decisions. + + There are two states of concern: + + * If the repository is in-sync with the externals description file. + + * If the repostiory working copy is clean and there are no pending + transactions (e.g. add, remove, rename, untracked files). + + """ + # sync_state and clean_state can be one of the following: + DEFAULT = '-' # not set yet (sync_state). clean_state can be this if sync_state is EMPTY. + UNKNOWN = '?' + EMPTY = 'e' + MODEL_MODIFIED = 's' # repo version != externals (sync_state only) + DIRTY = 'M' # repo is dirty (clean_state only) + STATUS_OK = ' ' # repo is clean (clean_state) or matches externals version (sync_state) + STATUS_ERROR = '!' + + # source_type can be one of the following: + OPTIONAL = 'o' + STANDALONE = 's' + MANAGED = ' ' + + def __init__(self): + self.sync_state = self.DEFAULT + self.clean_state = self.DEFAULT + self.source_type = self.DEFAULT + self.path = EMPTY_STR + self.current_version = EMPTY_STR + self.expected_version = EMPTY_STR + self.status_output = EMPTY_STR + + def log_status_message(self, verbosity): + """Write status message to the screen and log file + """ + printlog(self._default_status_message()) + if verbosity >= VERBOSITY_VERBOSE: + printlog(self._verbose_status_message()) + if verbosity >= VERBOSITY_DUMP: + printlog(self._dump_status_message()) + + def __repr__(self): + return self._default_status_message() + + def _default_status_message(self): + """Return the default terse status message string + """ + return '{sync}{clean}{src_type} {path}'.format( + sync=self.sync_state, clean=self.clean_state, + src_type=self.source_type, path=self.path) + + def _verbose_status_message(self): + """Return the verbose status message string + """ + clean_str = self.DEFAULT + if self.clean_state == self.STATUS_OK: + clean_str = 'clean sandbox' + elif self.clean_state == self.DIRTY: + clean_str = 'modified sandbox' + + sync_str = 'on {0}'.format(self.current_version) + if self.sync_state != self.STATUS_OK: + sync_str = '{current} --> {expected}'.format( + current=self.current_version, expected=self.expected_version) + return ' {clean}, {sync}'.format(clean=clean_str, sync=sync_str) + + def _dump_status_message(self): + """Return the dump status message string + """ + return indent_string(self.status_output, 12) + + def safe_to_update(self): + """Report if it is safe to update a repository. Safe is defined as: + + * If a repository is empty, it is safe to update. + + * If a repository exists and has a clean working copy state + with no pending transactions. + + """ + safe_to_update = False + repo_exists = self.exists() + if not repo_exists: + safe_to_update = True + else: + # If the repo exists, it must be in ok or modified + # sync_state. Any other sync_state at this point + # represents a logic error that should have been handled + # before now! + sync_safe = ((self.sync_state == ExternalStatus.STATUS_OK) or + (self.sync_state == ExternalStatus.MODEL_MODIFIED)) + if sync_safe: + # The clean_state must be STATUS_OK to update. Otherwise we + # are dirty or there was a missed error previously. + if self.clean_state == ExternalStatus.STATUS_OK: + safe_to_update = True + return safe_to_update + + def exists(self): + """Determine if the repo exists. This is indicated by: + + * sync_state is not EMPTY + + * if the sync_state is empty, then the valid states for + clean_state are default, empty or unknown. Anything else + and there was probably an internal logic error. + + NOTE(bja, 2017-10) For the moment we are considering a + sync_state of default or unknown to require user intervention, + but we may want to relax this convention. This is probably a + result of a network error or internal logic error but more + testing is needed. + + """ + is_empty = (self.sync_state == ExternalStatus.EMPTY) + clean_valid = ((self.clean_state == ExternalStatus.DEFAULT) or + (self.clean_state == ExternalStatus.EMPTY) or + (self.clean_state == ExternalStatus.UNKNOWN)) + + if is_empty and clean_valid: + exists = False + else: + exists = True + return exists + + +def check_safe_to_update_repos(tree_status): + """Check if *ALL* repositories are in a safe state to update. We don't + want to do a partial update of the repositories then die, leaving + the model in an inconsistent state. + + Note: if there is an update to do, the repositories will by + definiation be out of synce with the externals description, so we + can't use that as criteria for updating. + + """ + safe_to_update = True + for comp in tree_status: + stat = tree_status[comp] + safe_to_update &= stat.safe_to_update() + + return safe_to_update diff --git a/src/core_atmosphere/tools/manage_externals/manic/global_constants.py b/src/core_atmosphere/tools/manage_externals/manic/global_constants.py new file mode 100644 index 000000000..0e91cffc9 --- /dev/null +++ b/src/core_atmosphere/tools/manage_externals/manic/global_constants.py @@ -0,0 +1,18 @@ +"""Globals shared across modules +""" + +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +import pprint + +EMPTY_STR = '' +LOCAL_PATH_INDICATOR = '.' +VERSION_SEPERATOR = '.' +LOG_FILE_NAME = 'manage_externals.log' +PPRINTER = pprint.PrettyPrinter(indent=4) + +VERBOSITY_DEFAULT = 0 +VERBOSITY_VERBOSE = 1 +VERBOSITY_DUMP = 2 diff --git a/src/core_atmosphere/tools/manage_externals/manic/repository.py b/src/core_atmosphere/tools/manage_externals/manic/repository.py new file mode 100644 index 000000000..ea4230fb7 --- /dev/null +++ b/src/core_atmosphere/tools/manage_externals/manic/repository.py @@ -0,0 +1,98 @@ +"""Base class representation of a repository +""" + +from .externals_description import ExternalsDescription +from .utils import fatal_error +from .global_constants import EMPTY_STR + + +class Repository(object): + """ + Class to represent and operate on a repository description. + """ + + def __init__(self, component_name, repo): + """ + Parse repo externals description + """ + self._name = component_name + self._protocol = repo[ExternalsDescription.PROTOCOL] + self._tag = repo[ExternalsDescription.TAG] + self._branch = repo[ExternalsDescription.BRANCH] + self._hash = repo[ExternalsDescription.HASH] + self._url = repo[ExternalsDescription.REPO_URL] + self._sparse = repo[ExternalsDescription.SPARSE] + + if self._url is EMPTY_STR: + fatal_error('repo must have a URL') + + if ((self._tag is EMPTY_STR) and (self._branch is EMPTY_STR) and + (self._hash is EMPTY_STR)): + fatal_error('{0} repo must have a branch, tag or hash element') + + ref_count = 0 + if self._tag is not EMPTY_STR: + ref_count += 1 + if self._branch is not EMPTY_STR: + ref_count += 1 + if self._hash is not EMPTY_STR: + ref_count += 1 + if ref_count != 1: + fatal_error('repo {0} must have exactly one of ' + 'tag, branch or hash.'.format(self._name)) + + def checkout(self, base_dir_path, repo_dir_name, verbosity, recursive): # pylint: disable=unused-argument + """ + If the repo destination directory exists, ensure it is correct (from + correct URL, correct branch or tag), and possibly update the source. + If the repo destination directory does not exist, checkout the correce + branch or tag. + NB: is include as an argument for compatibility with + git functionality (repository_git.py) + """ + msg = ('DEV_ERROR: checkout method must be implemented in all ' + 'repository classes! {0}'.format(self.__class__.__name__)) + fatal_error(msg) + + def status(self, stat, repo_dir_path): # pylint: disable=unused-argument + """Report the status of the repo + + """ + msg = ('DEV_ERROR: status method must be implemented in all ' + 'repository classes! {0}'.format(self.__class__.__name__)) + fatal_error(msg) + + def submodules_file(self, repo_path=None): + # pylint: disable=no-self-use,unused-argument + """Stub for use by non-git VC systems""" + return None + + def url(self): + """Public access of repo url. + """ + return self._url + + def tag(self): + """Public access of repo tag + """ + return self._tag + + def branch(self): + """Public access of repo branch. + """ + return self._branch + + def hash(self): + """Public access of repo hash. + """ + return self._hash + + def name(self): + """Public access of repo name. + """ + return self._name + + def protocol(self): + """Public access of repo protocol. + """ + return self._protocol diff --git a/src/core_atmosphere/tools/manage_externals/manic/repository_factory.py b/src/core_atmosphere/tools/manage_externals/manic/repository_factory.py new file mode 100644 index 000000000..18c73ffc4 --- /dev/null +++ b/src/core_atmosphere/tools/manage_externals/manic/repository_factory.py @@ -0,0 +1,30 @@ +"""Factory for creating and initializing the appropriate repository class +""" + +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +from .repository_git import GitRepository +from .repository_svn import SvnRepository +from .externals_description import ExternalsDescription +from .utils import fatal_error + + +def create_repository(component_name, repo_info, svn_ignore_ancestry=False): + """Determine what type of repository we have, i.e. git or svn, and + create the appropriate object. + + Can return None (e.g. if protocol is 'externals_only'). + """ + protocol = repo_info[ExternalsDescription.PROTOCOL].lower() + if protocol == 'git': + repo = GitRepository(component_name, repo_info) + elif protocol == 'svn': + repo = SvnRepository(component_name, repo_info, ignore_ancestry=svn_ignore_ancestry) + elif protocol == 'externals_only': + repo = None + else: + msg = 'Unknown repo protocol "{0}"'.format(protocol) + fatal_error(msg) + return repo diff --git a/src/core_atmosphere/tools/manage_externals/manic/repository_git.py b/src/core_atmosphere/tools/manage_externals/manic/repository_git.py new file mode 100644 index 000000000..aab1a468a --- /dev/null +++ b/src/core_atmosphere/tools/manage_externals/manic/repository_git.py @@ -0,0 +1,859 @@ +"""Class for interacting with git repositories +""" + +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +import copy +import os +import sys + +from .global_constants import EMPTY_STR, LOCAL_PATH_INDICATOR +from .global_constants import VERBOSITY_VERBOSE +from .repository import Repository +from .externals_status import ExternalStatus +from .externals_description import ExternalsDescription, git_submodule_status +from .utils import expand_local_url, split_remote_url, is_remote_url +from .utils import fatal_error, printlog +from .utils import execute_subprocess + + +class GitRepository(Repository): + """Class to represent and operate on a repository description. + + For testing purpose, all system calls to git should: + + * be isolated in separate functions with no application logic + * of the form: + - cmd = 'git -C {dirname} ...'.format(dirname=dirname).split() + - value = execute_subprocess(cmd, output_to_caller={T|F}, + status_to_caller={T|F}) + - return value + * be static methods (not rely on self) + * name as _git_subcommand_args(user_args) + + This convention allows easy unit testing of the repository logic + by mocking the specific calls to return predefined results. + + """ + + def __init__(self, component_name, repo): + """ + repo: ExternalsDescription. + """ + Repository.__init__(self, component_name, repo) + self._gitmodules = None + self._submods = None + + # ---------------------------------------------------------------- + # + # Public API, defined by Repository + # + # ---------------------------------------------------------------- + def checkout(self, base_dir_path, repo_dir_name, verbosity, recursive): + """ + If the repo destination directory exists, ensure it is correct (from + correct URL, correct branch or tag), and possibly update the source. + If the repo destination directory does not exist, checkout the correct + branch or tag. + """ + repo_dir_path = os.path.join(base_dir_path, repo_dir_name) + repo_dir_exists = os.path.exists(repo_dir_path) + if (repo_dir_exists and not os.listdir( + repo_dir_path)) or not repo_dir_exists: + self._clone_repo(base_dir_path, repo_dir_name, verbosity) + self._checkout_ref(repo_dir_path, verbosity, recursive) + gmpath = os.path.join(repo_dir_path, + ExternalsDescription.GIT_SUBMODULES_FILENAME) + if os.path.exists(gmpath): + self._gitmodules = gmpath + self._submods = git_submodule_status(repo_dir_path) + else: + self._gitmodules = None + self._submods = None + + def status(self, stat, repo_dir_path): + """ + If the repo destination directory exists, ensure it is correct (from + correct URL, correct branch or tag), and possibly update the source. + If the repo destination directory does not exist, checkout the correct + branch or tag. + """ + self._check_sync(stat, repo_dir_path) + if os.path.exists(repo_dir_path): + self._status_summary(stat, repo_dir_path) + + def submodules_file(self, repo_path=None): + if repo_path is not None: + gmpath = os.path.join(repo_path, + ExternalsDescription.GIT_SUBMODULES_FILENAME) + if os.path.exists(gmpath): + self._gitmodules = gmpath + self._submods = git_submodule_status(repo_path) + + return self._gitmodules + + # ---------------------------------------------------------------- + # + # Internal work functions + # + # ---------------------------------------------------------------- + def _clone_repo(self, base_dir_path, repo_dir_name, verbosity): + """Clones repo_dir_name into base_dir_path. + """ + self._git_clone(self._url, os.path.join(base_dir_path, repo_dir_name), + verbosity=verbosity) + + def _current_ref(self, dirname): + """Determine the *name* associated with HEAD at dirname. + + If we're on a tag, then returns the tag name; otherwise, returns + the current hash. Returns an empty string if no reference can be + determined (e.g., if we're not actually in a git repository). + + If we're on a branch, then the branch name is also included in + the returned string (in addition to the tag / hash). + """ + ref_found = False + + # If we're exactly at a tag, use that as the current ref + tag_found, tag_name = self._git_current_tag(dirname) + if tag_found: + current_ref = tag_name + ref_found = True + + if not ref_found: + # Otherwise, use current hash as the current ref + hash_found, hash_name = self._git_current_hash(dirname) + if hash_found: + current_ref = hash_name + ref_found = True + + if ref_found: + # If we're on a branch, include branch name in current ref + branch_found, branch_name = self._git_current_branch(dirname) + if branch_found: + current_ref = "{} (branch {})".format(current_ref, branch_name) + else: + # If we still can't find a ref, return empty string. This + # can happen if we're not actually in a git repo + current_ref = '' + + return current_ref + + def _check_sync(self, stat, repo_dir_path): + """Determine whether a git repository is in-sync with the model + description. + + Because repos can have multiple remotes, the only criteria is + whether the branch or tag is the same. + + """ + if not os.path.exists(repo_dir_path): + # NOTE(bja, 2017-10) condition should have been determined + # by _Source() object and should never be here! + stat.sync_state = ExternalStatus.STATUS_ERROR + else: + git_dir = os.path.join(repo_dir_path, '.git') + if not os.path.exists(git_dir): + # NOTE(bja, 2017-10) directory exists, but no git repo + # info.... Can't test with subprocess git command + # because git will move up directory tree until it + # finds the parent repo git dir! + stat.sync_state = ExternalStatus.UNKNOWN + else: + self._check_sync_logic(stat, repo_dir_path) + + def _check_sync_logic(self, stat, repo_dir_path): + """Compare the underlying hashes of the currently checkout ref and the + expected ref. + + Output: sets the sync_state as well as the current and + expected ref in the input status object. + + """ + def compare_refs(current_ref, expected_ref): + """Compare the current and expected ref. + + """ + if current_ref == expected_ref: + status = ExternalStatus.STATUS_OK + else: + status = ExternalStatus.MODEL_MODIFIED + return status + + # get the full hash of the current commit + _, current_ref = self._git_current_hash(repo_dir_path) + + if self._branch: + if self._url == LOCAL_PATH_INDICATOR: + expected_ref = self._branch + else: + remote_name = self._remote_name_for_url(self._url, + repo_dir_path) + if not remote_name: + # git doesn't know about this remote. by definition + # this is a modified state. + expected_ref = "unknown_remote/{0}".format(self._branch) + else: + expected_ref = "{0}/{1}".format(remote_name, self._branch) + elif self._hash: + expected_ref = self._hash + elif self._tag: + expected_ref = self._tag + else: + msg = 'In repo "{0}": none of branch, hash or tag are set'.format( + self._name) + fatal_error(msg) + + # record the *names* of the current and expected branches + stat.current_version = self._current_ref(repo_dir_path) + stat.expected_version = copy.deepcopy(expected_ref) + + if current_ref == EMPTY_STR: + stat.sync_state = ExternalStatus.UNKNOWN + else: + # get the underlying hash of the expected ref + revparse_status, expected_ref_hash = self._git_revparse_commit( + expected_ref, repo_dir_path) + if revparse_status: + # We failed to get the hash associated with + # expected_ref. Maybe we should assign this to some special + # status, but for now we're just calling this out-of-sync to + # remain consistent with how this worked before. + stat.sync_state = ExternalStatus.MODEL_MODIFIED + else: + # compare the underlying hashes + stat.sync_state = compare_refs(current_ref, expected_ref_hash) + + @classmethod + def _remote_name_for_url(cls, remote_url, dirname): + """Return the remote name matching remote_url (or None) + + """ + git_output = cls._git_remote_verbose(dirname) + git_output = git_output.splitlines() + for line in git_output: + data = line.strip() + if not data: + continue + data = data.split() + name = data[0].strip() + url = data[1].strip() + if remote_url == url: + return name + return None + + def _create_remote_name(self): + """The url specified in the externals description file was not known + to git. We need to add it, which means adding a unique and + safe name.... + + The assigned name needs to be safe for git to use, e.g. can't + look like a path 'foo/bar' and work with both remote and local paths. + + Remote paths include but are not limited to: git, ssh, https, + github, gitlab, bitbucket, custom server, etc. + + Local paths can be relative or absolute. They may contain + shell variables, e.g. ${REPO_ROOT}/repo_name, or username + expansion, i.e. ~/ or ~someuser/. + + Relative paths must be at least one layer of redirection, i.e. + container/../ext_repo, but may be many layers deep, e.g. + container/../../../../../ext_repo + + NOTE(bja, 2017-11) + + The base name below may not be unique, for example if the + user has local paths like: + + /path/to/my/repos/nice_repo + /path/to/other/repos/nice_repo + + But the current implementation should cover most common + use cases for remotes and still provide usable names. + + """ + url = copy.deepcopy(self._url) + if is_remote_url(url): + url = split_remote_url(url) + else: + url = expand_local_url(url, self._name) + url = url.split('/') + repo_name = url[-1] + base_name = url[-2] + # repo name should nominally already be something that git can + # deal with. We need to remove other possibly troublesome + # punctuation, e.g. /, $, from the base name. + unsafe_characters = '!@#$%^&*()[]{}\\/,;~' + for unsafe in unsafe_characters: + base_name = base_name.replace(unsafe, '') + remote_name = "{0}_{1}".format(base_name, repo_name) + return remote_name + + def _checkout_ref(self, repo_dir, verbosity, submodules): + """Checkout the user supplied reference + if is True, recursively initialize and update + the repo's submodules + """ + # import pdb; pdb.set_trace() + if self._url.strip() == LOCAL_PATH_INDICATOR: + self._checkout_local_ref(verbosity, submodules, repo_dir) + else: + self._checkout_external_ref(verbosity, submodules, repo_dir) + + if self._sparse: + self._sparse_checkout(repo_dir, verbosity) + + + def _checkout_local_ref(self, verbosity, submodules, dirname): + """Checkout the reference considering the local repo only. Do not + fetch any additional remotes or specify the remote when + checkout out the ref. + if is True, recursively initialize and update + the repo's submodules + """ + if self._tag: + ref = self._tag + elif self._branch: + ref = self._branch + else: + ref = self._hash + + self._check_for_valid_ref(ref, remote_name=None, + dirname=dirname) + self._git_checkout_ref(ref, verbosity, submodules, dirname) + + def _checkout_external_ref(self, verbosity, submodules, dirname): + """Checkout the reference from a remote repository into dirname. + if is True, recursively initialize and update + the repo's submodules. + Note that this results in a 'detached HEAD' state if checking out + a branch, because we check out the remote branch rather than the + local. See https://github.com/ESMCI/manage_externals/issues/34 for + more discussion. + """ + if self._tag: + ref = self._tag + elif self._branch: + ref = self._branch + else: + ref = self._hash + + remote_name = self._remote_name_for_url(self._url, dirname) + if not remote_name: + remote_name = self._create_remote_name() + self._git_remote_add(remote_name, self._url, dirname) + self._git_fetch(remote_name, dirname) + + # NOTE(bja, 2018-03) we need to send separate ref and remote + # name to check_for_vaild_ref, but the combined name to + # checkout_ref! + self._check_for_valid_ref(ref, remote_name, dirname) + + if self._branch: + # Prepend remote name to branch. This means we avoid various + # special cases if the local branch is not tracking the remote or + # cannot be trivially fast-forwarded to match; but, it also + # means we end up in a 'detached HEAD' state. + ref = '{0}/{1}'.format(remote_name, ref) + self._git_checkout_ref(ref, verbosity, submodules, dirname) + + def _sparse_checkout(self, repo_dir, verbosity): + """Use git read-tree to thin the working tree.""" + cmd = ['cp', os.path.join(repo_dir, self._sparse), + os.path.join(repo_dir, + '.git/info/sparse-checkout')] + if verbosity >= VERBOSITY_VERBOSE: + printlog(' {0}'.format(' '.join(cmd))) + execute_subprocess(cmd) + self._git_sparse_checkout(verbosity, repo_dir) + + def _check_for_valid_ref(self, ref, remote_name, dirname): + """Try some basic sanity checks on the user supplied reference so we + can provide a more useful error message than calledprocess + error... + + remote_name can be NOne + """ + is_tag = self._ref_is_tag(ref, dirname) + is_branch = self._ref_is_branch(ref, remote_name, dirname) + is_hash = self._ref_is_hash(ref, dirname) + is_valid = is_tag or is_branch or is_hash + if not is_valid: + msg = ('In repo "{0}": reference "{1}" does not appear to be a ' + 'valid tag, branch or hash! Please verify the reference ' + 'name (e.g. spelling), is available from: {2} '.format( + self._name, ref, self._url)) + fatal_error(msg) + + if is_tag: + is_unique_tag, msg = self._is_unique_tag(ref, remote_name, + dirname) + if not is_unique_tag: + msg = ('In repo "{0}": tag "{1}" {2}'.format( + self._name, self._tag, msg)) + fatal_error(msg) + + return is_valid + + def _is_unique_tag(self, ref, remote_name, dirname): + """Verify that a reference is a valid tag and is unique (not a branch) + + Tags may be tag names, or SHA id's. It is also possible that a + branch and tag have the some name. + + Note: values returned by git_showref_* and git_revparse are + shell return codes, which are zero for success, non-zero for + error! + + """ + is_tag = self._ref_is_tag(ref, dirname) + is_branch = self._ref_is_branch(ref, remote_name, dirname) + is_hash = self._ref_is_hash(ref, dirname) + + msg = '' + is_unique_tag = False + if is_tag and not is_branch: + # unique tag + msg = 'is ok' + is_unique_tag = True + elif is_tag and is_branch: + msg = ('is both a branch and a tag. git may checkout the branch ' + 'instead of the tag depending on your version of git.') + is_unique_tag = False + elif not is_tag and is_branch: + msg = ('is a branch, and not a tag. If you intended to checkout ' + 'a branch, please change the externals description to be ' + 'a branch. If you intended to checkout a tag, it does not ' + 'exist. Please check the name.') + is_unique_tag = False + else: # not is_tag and not is_branch: + if is_hash: + # probably a sha1 or HEAD, etc, we call it a tag + msg = 'is ok' + is_unique_tag = True + else: + # undetermined state. + msg = ('does not appear to be a valid tag, branch or hash! ' + 'Please check the name and repository.') + is_unique_tag = False + + return is_unique_tag, msg + + def _ref_is_tag(self, ref, dirname): + """Verify that a reference is a valid tag according to git. + + Note: values returned by git_showref_* and git_revparse are + shell return codes, which are zero for success, non-zero for + error! + """ + is_tag = False + value = self._git_showref_tag(ref, dirname) + if value == 0: + is_tag = True + return is_tag + + def _ref_is_branch(self, ref, remote_name, dirname): + """Verify if a ref is any kind of branch (local, tracked remote, + untracked remote). + + remote_name can be None. + """ + local_branch = False + remote_branch = False + if remote_name: + remote_branch = self._ref_is_remote_branch(ref, remote_name, + dirname) + local_branch = self._ref_is_local_branch(ref, dirname) + + is_branch = False + if local_branch or remote_branch: + is_branch = True + return is_branch + + def _ref_is_local_branch(self, ref, dirname): + """Verify that a reference is a valid branch according to git. + + show-ref branch returns local branches that have been + previously checked out. It will not necessarily pick up + untracked remote branches. + + Note: values returned by git_showref_* and git_revparse are + shell return codes, which are zero for success, non-zero for + error! + + """ + is_branch = False + value = self._git_showref_branch(ref, dirname) + if value == 0: + is_branch = True + return is_branch + + def _ref_is_remote_branch(self, ref, remote_name, dirname): + """Verify that a reference is a valid branch according to git. + + show-ref branch returns local branches that have been + previously checked out. It will not necessarily pick up + untracked remote branches. + + Note: values returned by git_showref_* and git_revparse are + shell return codes, which are zero for success, non-zero for + error! + + """ + is_branch = False + value = self._git_lsremote_branch(ref, remote_name, dirname) + if value == 0: + is_branch = True + return is_branch + + def _ref_is_commit(self, ref, dirname): + """Verify that a reference is a valid commit according to git. + + This could be a tag, branch, sha1 id, HEAD and potentially others... + + Note: values returned by git_showref_* and git_revparse are + shell return codes, which are zero for success, non-zero for + error! + """ + is_commit = False + value, _ = self._git_revparse_commit(ref, dirname) + if value == 0: + is_commit = True + return is_commit + + def _ref_is_hash(self, ref, dirname): + """Verify that a reference is a valid hash according to git. + + Git doesn't seem to provide an exact way to determine if user + supplied reference is an actual hash. So we verify that the + ref is a valid commit and return the underlying commit + hash. Then check that the commit hash begins with the user + supplied string. + + Note: values returned by git_showref_* and git_revparse are + shell return codes, which are zero for success, non-zero for + error! + + """ + is_hash = False + status, git_output = self._git_revparse_commit(ref, dirname) + if status == 0: + if git_output.strip().startswith(ref): + is_hash = True + return is_hash + + def _status_summary(self, stat, repo_dir_path): + """Determine the clean/dirty status of a git repository + + """ + git_output = self._git_status_porcelain_v1z(repo_dir_path) + is_dirty = self._status_v1z_is_dirty(git_output) + if is_dirty: + stat.clean_state = ExternalStatus.DIRTY + else: + stat.clean_state = ExternalStatus.STATUS_OK + + # Now save the verbose status output incase the user wants to + # see it. + stat.status_output = self._git_status_verbose(repo_dir_path) + + @staticmethod + def _status_v1z_is_dirty(git_output): + """Parse the git status output from --porcelain=v1 -z and determine if + the repo status is clean or dirty. Dirty means: + + * modified files + * missing files + * added files + * removed + * renamed + * unmerged + + Whether untracked files are considered depends on how the status + command was run (i.e., whether it was run with the '-u' option). + + NOTE: Based on the above definition, the porcelain status + should be an empty string to be considered 'clean'. Of course + this assumes we only get an empty string from an status + command on a clean checkout, and not some error + condition... Could alse use 'git diff --quiet'. + + """ + is_dirty = False + if git_output: + is_dirty = True + return is_dirty + + # ---------------------------------------------------------------- + # + # system call to git for information gathering + # + # ---------------------------------------------------------------- + @staticmethod + def _git_current_hash(dirname): + """Return the full hash of the currently checked-out version. + + Returns a tuple, (hash_found, hash), where hash_found is a + logical specifying whether a hash was found for HEAD (False + could mean we're not in a git repository at all). (If hash_found + is False, then hash is ''.) + """ + status, git_output = GitRepository._git_revparse_commit("HEAD", + dirname) + hash_found = not status + if not hash_found: + git_output = '' + return hash_found, git_output + + @staticmethod + def _git_current_remote_branch(dirname): + """Determines the name of the current remote branch, if any. + + if dir is None, uses the cwd. + + Returns a tuple, (branch_found, branch_name), where branch_found + is a bool specifying whether a branch name was found for + HEAD. (If branch_found is False, then branch_name is ''). + branch_name is in the format '$remote/$branch', e.g. 'origin/foo'. + """ + branch_found = False + branch_name = '' + + cmd = 'git -C {dirname} log -n 1 --pretty=%d HEAD'.format( + dirname=dirname).split() + status, git_output = execute_subprocess(cmd, + output_to_caller=True, + status_to_caller=True) + branch_found = 'HEAD,' in git_output + if branch_found: + # git_output is of the form " (HEAD, origin/blah)" + branch_name = git_output.split(',')[1].strip()[:-1] + return branch_found, branch_name + + @staticmethod + def _git_current_branch(dirname): + """Determines the name of the current local branch. + + Returns a tuple, (branch_found, branch_name), where branch_found + is a bool specifying whether a branch name was found for + HEAD. (If branch_found is False, then branch_name is ''.) + Note that currently we check out the remote branch rather than + the local, so this command does not return the just-checked-out + branch. See _git_current_remote_branch. + """ + cmd = 'git -C {dirname} symbolic-ref --short -q HEAD'.format( + dirname=dirname).split() + status, git_output = execute_subprocess(cmd, + output_to_caller=True, + status_to_caller=True) + branch_found = not status + if branch_found: + git_output = git_output.strip() + else: + git_output = '' + return branch_found, git_output + + @staticmethod + def _git_current_tag(dirname): + """Determines the name tag corresponding to HEAD (if any). + + if dirname is None, uses the cwd. + + Returns a tuple, (tag_found, tag_name), where tag_found is a + bool specifying whether we found a tag name corresponding to + HEAD. (If tag_found is False, then tag_name is ''.) + """ + cmd = 'git -C {dirname} describe --exact-match --tags HEAD'.format( + dirname=dirname).split() + status, git_output = execute_subprocess(cmd, + output_to_caller=True, + status_to_caller=True) + tag_found = not status + if tag_found: + git_output = git_output.strip() + else: + git_output = '' + return tag_found, git_output + + @staticmethod + def _git_showref_tag(ref, dirname): + """Run git show-ref check if the user supplied ref is a tag. + + could also use git rev-parse --quiet --verify tagname^{tag} + """ + cmd = ('git -C {dirname} show-ref --quiet --verify refs/tags/{ref}' + .format(dirname=dirname, ref=ref).split()) + status = execute_subprocess(cmd, status_to_caller=True) + return status + + @staticmethod + def _git_showref_branch(ref, dirname): + """Run git show-ref check if the user supplied ref is a local or + tracked remote branch. + + """ + cmd = ('git -C {dirname} show-ref --quiet --verify refs/heads/{ref}' + .format(dirname=dirname, ref=ref).split()) + status = execute_subprocess(cmd, status_to_caller=True) + return status + + @staticmethod + def _git_lsremote_branch(ref, remote_name, dirname): + """Run git ls-remote to check if the user supplied ref is a remote + branch that is not being tracked + + """ + cmd = ('git -C {dirname} ls-remote --exit-code --heads ' + '{remote_name} {ref}').format( + dirname=dirname, remote_name=remote_name, ref=ref).split() + status, output = execute_subprocess(cmd, status_to_caller=True, output_to_caller=True) + if not status and not f"refs/heads/{ref}" in output: + # In this case the ref is contained in the branch name but is not the complete branch name + return -1 + return status + + @staticmethod + def _git_revparse_commit(ref, dirname): + """Run git rev-parse to detect if a reference is a SHA, HEAD or other + valid commit. + + """ + cmd = ('git -C {dirname} rev-parse --quiet --verify {ref}^{commit}' + .format(dirname=dirname, ref=ref, commit='{commit}').split()) + status, git_output = execute_subprocess(cmd, status_to_caller=True, + output_to_caller=True) + git_output = git_output.strip() + return status, git_output + + @staticmethod + def _git_status_porcelain_v1z(dirname): + """Run git status to obtain repository information. + + This is run with '--untracked=no' to ignore untracked files. + + The machine-portable format that is guaranteed not to change + between git versions or *user configuration*. + + """ + cmd = ('git -C {dirname} status --untracked-files=no --porcelain -z' + .format(dirname=dirname)).split() + git_output = execute_subprocess(cmd, output_to_caller=True) + return git_output + + @staticmethod + def _git_status_verbose(dirname): + """Run the git status command to obtain repository information. + """ + cmd = 'git -C {dirname} status'.format(dirname=dirname).split() + git_output = execute_subprocess(cmd, output_to_caller=True) + return git_output + + @staticmethod + def _git_remote_verbose(dirname): + """Run the git remote command to obtain repository information. + + Returned string is of the form: + myfork git@github.com:johnpaulalex/manage_externals_jp.git (fetch) + myfork git@github.com:johnpaulalex/manage_externals_jp.git (push) + """ + cmd = 'git -C {dirname} remote --verbose'.format( + dirname=dirname).split() + return execute_subprocess(cmd, output_to_caller=True) + + @staticmethod + def has_submodules(repo_dir_path): + """Return True iff the repository at has a + '.gitmodules' file + """ + fname = os.path.join(repo_dir_path, + ExternalsDescription.GIT_SUBMODULES_FILENAME) + + return os.path.exists(fname) + + # ---------------------------------------------------------------- + # + # system call to git for sideffects modifying the working tree + # + # ---------------------------------------------------------------- + @staticmethod + def _git_clone(url, repo_dir_name, verbosity): + """Clones url into repo_dir_name. + """ + cmd = 'git clone --quiet {url} {repo_dir_name}'.format( + url=url, repo_dir_name=repo_dir_name).split() + if verbosity >= VERBOSITY_VERBOSE: + printlog(' {0}'.format(' '.join(cmd))) + execute_subprocess(cmd) + + @staticmethod + def _git_remote_add(name, url, dirname): + """Run the git remote command for the side effect of adding a remote + """ + cmd = 'git -C {dirname} remote add {name} {url}'.format( + dirname=dirname, name=name, url=url).split() + execute_subprocess(cmd) + + @staticmethod + def _git_fetch(remote_name, dirname): + """Run the git fetch command for the side effect of updating the repo + """ + cmd = 'git -C {dirname} fetch --quiet --tags {remote_name}'.format( + dirname=dirname, remote_name=remote_name).split() + execute_subprocess(cmd) + + @staticmethod + def _git_checkout_ref(ref, verbosity, submodules, dirname): + """Run the git checkout command for the side effect of updating the repo + + Param: ref is a reference to a local or remote object in the + form 'origin/my_feature', or 'tag1'. + + """ + cmd = 'git -C {dirname} checkout --quiet {ref}'.format( + dirname=dirname, ref=ref).split() + if verbosity >= VERBOSITY_VERBOSE: + printlog(' {0}'.format(' '.join(cmd))) + execute_subprocess(cmd) + if submodules: + GitRepository._git_update_submodules(verbosity, dirname) + + @staticmethod + def _git_sparse_checkout(verbosity, dirname): + """Configure repo via read-tree.""" + cmd = 'git -C {dirname} config core.sparsecheckout true'.format( + dirname=dirname).split() + if verbosity >= VERBOSITY_VERBOSE: + printlog(' {0}'.format(' '.join(cmd))) + execute_subprocess(cmd) + cmd = 'git -C {dirname} read-tree -mu HEAD'.format( + dirname=dirname).split() + if verbosity >= VERBOSITY_VERBOSE: + printlog(' {0}'.format(' '.join(cmd))) + execute_subprocess(cmd) + + @staticmethod + def _git_update_submodules(verbosity, dirname): + """Run git submodule update for the side effect of updating this + repo's submodules. + """ + # due to https://vielmetti.typepad.com/logbook/2022/10/git-security-fixes-lead-to-fatal-transport-file-not-allowed-error-in-ci-systems-cve-2022-39253.html + # submodules from file doesn't work without overriding the protocol, this is done + # for testing submodule support but should not be done in practice + file_protocol = "" + if 'unittest' in sys.modules.keys(): + file_protocol = "-c protocol.file.allow=always" + + # First, verify that we have a .gitmodules file + if os.path.exists( + os.path.join(dirname, + ExternalsDescription.GIT_SUBMODULES_FILENAME)): + cmd = ('git {file_protocol} -C {dirname} submodule update --init --recursive' + .format(file_protocol=file_protocol, dirname=dirname)).split() + if verbosity >= VERBOSITY_VERBOSE: + printlog(' {0}'.format(' '.join(cmd))) + + execute_subprocess(cmd) diff --git a/src/core_atmosphere/tools/manage_externals/manic/repository_svn.py b/src/core_atmosphere/tools/manage_externals/manic/repository_svn.py new file mode 100644 index 000000000..b66c72e07 --- /dev/null +++ b/src/core_atmosphere/tools/manage_externals/manic/repository_svn.py @@ -0,0 +1,291 @@ +"""Class for interacting with svn repositories +""" + +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +import os +import re +import xml.etree.ElementTree as ET + +from .global_constants import EMPTY_STR, VERBOSITY_VERBOSE +from .repository import Repository +from .externals_status import ExternalStatus +from .utils import fatal_error, indent_string, printlog +from .utils import execute_subprocess + + +class SvnRepository(Repository): + """ + Class to represent and operate on a repository description. + + For testing purpose, all system calls to svn should: + + * be isolated in separate functions with no application logic + * of the form: + - cmd = ['svn', ...] + - value = execute_subprocess(cmd, output_to_caller={T|F}, + status_to_caller={T|F}) + - return value + * be static methods (not rely on self) + * name as _svn_subcommand_args(user_args) + + This convention allows easy unit testing of the repository logic + by mocking the specific calls to return predefined results. + + """ + RE_URLLINE = re.compile(r'^URL:') + + def __init__(self, component_name, repo, ignore_ancestry=False): + """ + Parse repo (a XML element). + """ + Repository.__init__(self, component_name, repo) + self._ignore_ancestry = ignore_ancestry + if self._url.endswith('/'): + # there is already a '/' separator in the URL; no need to add another + url_sep = '' + else: + url_sep = '/' + if self._branch: + self._url = self._url + url_sep + self._branch + elif self._tag: + self._url = self._url + url_sep + self._tag + else: + msg = "DEV_ERROR in svn repository. Shouldn't be here!" + fatal_error(msg) + + # ---------------------------------------------------------------- + # + # Public API, defined by Repository + # + # ---------------------------------------------------------------- + def checkout(self, base_dir_path, repo_dir_name, verbosity, recursive): # pylint: disable=unused-argument + """Checkout or update the working copy + + If the repo destination directory exists, switch the sandbox to + match the externals description. + + If the repo destination directory does not exist, checkout the + correct branch or tag. + NB: is include as an argument for compatibility with + git functionality (repository_git.py) + + """ + repo_dir_path = os.path.join(base_dir_path, repo_dir_name) + if 'github.com' in self._url: + msg = "SVN access to github.com is no longer supported" + fatal_error(msg) + if os.path.exists(repo_dir_path): + cwd = os.getcwd() + os.chdir(repo_dir_path) + self._svn_switch(self._url, self._ignore_ancestry, verbosity) + # svn switch can lead to a conflict state, but it gives a + # return code of 0. So now we need to make sure that we're + # in a clean (non-conflict) state. + self._abort_if_dirty(repo_dir_path, + "Expected clean state following switch") + os.chdir(cwd) + else: + self._svn_checkout(self._url, repo_dir_path, verbosity) + + def status(self, stat, repo_dir_path): + """ + Check and report the status of the repository + """ + self._check_sync(stat, repo_dir_path) + if os.path.exists(repo_dir_path): + self._status_summary(stat, repo_dir_path) + + # ---------------------------------------------------------------- + # + # Internal work functions + # + # ---------------------------------------------------------------- + def _check_sync(self, stat, repo_dir_path): + """Check to see if repository directory exists and is at the expected + url. Return: status object + + """ + if not os.path.exists(repo_dir_path): + # NOTE(bja, 2017-10) this state should have been handled by + # the source object and we never get here! + stat.sync_state = ExternalStatus.STATUS_ERROR + else: + svn_output = self._svn_info(repo_dir_path) + if not svn_output: + # directory exists, but info returned nothing. .svn + # directory removed or incomplete checkout? + stat.sync_state = ExternalStatus.UNKNOWN + else: + stat.sync_state, stat.current_version = \ + self._check_url(svn_output, self._url) + stat.expected_version = '/'.join(self._url.split('/')[3:]) + + def _abort_if_dirty(self, repo_dir_path, message): + """Check if the repo is in a dirty state; if so, abort with a + helpful message. + + """ + + stat = ExternalStatus() + self._status_summary(stat, repo_dir_path) + if stat.clean_state != ExternalStatus.STATUS_OK: + status = self._svn_status_verbose(repo_dir_path) + status = indent_string(status, 4) + errmsg = """In directory + {cwd} + +svn status now shows: +{status} + +ERROR: {message} + +One possible cause of this problem is that there may have been untracked +files in your working directory that had the same name as tracked files +in the new revision. + +To recover: Clean up the above directory (resolving conflicts, etc.), +then rerun checkout_externals. +""".format(cwd=repo_dir_path, message=message, status=status) + + fatal_error(errmsg) + + @staticmethod + def _check_url(svn_output, expected_url): + """Determine the svn url from svn info output and return whether it + matches the expected value. + + """ + url = None + for line in svn_output.splitlines(): + if SvnRepository.RE_URLLINE.match(line): + url = line.split(': ')[1].strip() + break + if not url: + status = ExternalStatus.UNKNOWN + elif url == expected_url: + status = ExternalStatus.STATUS_OK + else: + status = ExternalStatus.MODEL_MODIFIED + + if url: + current_version = '/'.join(url.split('/')[3:]) + else: + current_version = EMPTY_STR + + return status, current_version + + def _status_summary(self, stat, repo_dir_path): + """Report whether the svn repository is in-sync with the model + description and whether the sandbox is clean or dirty. + + """ + svn_output = self._svn_status_xml(repo_dir_path) + is_dirty = self.xml_status_is_dirty(svn_output) + if is_dirty: + stat.clean_state = ExternalStatus.DIRTY + else: + stat.clean_state = ExternalStatus.STATUS_OK + + # Now save the verbose status output incase the user wants to + # see it. + stat.status_output = self._svn_status_verbose(repo_dir_path) + + @staticmethod + def xml_status_is_dirty(svn_output): + """Parse svn status xml output and determine if the working copy is + clean or dirty. Dirty is defined as: + + * modified files + * added files + * deleted files + * missing files + + Unversioned files do not affect the clean/dirty status. + + 'external' is also an acceptable state + + """ + # pylint: disable=invalid-name + SVN_EXTERNAL = 'external' + SVN_UNVERSIONED = 'unversioned' + # pylint: enable=invalid-name + + is_dirty = False + try: + xml_status = ET.fromstring(svn_output) + except BaseException: + fatal_error( + "SVN returned invalid XML message {}".format(svn_output)) + xml_target = xml_status.find('./target') + entries = xml_target.findall('./entry') + for entry in entries: + status = entry.find('./wc-status') + item = status.get('item') + if item == SVN_EXTERNAL: + continue + if item == SVN_UNVERSIONED: + continue + is_dirty = True + break + return is_dirty + + # ---------------------------------------------------------------- + # + # system call to svn for information gathering + # + # ---------------------------------------------------------------- + @staticmethod + def _svn_info(repo_dir_path): + """Return results of svn info command + """ + cmd = ['svn', 'info', repo_dir_path] + output = execute_subprocess(cmd, output_to_caller=True) + return output + + @staticmethod + def _svn_status_verbose(repo_dir_path): + """capture the full svn status output + """ + cmd = ['svn', 'status', repo_dir_path] + svn_output = execute_subprocess(cmd, output_to_caller=True) + return svn_output + + @staticmethod + def _svn_status_xml(repo_dir_path): + """ + Get status of the subversion sandbox in repo_dir + """ + cmd = ['svn', 'status', '--xml', repo_dir_path] + svn_output = execute_subprocess(cmd, output_to_caller=True) + return svn_output + + # ---------------------------------------------------------------- + # + # system call to svn for sideffects modifying the working tree + # + # ---------------------------------------------------------------- + @staticmethod + def _svn_checkout(url, repo_dir_path, verbosity): + """ + Checkout a subversion repository (repo_url) to checkout_dir. + """ + cmd = ['svn', 'checkout', '--quiet', url, repo_dir_path] + if verbosity >= VERBOSITY_VERBOSE: + printlog(' {0}'.format(' '.join(cmd))) + execute_subprocess(cmd) + + @staticmethod + def _svn_switch(url, ignore_ancestry, verbosity): + """ + Switch branches for in an svn sandbox + """ + cmd = ['svn', 'switch', '--quiet'] + if ignore_ancestry: + cmd.append('--ignore-ancestry') + cmd.append(url) + if verbosity >= VERBOSITY_VERBOSE: + printlog(' {0}'.format(' '.join(cmd))) + execute_subprocess(cmd) diff --git a/src/core_atmosphere/tools/manage_externals/manic/sourcetree.py b/src/core_atmosphere/tools/manage_externals/manic/sourcetree.py new file mode 100644 index 000000000..cf2a5b756 --- /dev/null +++ b/src/core_atmosphere/tools/manage_externals/manic/sourcetree.py @@ -0,0 +1,425 @@ +""" +Classes to represent an externals config file (SourceTree) and the components +within it (_External). +""" + +import errno +import logging +import os + +from .externals_description import ExternalsDescription +from .externals_description import read_externals_description_file +from .externals_description import create_externals_description +from .repository_factory import create_repository +from .repository_git import GitRepository +from .externals_status import ExternalStatus +from .utils import fatal_error, printlog +from .global_constants import EMPTY_STR, LOCAL_PATH_INDICATOR +from .global_constants import VERBOSITY_VERBOSE + +class _External(object): + """ + A single component hosted in an external repository (and any children). + + The component may or may not be checked-out upon construction. + """ + # pylint: disable=R0902 + + def __init__(self, root_dir, name, local_path, required, subexternals_path, + repo, svn_ignore_ancestry, subexternal_sourcetree): + """Create a single external component (checked out or not). + + Input: + root_dir : string - the (checked-out) parent repo's root dir. + local_path : string - this external's (checked-out) subdir relative + to root_dir, e.g. "components/mom" + repo: Repository - the repo object for this external. Can be None (e.g. if this external just refers to another external file). + + name : string - name of this external (as named by the parent + reference). May or may not correspond to something in the path. + + ext_description : dict - source ExternalsDescription object + + svn_ignore_ancestry : bool - use --ignore-externals with svn switch + + subexternals_path: string - path to sub-externals config file, if any. Relative to local_path, or special value 'none'. + subexternal_sourcetree: SourceTree - corresponding to subexternals_path, if subexternals_path exists (it might not, if it is not checked out yet). + """ + self._name = name + self._required = required + + self._stat = None # Populated in status() + + self._local_path = local_path + # _repo_dir_path : full repository directory, e.g. + # "/components/mom" + repo_dir = os.path.join(root_dir, local_path) + self._repo_dir_path = os.path.abspath(repo_dir) + # _base_dir_path : base directory *containing* the repository, e.g. + # "/components" + self._base_dir_path = os.path.dirname(self._repo_dir_path) + # _repo_dir_name : base_dir_path + repo_dir_name = repo_dir_path + # e.g., "mom" + self._repo_dir_name = os.path.basename(self._repo_dir_path) + self._repo = repo + + # Does this component have subcomponents aka an externals config? + self._subexternals_path = subexternals_path + self._subexternal_sourcetree = subexternal_sourcetree + + + def get_name(self): + """ + Return the external object's name + """ + return self._name + + def get_local_path(self): + """ + Return the external object's path + """ + return self._local_path + + def get_repo_dir_path(self): + return self._repo_dir_path + + def get_subexternals_path(self): + return self._subexternals_path + + def get_repo(self): + return self._repo + + def status(self, force=False, print_progress=False): + """ + Returns status of this component and all subcomponents. + + Returns a dict mapping our local path (not component name!) to an + ExternalStatus dict. Any subcomponents will have their own top-level + path keys. Note the return value includes entries for this and all + subcomponents regardless of whether they are locally installed or not. + + Side-effect: If self._stat is empty or force is True, calculates _stat. + """ + calc_stat = force or not self._stat + + if calc_stat: + self._stat = ExternalStatus() + self._stat.path = self.get_local_path() + if not self._required: + self._stat.source_type = ExternalStatus.OPTIONAL + elif self._local_path == LOCAL_PATH_INDICATOR: + # LOCAL_PATH_INDICATOR, '.' paths, are standalone + # component directories that are not managed by + # checkout_subexternals. + self._stat.source_type = ExternalStatus.STANDALONE + else: + # managed by checkout_subexternals + self._stat.source_type = ExternalStatus.MANAGED + + subcomponent_stats = {} + if not os.path.exists(self._repo_dir_path): + if calc_stat: + # No local repository. + self._stat.sync_state = ExternalStatus.EMPTY + msg = ('status check: repository directory for "{0}" does not ' + 'exist.'.format(self._name)) + logging.info(msg) + self._stat.current_version = 'not checked out' + # NOTE(bja, 2018-01) directory doesn't exist, so we cannot + # use repo to determine the expected version. We just take + # a best-guess based on the assumption that only tag or + # branch should be set, but not both. + if not self._repo: + self._stat.expected_version = 'unknown' + else: + self._stat.expected_version = self._repo.tag() + self._repo.branch() + else: + # Merge local repository state (e.g. clean/dirty) into self._stat. + if calc_stat and self._repo: + self._repo.status(self._stat, self._repo_dir_path) + + # Status of subcomponents, if any. + if self._subexternals_path and self._subexternal_sourcetree: + cwd = os.getcwd() + # SourceTree.status() expects to be called from the correct + # root directory. + os.chdir(self._repo_dir_path) + subcomponent_stats = self._subexternal_sourcetree.status(self._local_path, force=force, print_progress=print_progress) + os.chdir(cwd) + + # Merge our status + subcomponent statuses into one return dict keyed + # by component path. + all_stats = {} + # don't add the root component because we don't manage it + # and can't provide useful info about it. + if self._local_path != LOCAL_PATH_INDICATOR: + # store the stats under the local_path, not comp name so + # it will be sorted correctly + all_stats[self._stat.path] = self._stat + + if subcomponent_stats: + all_stats.update(subcomponent_stats) + + return all_stats + + def checkout(self, verbosity): + """ + If the repo destination directory exists, ensure it is correct (from + correct URL, correct branch or tag), and possibly updateit. + If the repo destination directory does not exist, checkout the correct + branch or tag. + Does not check out sub-externals, see SourceTree.checkout(). + """ + # Make sure we are in correct location + if not os.path.exists(self._repo_dir_path): + # repository directory doesn't exist. Need to check it + # out, and for that we need the base_dir_path to exist + try: + os.makedirs(self._base_dir_path) + except OSError as error: + if error.errno != errno.EEXIST: + msg = 'Could not create directory "{0}"'.format( + self._base_dir_path) + fatal_error(msg) + + if not self._stat: + self.status() + assert self._stat + + if self._stat.source_type != ExternalStatus.STANDALONE: + if verbosity >= VERBOSITY_VERBOSE: + # NOTE(bja, 2018-01) probably do not want to pass + # verbosity in this case, because if (verbosity == + # VERBOSITY_DUMP), then the previous status output would + # also be dumped, adding noise to the output. + self._stat.log_status_message(VERBOSITY_VERBOSE) + + if self._repo: + if self._stat.sync_state == ExternalStatus.STATUS_OK: + # If we're already in sync, avoid showing verbose output + # from the checkout command, unless the verbosity level + # is 2 or more. + checkout_verbosity = verbosity - 1 + else: + checkout_verbosity = verbosity + + self._repo.checkout(self._base_dir_path, self._repo_dir_name, + checkout_verbosity, self.clone_recursive()) + + def replace_subexternal_sourcetree(self, sourcetree): + self._subexternal_sourcetree = sourcetree + + def clone_recursive(self): + 'Return True iff any .gitmodules files should be processed' + # Try recursive .gitmodules unless there is an externals entry + recursive = not self._subexternals_path + + return recursive + + +class SourceTree(object): + """ + SourceTree represents a group of managed externals. + + Those externals may not be checked out locally yet, they might only + have Repository objects pointing to their respective repositories. + """ + + @classmethod + def from_externals_file(cls, parent_repo_dir_path, parent_repo, + externals_path): + """Creates a SourceTree representing the given externals file. + + Looks up a git submodules file as an optional backup if there is no + externals file specified. + + Returns None if there is no externals file (i.e. it's None or 'none'), + or if the externals file hasn't been checked out yet. + + parent_repo_dir_path: parent repo root dir + parent_repo: parent repo. + externals_path: path to externals file, relative to parent_repo_dir_path. + """ + if not os.path.exists(parent_repo_dir_path): + # NOTE(bja, 2017-10) repository has not been checked out + # yet, can't process the externals file. Assume we are + # checking status before code is checkoud out and this + # will be handled correctly later. + return None + + if externals_path.lower() == 'none': + # With explicit 'none', do not look for git submodules file. + return None + + cwd = os.getcwd() + os.chdir(parent_repo_dir_path) + + if not externals_path: + if GitRepository.has_submodules(parent_repo_dir_path): + externals_path = ExternalsDescription.GIT_SUBMODULES_FILENAME + else: + return None + + if not os.path.exists(externals_path): + # NOTE(bja, 2017-10) this check is redundant with the one + # in read_externals_description_file! + msg = ('Externals description file "{0}" ' + 'does not exist! In directory: {1}'.format( + externals_path, parent_repo_dir_path)) + fatal_error(msg) + + externals_root = parent_repo_dir_path + # model_data is a dict-like object which mirrors the file format. + model_data = read_externals_description_file(externals_root, + externals_path) + # ext_description is another dict-like object (see ExternalsDescription) + ext_description = create_externals_description(model_data, + parent_repo=parent_repo) + externals_sourcetree = SourceTree(externals_root, ext_description) + os.chdir(cwd) + return externals_sourcetree + + def __init__(self, root_dir, ext_description, svn_ignore_ancestry=False): + """ + Build a SourceTree object from an ExternalDescription. + + root_dir: the (checked-out) parent repo root dir. + """ + self._root_dir = os.path.abspath(root_dir) + self._all_components = {} # component_name -> _External + self._required_compnames = [] + for comp, desc in ext_description.items(): + local_path = desc[ExternalsDescription.PATH] + required = desc[ExternalsDescription.REQUIRED] + repo_info = desc[ExternalsDescription.REPO] + subexternals_path = desc[ExternalsDescription.EXTERNALS] + + repo = create_repository(comp, + repo_info, + svn_ignore_ancestry=svn_ignore_ancestry) + + sourcetree = None + # Treat a .gitmodules file as a backup externals config + if not subexternals_path: + parent_repo_dir_path = os.path.abspath(os.path.join(root_dir, + local_path)) + if GitRepository.has_submodules(parent_repo_dir_path): + subexternals_path = ExternalsDescription.GIT_SUBMODULES_FILENAME + + # Might return None (if the subexternal isn't checked out yet, or subexternal is None or 'none') + subexternal_sourcetree = SourceTree.from_externals_file( + os.path.join(self._root_dir, local_path), + repo, + subexternals_path) + src = _External(self._root_dir, comp, local_path, required, + subexternals_path, repo, svn_ignore_ancestry, + subexternal_sourcetree) + + self._all_components[comp] = src + if required: + self._required_compnames.append(comp) + + def status(self, relative_path_base=LOCAL_PATH_INDICATOR, + force=False, print_progress=False): + """Return a dictionary of local path->ExternalStatus. + + Notes about the returned dictionary: + * It is keyed by local path (e.g. 'components/mom'), not by + component name (e.g. 'mom'). + * It contains top-level keys for all traversed components, whether + discovered by recursion or top-level. + * It contains entries for all components regardless of whether they + are locally installed or not, or required or optional. +x """ + load_comps = self._all_components.keys() + + summary = {} # Holds merged statuses from all components. + for comp in load_comps: + if print_progress: + printlog('{0}, '.format(comp), end='') + stat = self._all_components[comp].status(force=force, + print_progress=print_progress) + + # Returned status dictionary is keyed by local path; prepend + # relative_path_base if not already there. + stat_final = {} + for name in stat.keys(): + if stat[name].path.startswith(relative_path_base): + stat_final[name] = stat[name] + else: + modified_path = os.path.join(relative_path_base, + stat[name].path) + stat_final[modified_path] = stat[name] + stat_final[modified_path].path = modified_path + summary.update(stat_final) + + return summary + + def _find_installed_optional_components(self): + """Returns a list of installed optional component names, if any.""" + installed_comps = [] + for comp_name, ext in self._all_components.items(): + if comp_name in self._required_compnames: + continue + # Note that in practice we expect this status to be cached. + path_to_stat = ext.status() + + # If any part of this component exists locally, consider it + # installed and therefore eligible for updating. + if any(s.sync_state != ExternalStatus.EMPTY + for s in path_to_stat.values()): + installed_comps.append(comp_name) + return installed_comps + + def checkout(self, verbosity, load_all, load_comp=None): + """ + Checkout or update indicated components into the configured subdirs. + + If load_all is True, checkout all externals (required + optional), recursively. + If load_all is False and load_comp is set, checkout load_comp (and any required subexternals, plus any optional subexternals that are already checked out, recursively) + If load_all is False and load_comp is None, checkout all required externals, plus any optionals that are already checked out, recursively. + """ + if load_all: + tmp_comps = self._all_components.keys() + elif load_comp is not None: + tmp_comps = [load_comp] + else: + local_optional_compnames = self._find_installed_optional_components() + tmp_comps = self._required_compnames + local_optional_compnames + if local_optional_compnames: + printlog('Found locally installed optional components: ' + + ', '.join(local_optional_compnames)) + bad_compnames = set(local_optional_compnames) - set(self._all_components.keys()) + if bad_compnames: + printlog('Internal error: found locally installed components that are not in the global list of all components: ' + ','.join(bad_compnames)) + + if verbosity >= VERBOSITY_VERBOSE: + printlog('Checking out externals: ') + else: + printlog('Checking out externals: ', end='') + + # Sort by path so that if paths are nested the + # parent repo is checked out first. + load_comps = sorted(tmp_comps, key=lambda comp: self._all_components[comp].get_local_path()) + + # checkout. + for comp_name in load_comps: + if verbosity < VERBOSITY_VERBOSE: + printlog('{0}, '.format(comp_name), end='') + else: + # verbose output handled by the _External object, just + # output a newline + printlog(EMPTY_STR) + c = self._all_components[comp_name] + # Does not recurse. + c.checkout(verbosity) + # Recursively check out subexternals, if any. Returns None + # if there's no subexternals path. + component_subexternal_sourcetree = SourceTree.from_externals_file( + c.get_repo_dir_path(), + c.get_repo(), + c.get_subexternals_path()) + c.replace_subexternal_sourcetree(component_subexternal_sourcetree) + if component_subexternal_sourcetree: + component_subexternal_sourcetree.checkout(verbosity, load_all) + printlog('') diff --git a/src/core_atmosphere/tools/manage_externals/manic/utils.py b/src/core_atmosphere/tools/manage_externals/manic/utils.py new file mode 100644 index 000000000..9c63ffe65 --- /dev/null +++ b/src/core_atmosphere/tools/manage_externals/manic/utils.py @@ -0,0 +1,330 @@ +#!/usr/bin/env python3 +""" +Common public utilities for manic package + +""" + +from __future__ import absolute_import +from __future__ import unicode_literals +from __future__ import print_function + +import logging +import os +import subprocess +import sys +from threading import Timer + +from .global_constants import LOCAL_PATH_INDICATOR + +# --------------------------------------------------------------------- +# +# screen and logging output and functions to massage text for output +# +# --------------------------------------------------------------------- + + +def log_process_output(output): + """Log each line of process output at debug level so it can be + filtered if necessary. By default, output is a single string, and + logging.debug(output) will only put log info heading on the first + line. This makes it hard to filter with grep. + + """ + output = output.split('\n') + for line in output: + logging.debug(line) + + +def printlog(msg, **kwargs): + """Wrapper script around print to ensure that everything printed to + the screen also gets logged. + + """ + logging.info(msg) + if kwargs: + print(msg, **kwargs) + else: + print(msg) + sys.stdout.flush() + + +def last_n_lines(the_string, n_lines, truncation_message=None): + """Returns the last n lines of the given string + + Args: + the_string: str + n_lines: int + truncation_message: str, optional + + Returns a string containing the last n lines of the_string + + If truncation_message is provided, the returned string begins with + the given message if and only if the string is greater than n lines + to begin with. + """ + + lines = the_string.splitlines(True) + if len(lines) <= n_lines: + return_val = the_string + else: + lines_subset = lines[-n_lines:] + str_truncated = ''.join(lines_subset) + if truncation_message: + str_truncated = truncation_message + '\n' + str_truncated + return_val = str_truncated + + return return_val + + +def indent_string(the_string, indent_level): + """Indents the given string by a given number of spaces + + Args: + the_string: str + indent_level: int + + Returns a new string that is the same as the_string, except that + each line is indented by 'indent_level' spaces. + + In python3, this can be done with textwrap.indent. + """ + + lines = the_string.splitlines(True) + padding = ' ' * indent_level + lines_indented = [padding + line for line in lines] + return ''.join(lines_indented) + +# --------------------------------------------------------------------- +# +# error handling +# +# --------------------------------------------------------------------- + + +def fatal_error(message): + """ + Error output function + """ + logging.error(message) + raise RuntimeError("{0}ERROR: {1}".format(os.linesep, message)) + + +# --------------------------------------------------------------------- +# +# Data conversion / manipulation +# +# --------------------------------------------------------------------- +def str_to_bool(bool_str): + """Convert a sting representation of as boolean into a true boolean. + + Conversion should be case insensitive. + """ + value = None + str_lower = bool_str.lower() + if str_lower in ('true', 't'): + value = True + elif str_lower in ('false', 'f'): + value = False + if value is None: + msg = ('ERROR: invalid boolean string value "{0}". ' + 'Must be "true" or "false"'.format(bool_str)) + fatal_error(msg) + return value + + +REMOTE_PREFIXES = ['http://', 'https://', 'ssh://', 'git@'] + + +def is_remote_url(url): + """check if the user provided a local file path instead of a + remote. If so, it must be expanded to an absolute + path. + + """ + remote_url = False + for prefix in REMOTE_PREFIXES: + if url.startswith(prefix): + remote_url = True + return remote_url + + +def split_remote_url(url): + """check if the user provided a local file path or a + remote. If remote, try to strip off protocol info. + + """ + remote_url = is_remote_url(url) + if not remote_url: + return url + + for prefix in REMOTE_PREFIXES: + url = url.replace(prefix, '') + + if '@' in url: + url = url.split('@')[1] + + if ':' in url: + url = url.split(':')[1] + + return url + + +def expand_local_url(url, field): + """check if the user provided a local file path instead of a + remote. If so, it must be expanded to an absolute + path. + + Note: local paths of LOCAL_PATH_INDICATOR have special meaning and + represent local copy only, don't work with the remotes. + + """ + remote_url = is_remote_url(url) + if not remote_url: + if url.strip() == LOCAL_PATH_INDICATOR: + pass + else: + url = os.path.expandvars(url) + url = os.path.expanduser(url) + if not os.path.isabs(url): + msg = ('WARNING: Externals description for "{0}" contains a ' + 'url that is not remote and does not expand to an ' + 'absolute path. Version control operations may ' + 'fail.\n\nurl={1}'.format(field, url)) + printlog(msg) + else: + url = os.path.normpath(url) + return url + + +# --------------------------------------------------------------------- +# +# subprocess +# +# --------------------------------------------------------------------- + +# Give the user a helpful message if we detect that a command seems to +# be hanging. +_HANGING_SEC = 300 + + +def _hanging_msg(working_directory, command): + print(""" + +Command '{command}' +from directory {working_directory} +has taken {hanging_sec} seconds. It may be hanging. + +The command will continue to run, but you may want to abort +manage_externals with ^C and investigate. A possible cause of hangs is +when svn or git require authentication to access a private +repository. On some systems, svn and git requests for authentication +information will not be displayed to the user. In this case, the program +will appear to hang. Ensure you can run svn and git manually and access +all repositories without entering your authentication information. + +""".format(command=command, + working_directory=working_directory, + hanging_sec=_HANGING_SEC)) + + +def execute_subprocess(commands, status_to_caller=False, + output_to_caller=False): + """Wrapper around subprocess.check_output to handle common + exceptions. + + check_output runs a command with arguments and waits + for it to complete. + + check_output raises an exception on a nonzero return code. if + status_to_caller is true, execute_subprocess returns the subprocess + return code, otherwise execute_subprocess treats non-zero return + status as an error and raises an exception. + + """ + cwd = os.getcwd() + msg = 'In directory: {0}\nexecute_subprocess running command:'.format(cwd) + logging.info(msg) + commands_str = ' '.join(commands) + logging.info(commands_str) + return_to_caller = status_to_caller or output_to_caller + status = -1 + output = '' + hanging_timer = Timer(_HANGING_SEC, _hanging_msg, + kwargs={"working_directory": cwd, + "command": commands_str}) + hanging_timer.start() + try: + output = subprocess.check_output(commands, stderr=subprocess.STDOUT, + universal_newlines=True) + log_process_output(output) + status = 0 + except OSError as error: + msg = failed_command_msg( + 'Command execution failed. Does the executable exist?', + commands) + logging.error(error) + fatal_error(msg) + except ValueError as error: + msg = failed_command_msg( + 'DEV_ERROR: Invalid arguments trying to run subprocess', + commands) + logging.error(error) + fatal_error(msg) + except subprocess.CalledProcessError as error: + # Only report the error if we are NOT returning to the + # caller. If we are returning to the caller, then it may be a + # simple status check. If returning, it is the callers + # responsibility determine if an error occurred and handle it + # appropriately. + if not return_to_caller: + msg_context = ('Process did not run successfully; ' + 'returned status {0}'.format(error.returncode)) + msg = failed_command_msg(msg_context, commands, + output=error.output) + logging.error(error) + logging.error(msg) + log_process_output(error.output) + fatal_error(msg) + status = error.returncode + finally: + hanging_timer.cancel() + + if status_to_caller and output_to_caller: + ret_value = (status, output) + elif status_to_caller: + ret_value = status + elif output_to_caller: + ret_value = output + else: + ret_value = None + + return ret_value + + +def failed_command_msg(msg_context, command, output=None): + """Template for consistent error messages from subprocess calls. + + If 'output' is given, it should provide the output from the failed + command + """ + + if output: + output_truncated = last_n_lines(output, 20, + truncation_message='[... Output truncated for brevity ...]') + errmsg = ('Failed with output:\n' + + indent_string(output_truncated, 4) + + '\nERROR: ') + else: + errmsg = '' + + command_str = ' '.join(command) + errmsg += """In directory + {cwd} +{context}: + {command} +""".format(cwd=os.getcwd(), context=msg_context, command=command_str) + + if output: + errmsg += 'See above for output from failed command.\n' + + return errmsg diff --git a/src/core_atmosphere/tools/manage_externals/version.txt b/src/core_atmosphere/tools/manage_externals/version.txt new file mode 100644 index 000000000..cbda54c51 --- /dev/null +++ b/src/core_atmosphere/tools/manage_externals/version.txt @@ -0,0 +1 @@ +manic-1.2.24-3-gba00e50 diff --git a/src/core_init_atmosphere/CMakeLists.txt b/src/core_init_atmosphere/CMakeLists.txt new file mode 100644 index 000000000..01e09fea4 --- /dev/null +++ b/src/core_init_atmosphere/CMakeLists.txt @@ -0,0 +1,82 @@ +# MPAS/src/core_init_atmosphere +# +# Targets +# MPAS::core::init_atmosphere + +## Generated includes +set(init_atm_core_inc + block_dimension_routines.inc + core_variables.inc + define_packages.inc + domain_variables.inc + namelist_call.inc + namelist_defines.inc + setup_immutable_streams.inc + structs_and_variables.inc) + +## core_init_atosphere +set(init_atm_core_srcs + mpas_atm_advection.F + mpas_atmphys_constants.F + mpas_atmphys_date_time.F + mpas_atmphys_functions.F + mpas_atmphys_initialize_real.F + mpas_atmphys_utilities.F + mpas_geotile_manager.F + mpas_gsl_oro_data_sm_scale.F + mpas_gsl_oro_data_lg_scale.F + mpas_init_atm_bitarray.F + mpas_init_atm_cases.F + mpas_init_atm_core.F + mpas_init_atm_core_interface.F + mpas_init_atm_thompson_aerosols.F + mpas_init_atm_gwd.F + mpas_init_atm_gwd_gsl.F + mpas_init_atm_hinterp.F + mpas_init_atm_llxy.F + mpas_init_atm_queue.F + mpas_init_atm_read_met.F + mpas_init_atm_static.F + mpas_init_atm_surface.F + mpas_init_atm_vinterp.F + mpas_kd_tree.F + mpas_parse_geoindex.F + mpas_stack.F + read_geogrid.c) + +add_library(core_init_atmosphere ${init_atm_core_srcs}) +if (${DO_PHYSICS}) + target_compile_definitions(core_init_atmosphere PRIVATE DO_PHYSICS) +endif () +if (MPAS_DOUBLE_PRECISION) + set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -fdefault-real-8 -fdefault-double-8") +else () + target_compile_definitions(core_init_atmosphere PRIVATE SINGLE_PRECISION) +endif () +if (${CMAKE_BUILD_TYPE} MATCHES "Debug") + target_compile_definitions(core_init_atmosphere PRIVATE MPAS_DEBUG) +endif () +if (${PIO_FOUND}) + FILE(STRINGS ${PIO_PREFIX}/lib/libpio.settings PIO_SETTINGS) + foreach (setting ${PIO_SETTINGS}) + string(FIND ${setting} "PIO Version" found) + if (${found} GREATER -1) + string(FIND ${setting} "2." pos) + if (${pos} GREATER -1) + set(PIO_VERSION 2) + else () + set(PIO_VERSION 1) + endif () + break() + endif () + endforeach () + if (${PIO_VERSION} EQUAL 1) + target_compile_definitions(core_init_atmosphere PRIVATE USE_PIO1) + else () + target_compile_definitions(core_init_atmosphere PRIVATE USE_PIO2) + endif () + target_compile_definitions(core_init_atmosphere PRIVATE MPAS_PIO_SUPPORT) +endif () +target_compile_definitions(core_init_atmosphere PRIVATE mpas=1) +target_compile_definitions(framework PRIVATE MPAS_NATIVE_TIMERS) +mpas_core_target(CORE init_atmosphere TARGET core_init_atmosphere INCLUDES ${init_atm_core_inc}) diff --git a/src/core_init_atmosphere/Makefile b/src/core_init_atmosphere/Makefile index 9494a5b7c..f0c08a1ca 100644 --- a/src/core_init_atmosphere/Makefile +++ b/src/core_init_atmosphere/Makefile @@ -12,8 +12,12 @@ OBJS = \ mpas_init_atm_hinterp.o \ mpas_init_atm_static.o \ mpas_init_atm_gwd.o \ + mpas_gsl_oro_data_sm_scale.o \ + mpas_gsl_oro_data_lg_scale.o \ + mpas_init_atm_gwd_gsl.o \ mpas_init_atm_surface.o \ mpas_init_atm_vinterp.o \ + mpas_init_atm_thompson_aerosols.o \ read_geogrid.o \ mpas_atmphys_constants.o \ mpas_atmphys_date_time.o \ @@ -41,7 +45,7 @@ core_input_gen: gen_includes: $(CPP) $(CPPFLAGS) $(CPPINCLUDES) Registry.xml > Registry_processed.xml (if [ ! -d inc ]; then mkdir -p inc; fi) # To generate *.inc files - (cd inc; $(REG_PARSE) < ../Registry_processed.xml ) + (cd inc; $(REG_PARSE) ../Registry_processed.xml $(CPPFLAGS) ) post_build: if [ ! -e $(ROOT_DIR)/default_inputs ]; then mkdir $(ROOT_DIR)/default_inputs; fi @@ -56,7 +60,9 @@ mpas_init_atm_cases.o: \ mpas_init_atm_hinterp.o \ mpas_init_atm_static.o \ mpas_init_atm_gwd.o \ + mpas_init_atm_gwd_gsl.o \ mpas_init_atm_surface.o \ + mpas_init_atm_thompson_aerosols.o \ mpas_init_atm_vinterp.o \ mpas_atmphys_constants.o \ mpas_atmphys_functions.o \ @@ -64,6 +70,14 @@ mpas_init_atm_cases.o: \ mpas_init_atm_hinterp.o: mpas_init_atm_queue.o mpas_init_atm_bitarray.o +mpas_init_atm_thompson_aerosols.o: \ + mpas_init_atm_read_met.o \ + mpas_init_atm_hinterp.o \ + mpas_init_atm_llxy.o \ + mpas_init_atm_vinterp.o \ + mpas_atmphys_date_time.o \ + mpas_atmphys_utilities.o + mpas_advection.o: mpas_init_atm_read_met.o: @@ -104,6 +118,10 @@ mpas_atmphys_initialize_real.o: \ mpas_atmphys_date_time.o \ mpas_atmphys_utilities.o +mpas_init_atm_gwd_gsl.o: \ + mpas_gsl_oro_data_sm_scale.o \ + mpas_gsl_oro_data_lg_scale.o + clean: $(RM) *.o *.mod *.f90 libdycore.a $(RM) Registry_processed.xml diff --git a/src/core_init_atmosphere/Registry.xml b/src/core_init_atmosphere/Registry.xml index ff461e6d4..36b8918fc 100644 --- a/src/core_init_atmosphere/Registry.xml +++ b/src/core_init_atmosphere/Registry.xml @@ -1,5 +1,5 @@ - + @@ -38,6 +38,10 @@ description="The number of first-guess soil layers"/> + + @@ -62,7 +66,7 @@ 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 \newline 13 = CAM-MPAS 3-d grid with specified topography and zeta levels" - possible_values="1 -- 9"/> + possible_values="1 -- 9, or 13"/> + + + possible_values="`USGS', `MODIFIED_IGBP_MODIS_NOAH', or `MODIFIED_IGBP_MODIS_NOAH_15s'"/> + + + + + + + + + + + @@ -416,6 +448,11 @@ + + + + + @@ -516,6 +553,11 @@ + + + + + @@ -550,7 +592,7 @@ - + @@ -585,6 +627,35 @@ + + + + + + + + + + + + + + + + + + + + + + + + - + - - - + + + + + + + + + + + - @@ -841,6 +933,101 @@ description="effective orographic length for north-westerly flow" packages="gwd_stage_out;vertical_stage_out;met_stage_out"/> + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - + + + @@ -1015,6 +1205,14 @@ + + + + @@ -1147,7 +1345,7 @@ description="geopotential height vertically interpolated from first guess" packages="met_stage_out"/> - diff --git a/src/core_init_atmosphere/mpas_geotile_manager.F b/src/core_init_atmosphere/mpas_geotile_manager.F index 64e89212f..04f9c60d0 100644 --- a/src/core_init_atmosphere/mpas_geotile_manager.F +++ b/src/core_init_atmosphere/mpas_geotile_manager.F @@ -345,9 +345,9 @@ function mpas_geotile_mgr_finalize(mgr) result(ierr) endif enddo enddo - deallocate(mgr % hash) + deallocate(mgr % hash, stat=ierr) - if (associated(mgr % hash)) then + if (associated(mgr % hash) .or. (ierr /= 0)) then call mpas_log_write("Problem deallocating the geotile hash table", messageType=MPAS_LOG_ERR) ierr = -1 return diff --git a/src/core_init_atmosphere/mpas_gsl_oro_data_lg_scale.F b/src/core_init_atmosphere/mpas_gsl_oro_data_lg_scale.F new file mode 100644 index 000000000..1397add64 --- /dev/null +++ b/src/core_init_atmosphere/mpas_gsl_oro_data_lg_scale.F @@ -0,0 +1,1039 @@ +! This module calculates the parameters required for the subgrid- +! scale orographic gravity-wave drag (GWDO) scheme on the MPAS +! grid. These parameters are for the large-scale GWDO and blocking +! schemes of the GSL drag suite. 2.5minute (~5km) global topography +! is used. The topographic data comes from the 'fix' file +! geo_em.d01.lat-lon.2.5m.HGT_M.nc. +! The output fields are: +! - stddev standard deviation of subgrid-scale topograpy +! - convexity convexity (kurtosis) of subgrid-scale topography +! - ol{1,2,3,4} orographic effective lengths of subgrid-scale topography +! for 4 orientations: 1-westerly, 2-southerly, 3-southwesterly, 4-northwesterly +! - oa{1,2,3,4} orographic asymmetries of subgrid-scale topography +! for 4 orientations: 1-westerly, 2-southerly, 3-southwesterly, 4-northwesterly +! +! Based on code by Michael Duda provided by NCAR/MMM +! +module mpas_gsl_oro_data_lg_scale + +use iso_c_binding, only : c_char, c_int, c_float, c_ptr, c_loc + +use mpas_derived_types +use mpas_framework +use mpas_kind_types +use mpas_log, only : mpas_log_write +use mpas_stream_manager +use mpas_c_interfacing, only : mpas_f_to_c_string + +implicit none + +public :: calc_gsl_oro_data_lg_scale + +private + + interface + subroutine read_geogrid(fname, rarray, nx, ny, nz, isigned, endian, & + 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 + integer (c_int), intent(in), value :: wordsize + integer (c_int), intent(inout) :: status + end subroutine read_geogrid + end interface + +real (kind=RKIND), parameter :: Pi = 2.0_RKIND * asin(1.0_RKIND) + +integer, parameter :: topo_x = 8640 ! x-dimension of fine grid (30-arc-second topog array) +integer, parameter :: topo_y = 4320 ! y-dimension of fine grid (30-arc-second topog array) + +real (kind=RKIND), allocatable :: lat1d_fine(:) !< latitude of fine grid pts (radians) +real (kind=RKIND), allocatable :: lon1d_fine(:) !< longitude of fine grid pts (radians) + +real (kind=RKIND), allocatable :: lon_MPAS(:) ! "adjusted" longitude + +real (kind=RKIND), parameter :: p5 = 0.5_RKIND !< one half + +real (kind=R4KIND), allocatable :: HGT_M_fine(:,:) +real (kind=RKIND), parameter :: HGT_missing = 1.E+10 ! Flag for missing data + + +contains + +subroutine calc_gsl_oro_data_lg_scale(nCells,lat_MPAS,lon_MPAS_raw,area_MPAS, & + Re,std_dev,convexity,OA1,OA2,OA3,OA4, & + OL1,OL2,OL3,OL4,domain,duplicate_oro_data) + +implicit none + +type (domain_type), intent(inout) :: domain + +integer, intent(in) :: nCells +real (kind=RKIND), dimension(:), intent(in) :: lat_MPAS, lon_MPAS_raw ! radians +real (kind=RKIND), dimension(:), intent(in) :: area_MPAS ! approx area of MPAS grid cell (m^2) +real (kind=RKIND), intent(in) :: Re +real (kind=RKIND), dimension(:), intent(out) :: std_dev,convexity,OA1,OA2,OA3,OA4, & + OL1,OL2,OL3,OL4 +logical, dimension(:), intent(in) :: duplicate_oro_data + +integer (c_int) :: istatus +integer :: ix, iy +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 + + +integer :: i,j,ii,jj +integer :: iErr + +integer, parameter :: tile_x = 8640 ! x-dimension of each tile of global 30-arc-second topography +integer, parameter :: tile_y = 4320 ! y-dimension of each tile of global 30-arc-second topography +integer, parameter :: tile_bdr = 0 ! number of layers of border/halo points surrounding each tile + +integer :: nfinepoints ! number of fine grid points in each coarse grid cell + +real (kind=RKIND) :: sum2, sum4, var + + +real (kind=RKIND), allocatable :: zs(:,:) + +logical :: zs_accum + +real (kind=RKIND) :: zs_mean + +real (kind=RKIND), parameter :: max_convexity = 10._RKIND ! max value for convexity + +integer :: nu, nd, nw, nt +real (kind=RKIND) :: ratio + + +real (kind=RKIND) :: dlta_lat, dlta_lon + +character(len=StrKIND), pointer :: config_geog_data_path +character(len=StrKIND) :: geog_sub_path +character(len=StrKIND+1) :: geog_data_path ! same as config_geog_data_path, but guaranteed to have a trailing slash + +integer :: i_blk, j_blk +integer :: ii_loc, jj_loc, ii_m, jj_m +integer, dimension(3) :: s_ii, e_ii, s_jj, e_jj +real (kind=RKIND), dimension(3) :: lat_blk, lon_blk +real (kind=RKIND), dimension(3,3) :: HGT_M_coarse +real (kind=RKIND), allocatable :: HGT_M_coarse_on_fine(:,:) + +logical, parameter :: detrend_topography = .true. ! switch for using detrended + ! or actual fine-grid topography + ! to represent subgrid terrain + + +call mpas_log_write('Creating oro_data_ls fields') + +call mpas_pool_get_config(domain % 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 +geog_sub_path = 'topo_ugwp_2.5m/' + +! +! Retrieve 2.5m topo data from WPS_GEOG +! +isigned = 1 +endian = 0 +wordsize = 4 +scalefactor = 0.1 +nx = tile_x + 2*tile_bdr +ny = tile_y + 2*tile_bdr +nz = 1 + +allocate(HGT_M_fine(topo_x,topo_y)) +allocate(tile(tile_x+2*tile_bdr,tile_y+2*tile_bdr,1)) +tile_ptr = c_loc(tile) + +do iy=1,topo_y,tile_y +do ix=1,topo_x,tile_x + write(filename,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)//trim(geog_sub_path), & + ix, '-', (ix+tile_x-1), '.', iy, '-', (iy+tile_y-1) + call mpas_f_to_c_string(filename, c_filename) + call read_geogrid(c_filename, tile_ptr, nx, ny, nz, isigned, endian, & + wordsize, istatus) + tile(:,:,:) = tile(:,:,:) * scalefactor + if (istatus /= 0) then + call mpas_log_write('Error reading topography tile '//trim(filename), messageType=MPAS_LOG_ERR) + iErr = 1 + return + end if + HGT_M_fine(ix:(ix+tile_x-1),iy:(iy+tile_y-1)) = tile((tile_bdr+1):(tile_x+tile_bdr),(tile_bdr+1):(tile_y+tile_bdr),1) +end do +end do + +deallocate(tile) + + +! Calculate fine grid lat/lon in radians +allocate (lat1d_fine(topo_y)) +allocate (lon1d_fine(topo_x)) +do j = 1,topo_y + lat1d_fine(j) = ( -90._RKIND + (180._RKIND/topo_y)*(j-p5) )*Pi/180._RKIND +end do +do i = 1,topo_x + lon1d_fine(i) = (-180._RKIND + (360._RKIND/topo_x)*(i-p5) )*Pi/180._RKIND +end do + + +! Reassign MPAS longitude to vary from -Pi to Pi to match lon1d_fine range +! Transfer data from lon_MPAS_raw to lon_MPAS +allocate (lon_MPAS(nCells)) +do i = 1,nCells + if ( lon_MPAS_raw(i).gt.Pi ) then + lon_MPAS(i) = lon_MPAS_raw(i) - 2*Pi + else + lon_MPAS(i) = lon_MPAS_raw(i) + end if +end do + +! Initialize GWD statistics fields +std_dev(:) = 0._RKIND +convexity(:) = 0._RKIND +OA1(:) = 0._RKIND +OA2(:) = 0._RKIND +OA3(:) = 0._RKIND +OA4(:) = 0._RKIND +OL1(:) = 0._RKIND +OL2(:) = 0._RKIND +OL3(:) = 0._RKIND +OL4(:) = 0._RKIND + + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! This is a loop over all the MPAS (coarse) grid cells +! The subgrid-scale topographic variables needed for the large-scale +! orographic gravity wave drag schemes are calculated by the following steps: +! 1) Sample the fine-scale (2.5min) topography contained within each +! coarse grid cell. +! 2) Detrend the topography by subtracting a bilinear-interpolated height field +! from the fine-scale height field (if detrend_topography = .true.), +! otherwise actual fine-scale height field is used to calculate statistics +! 3) Calculate the orographic statistics: stddev,convexity,oa1,...oa4, +! ol1,...,ol4 +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + +do i = 1,nCells + + ! Skip calculation if grid size less than 7.5km + if ( duplicate_oro_data(i) ) cycle + + ! Calculate approximate side-lengths of square lat-long "coarse" grid + ! cell centered on MPAS cell (units = radians) + dlta_lat = sqrt(area_MPAS(i))/Re + dlta_lon = sqrt(area_MPAS(i))/(Re*COS(lat_MPAS(i))) + + ! Determine lat/lon of 9 lat-lon block centers + ! Note: lat_blk(2)/lon_blk(2) = lat_MPAS(i)/lon_MPAS(i) + ! Note: abs(lon_blk) may exceed pi + do i_blk = 1,3 + lon_blk(i_blk) = lon_MPAS(i) + (i_blk-2)*dlta_lon + end do + ! Note: abs(lat_blk) may exceed pi/2 (90 degrees) + do j_blk = 1,3 + lat_blk(j_blk) = lat_MPAS(i) + (j_blk-2)*dlta_lat + end do + + ! Find starting and ending fine-grid i,j indices for each + ! of the 9 "coarse-grid" blocks + ! Note: Index value of -999 is returned if latitude of grid points + ! exceed 90 degrees north or south + do i_blk = 1,3 + s_ii(i_blk) = nearest_i_east(lon_blk(i_blk)-p5*dlta_lon) + e_ii(i_blk) = nearest_i_west(lon_blk(i_blk)+p5*dlta_lon) + end do + do j_blk = 1,3 + s_jj(j_blk) = nearest_j_north(lat_blk(j_blk)-p5*dlta_lat) + e_jj(j_blk) = nearest_j_south(lat_blk(j_blk)+p5*dlta_lat) + end do + + + ! Calculate mean topographic height in each "coarse grid" block + ! Note: We only do the mean-height calculation if we are detrending + ! the subgrid topography, otherwise, we still need the + ! fine-grid indices for the block limits -- s_ii, etc. + do i_blk = 1,3 + + ! "Shave" blocks on north or south due to proximity to poles + ! if necessary + j_blk = 1 ! southern row + ! Check for "shaved" block due to proximity to south pole + if ( (s_jj(j_blk).eq.-999).and.(e_jj(j_blk).ne.-999) ) then + s_jj(j_blk) = 1 ! southern boundary of shaved block + ! Reassign latitude of block center + lat_blk(j_blk) = p5*(lat1d_fine(1)+lat1d_fine(e_jj(j_blk))) + end if + + j_blk = 2 ! center row + ! Check for "shaved" block due to proximity to south or north pole + ! Note: We're assuming e_jj(2) and s_jj(2) can't both be -999 + if ( s_jj(j_blk).eq.-999 ) then + s_jj(j_blk) = 1 ! block shaved on the south + ! Reassign latitude of block center + lat_blk(j_blk) = p5*(lat1d_fine(1)+lat1d_fine(e_jj(j_blk))) + end if + if ( e_jj(j_blk).eq.-999 ) then + e_jj(j_blk) = topo_y ! block shaved on the north + ! Reassign latitude of block center + lat_blk(j_blk) = p5*(lat1d_fine(s_jj(j_blk))+lat1d_fine(topo_y)) + end if + + j_blk = 3 ! northern row + ! Check for "shaved" block due to proximity to north pole + if ( (e_jj(j_blk).eq.-999).and.(s_jj(j_blk).ne.-999) ) then + e_jj(j_blk) = topo_y ! northern boundary of shaved block + ! Reassign latitude of block center + lat_blk(j_blk) = p5*(lat1d_fine(s_jj(j_blk))+lat1d_fine(topo_y)) + end if + + if ( detrend_topography ) then + do j_blk = 1,3 + call calc_mean_HGT(s_ii(i_blk),e_ii(i_blk), & + s_jj(j_blk),e_jj(j_blk),HGT_M_coarse(i_blk,j_blk)) + ! Note: If there is no block because s_jj and e_jj are + ! both -999 HGT_M_coarse returns with a "missing" + ! value of HGT_missing = 1.E+10 + end do + end if + + end do + + + ! Calculate number of fine-grid points within center coarse block (2,2) + ! Check if center block straddles date line + if ( s_ii(2).gt.e_ii(2) ) then + ii_m = topo_x - s_ii(2) + 1 + e_ii(2) + else + ii_m = e_ii(2) - s_ii(2) + 1 + end if + jj_m = e_jj(2) - s_jj(2) + 1 + + + ! Bilinearly interpolate coarse-grid topography of the 9 blocks to + ! fine grid for the purpose of detrending the fine-grid topography + ! to represent the sub-grid topography + ! Note: The detrending only occurs within the center coarse block (2,2) + if ( detrend_topography ) then + + ! i,j indices of HGT_M_coarse_on_fine range from 1,ii_m and 1,jj_m + ! i.e., a "local" index system + allocate (HGT_M_coarse_on_fine(ii_m,jj_m)) + + do jj = s_jj(2), e_jj(2) + jj_loc = jj - s_jj(2) + 1 ! local j-index (1 ... jj_m) + ! Check if block straddles the date line + if ( s_ii(2).gt.e_ii(2) ) then + do ii = s_ii(2), topo_x ! west of the date line + ii_loc = ii - s_ii(2) + 1 ! local i-index ( 1 ... ii_m) + call HGT_interpolate(lat1d_fine(jj),lon1d_fine(ii), & + lat_blk(:),lon_blk(:),HGT_M_coarse(:,:), & + HGT_M_coarse_on_fine(ii_loc,jj_loc)) + end do + do ii = 1, e_ii(2) ! east of the date line + ii_loc = ii_loc + 1 ! local i-index ( 1 ... ii_m ) + call HGT_interpolate(lat1d_fine(jj),lon1d_fine(ii), & + lat_blk(:),lon_blk(:),HGT_M_coarse(:,:), & + HGT_M_coarse_on_fine(ii_loc,jj_loc)) + end do + else ! no crossing of the date line + do ii = s_ii(2), e_ii(2) + ii_loc = ii - s_ii(2) + 1 ! local i-index ( 1 ... ii_m) + call HGT_interpolate(lat1d_fine(jj),lon1d_fine(ii), & + lat_blk(:),lon_blk(:),HGT_M_coarse(:,:), & + HGT_M_coarse_on_fine(ii_loc,jj_loc)) + end do + end if + end do + + end if + + + ! Assign values to "zs", which is the fine-grid surface topography field + ! that we will calculate statistics on, i.e, stddev, convexity, etc. + ! This will either be the detrended values (detrend_topography = .true.) + ! or the actual values (detrend_topography = .false.) + allocate (zs(ii_m,jj_m)) + + + do jj = s_jj(2), e_jj(2) + jj_loc = jj - s_jj(2) + 1 ! local j-index (1 ... jj_m) + ! Check if block straddles the date line + if ( s_ii(2).gt.e_ii(2) ) then + do ii = s_ii(2), topo_x ! west of the date line + ii_loc = ii - s_ii(2) + 1 ! local i-index ( 1 ... ii_m) + if ( detrend_topography ) then + zs(ii_loc,jj_loc) = HGT_M_fine(ii,jj) - & + HGT_M_coarse_on_fine(ii_loc,jj_loc) + else + zs(ii_loc,jj_loc) = HGT_M_fine(ii,jj) + end if + end do + do ii = 1, e_ii(2) ! east of the date line + ii_loc = ii_loc + 1 ! local i-index ( 1 ... ii_m ) + if ( detrend_topography ) then + zs(ii_loc,jj_loc) = HGT_M_fine(ii,jj) - & + HGT_M_coarse_on_fine(ii_loc,jj_loc) + else + zs(ii_loc,jj_loc) = HGT_M_fine(ii,jj) + end if + end do + else ! no crossing of the date line + do ii = s_ii(2), e_ii(2) + ii_loc = ii - s_ii(2) + 1 ! local i-index ( 1 ... ii_m) + if ( detrend_topography ) then + zs(ii_loc,jj_loc) = HGT_M_fine(ii,jj) - & + HGT_M_coarse_on_fine(ii_loc,jj_loc) + else + zs(ii_loc,jj_loc) = HGT_M_fine(ii,jj) + end if + end do + end if + end do + + + + ! + ! Finally, we can now calculate the topographic statistics fields needed + ! for the gravity wave drag scheme + ! + + ! Make sure statistics are zero if there is no terrain in the grid cell + zs_accum = .false. + do jj = 1,jj_m + do ii = 1,ii_m + if ( abs(zs(ii,jj)).gt.1.E-3 ) zs_accum = .true. + end do + end do + if ( .not.zs_accum ) then ! no terrain in the grid cell + std_dev(i) = 0._RKIND + convexity(i) = 0._RKIND + OA1(i) = 0._RKIND + OA2(i) = 0._RKIND + OA3(i) = 0._RKIND + OA4(i) = 0._RKIND + OL1(i) = 0._RKIND + OL2(i) = 0._RKIND + OL3(i) = 0._RKIND + OL4(i) = 0._RKIND + if ( detrend_topography ) deallocate (HGT_M_coarse_on_fine) + deallocate(zs) + cycle ! move on to next (coarse) grid cell + end if + + + ! + ! Calculate standard deviation of subgrid-scale terrain height + ! + + ! Calculate mean height + sum2 = 0._RKIND + nfinepoints = ii_m*jj_m + do jj = 1,jj_m + do ii = 1,ii_m + sum2 = sum2 + zs(ii,jj) + end do + end do + zs_mean = sum2 / real(nfinepoints,RKIND) + + ! Calculate standard deviation + sum2 = 0._RKIND + do jj = 1,jj_m + do ii = 1,ii_m + sum2 = sum2 + ( zs(ii,jj) - zs_mean )**2 + end do + end do + std_dev(i) = sqrt( sum2/real(nfinepoints,RKIND) ) + + + ! + ! Calculate convexity of sub-grid-scale terrain + ! + + sum2 = 0._RKIND + sum4 = 0._RKIND + do jj = 1,jj_m + do ii = 1,ii_m + sum2 = sum2 + ( zs(ii,jj) - zs_mean )**2 + sum4 = sum4 + ( zs(ii,jj) - zs_mean )**4 + end do + end do + + var = sum2 / real(nfinepoints,RKIND) + if ( abs(var) < 1.0E-05_RKIND ) then + convexity(i) = 0._RKIND + else + convexity(i) = min( sum4 / ( var**2 * & + real(nfinepoints,RKIND) ), max_convexity ) + end if + + + ! + ! Calculate orographic asymmetries + ! + + ! OA1 -- orographic asymmetry in West direction + nu = 0 + nd = 0 + do jj = 1,jj_m + if(mod(ii_m,2).eq.0.) then + do ii = 1,ii_m/2 ! left half of box + if ( zs(ii,jj) > zs_mean ) nu = nu + 1 + end do + else + do ii = 1,ii_m/2+1 ! left half of box + if ( zs(ii,jj) > zs_mean ) nu = nu + 1 + end do + endif + do ii = ii_m/2 + 1, ii_m ! right half of box + if ( zs(ii,jj) > zs_mean ) nd = nd + 1 + end do + end do + if ( nu + nd > 0 ) then + OA1(i) = real((nu - nd),RKIND) / & + real((nu + nd),RKIND) + else + OA1(i) = 0._RKIND + end if + + ! OA2 -- orographic asymmetry in South direction + nu = 0 + nd = 0 + if(mod(jj_m,2).eq.0.) then + do jj = 1,jj_m/2 ! bottom half of box + do ii = 1,ii_m + if ( zs(ii,jj) > zs_mean ) nu = nu + 1 + end do + end do + else + do jj = 1,jj_m/2+1 ! bottom half of box + do ii = 1,ii_m + if ( zs(ii,jj) > zs_mean ) nu = nu + 1 + end do + end do + endif + do jj = jj_m/2 + 1,jj_m ! top half of box + do ii = 1, ii_m + if ( zs(ii,jj) > zs_mean ) nd = nd + 1 + end do + end do + if ( nu + nd > 0 ) then + OA2(i) = real((nu - nd),RKIND) / & + real((nu + nd),RKIND) + else + OA2(i) = 0._RKIND + end if + + ! OA3 -- orographic asymmetry in South-West direction + nu = 0 + nd = 0 + ratio = real(jj_m,RKIND)/real(ii_m,RKIND) + do jj = 1,jj_m + do ii = 1,ii_m + if ( nint(real(ii,RKIND)*ratio) <= (jj_m - jj + 1) ) then + ! south-west half of box + if ( zs(ii,jj) > zs_mean ) nu = nu + 1 + endif + if ( nint(real(ii,RKIND)*ratio) >= (jj_m - jj + 1) ) then + ! north-east half of box + if ( zs(ii,jj) > zs_mean ) nd = nd + 1 + end if + end do + end do + if ( nu + nd > 0 ) then + OA3(i) = real((nu - nd),RKIND) / & + real((nu + nd),RKIND) + else + OA3(i) = 0._RKIND + end if + + ! OA4 -- orographic asymmetry in North-West direction + nu = 0 + nd = 0 + ratio = real(jj_m,RKIND)/real(ii_m,RKIND) + do jj = 1,jj_m + do ii = 1,ii_m + if ( nint(real(ii,RKIND)*ratio) <= jj ) then + ! north-west half of box + if ( zs(ii,jj) > zs_mean ) nu = nu + 1 + end if + if ( nint(real(ii,RKIND)*ratio) >= jj ) then + ! south-east half of box + if ( zs(ii,jj) > zs_mean ) nd = nd + 1 + end if + end do + end do + if ( nu + nd > 0 ) then + OA4(i) = real((nu - nd),RKIND) / & + real((nu + nd),RKIND) + else + OA4(i) = 0._RKIND + end if + + + ! + ! Calculate orographic effective lengths + ! + + ! OL1 -- orographic effective length for Westerly flow + nw = 0 + nt = 0 + do jj = max(jj_m/4,1), 3*jj_m/4 + ! within central east-west band of box + do ii = 1, ii_m + if ( zs(ii,jj) > zs_mean ) nw = nw + 1 + nt = nt + 1 + end do + end do + if ( nt /= 0 ) then + OL1(i) = real(nw,RKIND) / real(nt,RKIND) + else + OL1(i) = 0._RKIND + end if + + ! OL2 -- orographic effective length for Southerly flow + nw = 0 + nt = 0 + do jj = 1, jj_m + do ii = max(ii_m/4,1), 3*ii_m/4 + ! within central north-south band of box + if ( zs(ii,jj) > zs_mean ) nw = nw + 1 + nt = nt + 1 + end do + end do + if ( nt /= 0 ) then + OL2(i) = real(nw,RKIND) / real(nt,RKIND) + else + OL2(i) = 0._RKIND + end if + + ! OL3 -- orographic effective length for South-Westerly flow + nw = 0 + nt = 0 + do jj = 1, jj_m/2 + do ii = 1, ii_m/2 + if ( zs(ii,jj) > zs_mean ) nw = nw + 1 + nt = nt + 1 + end do + end do + do jj = jj_m/2+1, jj_m + do ii = ii_m/2+1, ii_m + if ( zs(ii,jj) > zs_mean ) nw = nw + 1 + nt = nt + 1 + end do + end do + if ( nt /= 0 ) then + OL3(i) = real(nw,RKIND) / real(nt,RKIND) + else + OL3(i) = 0._RKIND + end if + + ! OL4 -- orographic effective length for North-Westerly flow + nw = 0 + nt = 0 + do jj = jj_m/2+1, jj_m + do ii = 1, ii_m/2 + if ( zs(ii,jj) > zs_mean ) nw = nw + 1 + nt = nt + 1 + end do + end do + do jj = 1, jj_m/2 + do ii = ii_m/2+1, ii_m + if ( zs(ii,jj) > zs_mean ) nw = nw + 1 + nt = nt + 1 + end do + end do + if ( nt /= 0 ) then + OL4(i) = real(nw,RKIND) / real(nt,RKIND) + else + OL4(i) = 0._RKIND + end if + + + if ( detrend_topography ) deallocate (HGT_M_coarse_on_fine) + deallocate (zs) + +end do ! i = 1,nCells + + +! +! Output GWD statistics fields to netCDF file +! + + + + + +! Deallocate arrays +deallocate(lat1d_fine) +deallocate(lon1d_fine) +deallocate(lon_MPAS) +deallocate(HGT_M_fine) + + +end subroutine calc_gsl_oro_data_lg_scale + + + +!> Calculates average terrain height within coarse grid cell ("block") +!! +!! @param[in] s_ii Fine grid starting i-index +!! @param[in] e_ii Fine grid ending i-index +!! @param[in] s_jj Fine grid starting j-index +!! @param[in] e_jj Fine grid ending j-index +!! @param[out] hgt Fine grid height (m) +!! @author Michael Toy, NOAA/GSL +subroutine calc_mean_HGT(s_ii,e_ii,s_jj,e_jj,HGT) + +! This subroutine calculates the average terrain height within +! coarse grid cell ("block") + +implicit none + +integer :: s_ii, & ! starting fine-grid i-index + e_ii, & ! ending fine-grid i-index + s_jj, & ! starting fine-grid j-index + e_jj ! ending fine-grid j-index +real (kind=RKIND), intent(out) :: HGT + +! Local variables +integer :: i,j,grid_pt_count +real (kind=RKIND) :: HGT_sum + + +! Return a value of 0 if s_jj and e_jj are both -999, +! i.e., if there is no block adjoining the center row +! due to proximity to one of the poles +! Note: The HGT value of the block will be ignored +if ( (s_jj.eq.-999).and.(e_jj.eq.-999) ) then + HGT = HGT_missing + return +end if + +grid_pt_count = 0 +HGT_sum = 0._RKIND +do j = s_jj, e_jj + ! Note: If the grid block straddles the date line, then s_ii > e_ii + ! We need to correct for this + if ( s_ii.gt.e_ii ) then ! straddling the date line + do i = s_ii, topo_x ! west of the date line + HGT_sum = HGT_sum + HGT_M_fine(i,j) + grid_pt_count = grid_pt_count + 1 + end do + do i = 1, e_ii ! east of the date line + HGT_sum = HGT_sum + HGT_M_fine(i,j) + grid_pt_count = grid_pt_count + 1 + end do + else ! no crossing of the date line + do i = s_ii, e_ii + HGT_sum = HGT_sum + HGT_M_fine(i,j) + grid_pt_count = grid_pt_count + 1 + end do + end if +end do +HGT = HGT_sum/grid_pt_count + +end subroutine calc_mean_HGT + +!> Interpolates height from coarse grid on to fine grid points +!! +!! @param[in] lat Latitude of fine grid point. +!! @param[in] lon_in Longitude of fine grid point. +!! @param[in] lat_blk Latitudes of neighboring coarse grid points. +!! @param[in] lon_blk Longitudes of neighboring coarse grid points. +!! @param[in] hgt_coarse Topographic heights on coarse grid +!! @param[out] hgt_coarse_on_fine Coarse grid heights interpolated on to fine grid +!! @author Michael Toy, NOAA/GSL +subroutine HGT_interpolate(lat,lon_in,lat_blk,lon_blk,HGT_coarse, & + HGT_coarse_on_fine) + +! This subroutine bilinearly interpolates neighboring coarse-grid terrain +! heights (HGT_coarse) to fine-grid points (HGT_coarse_on_fine) +! (extrapolates in the case near poles) +! Note: Bilinear interpolation is done by calling a 1D interpolation +! function of a 1D interpolation function + +implicit none + +real (kind = RKIND), intent(in) :: & + lat, & ! latitude of fine grid point + lon_in ! longitude of fine grid point +real (kind = RKIND), dimension(3),intent(in) :: & + lat_blk, & ! latitudes of neighboring coarse grid points + lon_blk ! longitudes of neighboring coarse grid points +real (kind = RKIND), dimension(3,3), intent(in) :: HGT_coarse +real (kind = RKIND), intent(out) :: HGT_coarse_on_fine +real (kind = RKIND) :: lon + + +lon = lon_in +! We need to make sure that if we're straddling the date line, that +! we remove the possible 2*pi discontinuity between lon and +! {lon_blk(1),lon_blk(2),lon_blk(3)) for interpolation purposes +! This will line the 4 longitudes up monotonically +if ( abs(lon_in-lon_blk(2)).gt.pi ) then ! discontinuity exists + if ( lon_in.gt.0. ) lon = lon - 2*pi ! lon_in lies west of date line + if ( lon_in.lt.0. ) lon = lon + 2*pi ! lon_in lies east of date line +end if + + +! Check for need to extrapolate if top or bottom block rows +! have height = HGT_missing + +! Check for missing north row +if ( (HGT_coarse(1,3).eq.HGT_missing).or.(HGT_coarse(2,3).eq.HGT_missing) & + .or.(HGT_coarse(3,3).eq.HGT_missing) ) then + + ! Determine which quadrant of the coarse grid cell we are in + if ( (lat.ge.lat_blk(2)).and.(lon.ge.lon_blk(2)) ) then ! Quadrant I + ! Extrapolate from lat_blk(1) and lat_blk(2) + HGT_coarse_on_fine = interp_1d( & + lon,lon_blk(2),lon_blk(3), & + interp_1d(lat,lat_blk(1),lat_blk(2),HGT_coarse(2,1),HGT_coarse(2,2)), & + interp_1d(lat,lat_blk(1),lat_blk(2),HGT_coarse(3,1),HGT_coarse(3,2)) ) + elseif ( (lat.ge.lat_blk(2)).and.(lon.lt.lon_blk(2)) ) then ! Quadrant II + ! Extrapolate from lat_blk(1) and lat_blk(2) + HGT_coarse_on_fine = interp_1d( & + lon,lon_blk(1),lon_blk(2), & + interp_1d(lat,lat_blk(1),lat_blk(2),HGT_coarse(1,1),HGT_coarse(1,2)), & + interp_1d(lat,lat_blk(1),lat_blk(2),HGT_coarse(2,1),HGT_coarse(2,2)) ) + elseif ( (lat.lt.lat_blk(2)).and.(lon.lt.lon_blk(2)) ) then ! Quadrant III + HGT_coarse_on_fine = interp_1d( & + lon,lon_blk(1),lon_blk(2), & + interp_1d(lat,lat_blk(1),lat_blk(2),HGT_coarse(1,1),HGT_coarse(1,2)), & + interp_1d(lat,lat_blk(1),lat_blk(2),HGT_coarse(2,1),HGT_coarse(2,2)) ) + elseif ( (lat.lt.lat_blk(2)).and.(lon.ge.lon_blk(2)) ) then ! Quadrant IV + HGT_coarse_on_fine = interp_1d( & + lon,lon_blk(2),lon_blk(3), & + interp_1d(lat,lat_blk(1),lat_blk(2),HGT_coarse(2,1),HGT_coarse(2,2)), & + interp_1d(lat,lat_blk(1),lat_blk(2),HGT_coarse(3,1),HGT_coarse(3,2)) ) + end if + + return +end if + +! Check for missing south row +if ( (HGT_coarse(1,1).eq.HGT_missing).or.(HGT_coarse(2,1).eq.HGT_missing) & + .or.(HGT_coarse(3,1).eq.HGT_missing) ) then + + ! Determine which quadrant of the coarse grid cell we are in + if ( (lat.ge.lat_blk(2)).and.(lon.ge.lon_blk(2)) ) then ! Quadrant I + HGT_coarse_on_fine = interp_1d( & + lon,lon_blk(2),lon_blk(3), & + interp_1d(lat,lat_blk(2),lat_blk(3),HGT_coarse(2,2),HGT_coarse(2,3)), & + interp_1d(lat,lat_blk(2),lat_blk(3),HGT_coarse(3,2),HGT_coarse(3,3)) ) + elseif ( (lat.ge.lat_blk(2)).and.(lon.lt.lon_blk(2)) ) then ! Quadrant II + HGT_coarse_on_fine = interp_1d( & + lon,lon_blk(1),lon_blk(2), & + interp_1d(lat,lat_blk(2),lat_blk(3),HGT_coarse(1,2),HGT_coarse(1,3)), & + interp_1d(lat,lat_blk(2),lat_blk(3),HGT_coarse(2,2),HGT_coarse(2,3)) ) + elseif ( (lat.lt.lat_blk(2)).and.(lon.lt.lon_blk(2)) ) then ! Quadrant III + ! Extrapolate from lat_blk(2) and lat_blk(3) + HGT_coarse_on_fine = interp_1d( & + lon,lon_blk(1),lon_blk(2), & + interp_1d(lat,lat_blk(2),lat_blk(3),HGT_coarse(1,2),HGT_coarse(1,3)), & + interp_1d(lat,lat_blk(2),lat_blk(3),HGT_coarse(2,2),HGT_coarse(2,3)) ) + elseif ( (lat.lt.lat_blk(2)).and.(lon.ge.lon_blk(2)) ) then ! Quadrant IV + ! Extrapolate from lat_blk(2) and lat_blk(3) + HGT_coarse_on_fine = interp_1d( & + lon,lon_blk(2),lon_blk(3), & + interp_1d(lat,lat_blk(2),lat_blk(3),HGT_coarse(2,2),HGT_coarse(2,3)), & + interp_1d(lat,lat_blk(2),lat_blk(3),HGT_coarse(3,2),HGT_coarse(3,3)) ) + end if + + return +end if + +! Interpolation only +! Determine which quadrant of the coarse grid cell we are in +if ( (lat.ge.lat_blk(2)).and.(lon.ge.lon_blk(2)) ) then ! Quadrant I + HGT_coarse_on_fine = interp_1d( & + lon,lon_blk(2),lon_blk(3), & + interp_1d(lat,lat_blk(2),lat_blk(3),HGT_coarse(2,2),HGT_coarse(2,3)), & + interp_1d(lat,lat_blk(2),lat_blk(3),HGT_coarse(3,2),HGT_coarse(3,3)) ) +elseif ( (lat.ge.lat_blk(2)).and.(lon.lt.lon_blk(2)) ) then ! Quadrant II + HGT_coarse_on_fine = interp_1d( & + lon,lon_blk(1),lon_blk(2), & + interp_1d(lat,lat_blk(2),lat_blk(3),HGT_coarse(1,2),HGT_coarse(1,3)), & + interp_1d(lat,lat_blk(2),lat_blk(3),HGT_coarse(2,2),HGT_coarse(2,3)) ) +elseif ( (lat.lt.lat_blk(2)).and.(lon.lt.lon_blk(2)) ) then ! Quadrant III + HGT_coarse_on_fine = interp_1d( & + lon,lon_blk(1),lon_blk(2), & + interp_1d(lat,lat_blk(1),lat_blk(2),HGT_coarse(1,1),HGT_coarse(1,2)), & + interp_1d(lat,lat_blk(1),lat_blk(2),HGT_coarse(2,1),HGT_coarse(2,2)) ) +elseif ( (lat.lt.lat_blk(2)).and.(lon.ge.lon_blk(2)) ) then ! Quadrant IV + HGT_coarse_on_fine = interp_1d( & + lon,lon_blk(2),lon_blk(3), & + interp_1d(lat,lat_blk(1),lat_blk(2),HGT_coarse(2,1),HGT_coarse(2,2)), & + interp_1d(lat,lat_blk(1),lat_blk(2),HGT_coarse(3,1),HGT_coarse(3,2)) ) +end if + +end subroutine HGT_interpolate + +!> Finds nearest fine-grid i index to the east of a given longitude +!! +!! @param[in] lon_in longitude (radians) +!! @return nearest_i_east Nearest grid point i-index east of selected point +!! @author Michael Toy, NOAA/GSL +function nearest_i_east(lon_in) +! Calculates nearest fine-grid i index to the east of (or on) a given longitude +implicit none + +integer :: nearest_i_east +real (kind=RKIND), intent(in) :: lon_in +real (kind=RKIND) :: lon +integer :: i + +lon = lon_in +! Make sure longitude is between -pi and pi +do while ( (lon.lt.(-pi)).or.(lon.gt.pi) ) + if ( lon.lt.(-pi) ) lon = lon + 2*pi + if ( lon.gt.pi ) lon = lon - 2*pi +end do + +if ( lon.gt.lon1d_fine(topo_x) ) then + nearest_i_east = 1 +else + i = 1 + do while ( lon1d_fine(i).lt.lon ) + i = i + 1 + end do + nearest_i_east = i +end if + +end function nearest_i_east + +!> Finds nearest fine-grid i index to the west of a given longitude +!! +!! @param[in] lon_in longitude (radians) +!! @return nearest_i_west Nearest grid point i-index west of selected point +!! @author Michael Toy, NOAA/GSL +function nearest_i_west(lon_in) +! Calculates nearest fine-grid i index to the west of a given longitude +implicit none + +integer :: nearest_i_west +real (kind=RKIND), intent(in) :: lon_in +real (kind=RKIND) :: lon +integer :: i + +lon = lon_in +! Make sure longitude is between -pi and pi +do while ( (lon.lt.(-pi)).or.(lon.gt.pi) ) + if ( lon.lt.(-pi) ) lon = lon + 2*pi + if ( lon.gt.pi ) lon = lon - 2*pi +end do + +if ( (lon.lt.lon1d_fine(1)).or.(lon.ge.lon1d_fine(topo_x)) ) then + nearest_i_west = topo_x +else + i = 1 + do while ( lon1d_fine(i).le.lon ) + i = i + 1 + end do + nearest_i_west = i - 1 +end if + +end function nearest_i_west + +!> Calculates nearest fine-grid j index to the north of a given latitude +!! +!! @param[in] lat_in Latitude (radians) +!! @return nearest_j_north Nearest fine-grid j index to the north of a given latitude +!! @author Michael Toy, NOAA/GSL +function nearest_j_north(lat_in) +! Calculates nearest fine-grid j index to the north of a given latitude +! Note: If the abs(latitude) is greater than pi/2 (90 degrees) then +! the value -999 is returned +implicit none + +integer :: nearest_j_north +real (kind=RKIND), intent(in) :: lat_in +real (kind=RKIND) :: lat +integer :: j + +lat = lat_in +if ( abs(lat_in).gt.p5*pi ) then + nearest_j_north = -999 +else + j = 1 + do while ( (lat1d_fine(j).lt.lat).and.(j.lt.topo_y) ) + j = j + 1 + end do + nearest_j_north = j +end if + +end function nearest_j_north + +!> Calculates nearest fine-grid j index to the south of a given latitude +!! +!! @param[in] lat_in Latitude (radians) +!! @return nearest_j_south Nearest fine-grid j index to the south of a given latitude +!! @author Michael Toy, NOAA/GSL +function nearest_j_south(lat_in) +! Calculates nearest fine-grid j index to the south of a given latitude +! Note: If the abs(latitude) is greater than pi/2 (90 degrees) then +! the value -999 is returned +implicit none + +integer :: nearest_j_south +real (kind=RKIND), intent(in) :: lat_in +real (kind=RKIND) :: lat +integer :: j + +lat = lat_in +if ( abs(lat_in).gt.p5*pi ) then + nearest_j_south = -999 +elseif ( lat_in.le.lat1d_fine(1) ) then + nearest_j_south = 1 +else + j = 2 + do while ( (lat1d_fine(j).le.lat).and.(j.lt.topo_y) ) + j = j + 1 + end do + nearest_j_south = j - 1 +end if + +end function nearest_j_south + +!> Interpolates (or extrapolates) linear function y = y(x) +!! +!! @param[in] x Input "x" value +!! @param[in] x1 Known point 1 +!! @param[in] x2 Known point 2 +!! @param[in] y1 Known y(x1) +!! @param[in] y2 Known y(x2) +!! @return interp_1d Interpolated y value at x +!! @author Michael Toy, NOAA/GSL +function interp_1d(x,x1,x2,y1,y2) +! Interpolates (or extrapolates) linear function y = y(x) +! to x given y1 = y(x1) and y2 = y(x2) +implicit none + +real (kind=RKIND) :: interp_1d +real (kind=RKIND), intent(in) :: x,x1,x2,y1,y2 +real (kind=RKIND) :: slope + +! Formula for a line: y = y1 + slope*(x - x1) +slope = (y2-y1)/(x2-x1) +interp_1d = y1 + slope*(x-x1) + +end function interp_1d + + +end module mpas_gsl_oro_data_lg_scale diff --git a/src/core_init_atmosphere/mpas_gsl_oro_data_sm_scale.F b/src/core_init_atmosphere/mpas_gsl_oro_data_sm_scale.F new file mode 100644 index 000000000..de5802ec9 --- /dev/null +++ b/src/core_init_atmosphere/mpas_gsl_oro_data_sm_scale.F @@ -0,0 +1,754 @@ +! This module calculates the parameters required for the subgrid- +! scale orographic gravity-wave drag (GWDO) scheme on the MPAS +! mesh. These parameters are for the small-scale GWD (Tsiringakis et al., +! 2017) and the turbulent orographic form drag (TOFD) (Beljaars, 2004) +! schemes of the GSL drag suite. 30 second (~1km) global topography +! is used. The topographic data comes from the 'fix' file +! HGT.Beljaars_filtered.lat-lon.30s_res.nc. +! The output fields are: +! - stddev standard deviation of subgrid-scale topograpy +! - convexity convexity (kurtosis) of subgrid-scale topography +! - ol{1,2,3,4} orographic effective lengths of subgrid-scale topography +! for 4 orientations: 1-westerly, 2-southerly, 3-southwesterly, 4-northwesterly +! - oa{1,2,3,4} orographic asymmetries of subgrid-scale topography +! for 4 orientations: 1-westerly, 2-southerly, 3-southwesterly, 4-northwesterly +! +! Based on code by Michael Duda provided by NCAR/MMM +! +module mpas_gsl_oro_data_sm_scale + +use iso_c_binding, only : c_char, c_int, c_float, c_ptr, c_loc + +use mpas_derived_types +use mpas_framework +use mpas_kind_types +use mpas_log, only : mpas_log_write +use mpas_stream_manager +use mpas_c_interfacing, only : mpas_f_to_c_string + +implicit none + +public :: calc_gsl_oro_data_sm_scale + +private + + interface + subroutine read_geogrid(fname, rarray, nx, ny, nz, isigned, endian, & + 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 + integer (c_int), intent(in), value :: wordsize + integer (c_int), intent(inout) :: status + end subroutine read_geogrid + end interface + +real (kind=RKIND), parameter :: Pi = 2.0_RKIND * asin(1.0_RKIND) + +integer, parameter :: topo_x = 43200 ! x-dimension of fine grid (30-arc-second topog array) +integer, parameter :: topo_y = 21600 ! y-dimension of fine grid (30-arc-second topog array) + +real (kind=RKIND), allocatable :: lat1d_fine(:) !< latitude of fine grid pts (radians) +real (kind=RKIND), allocatable :: lon1d_fine(:) !< longitude of fine grid pts (radians) + +real (kind=RKIND), allocatable :: lon_MPAS(:) ! "adjusted" longitude + +real (kind=RKIND), parameter :: p5 = 0.5_RKIND !< one half + + +contains + +subroutine calc_gsl_oro_data_sm_scale(nCells,lat_MPAS,lon_MPAS_raw,area_MPAS, & + Re,std_dev,convexity,OA1,OA2,OA3,OA4, & + OL1,OL2,OL3,OL4,domain,duplicate_oro_data) + +implicit none + +type (domain_type), intent(inout) :: domain + +integer, intent(in) :: nCells +real (kind=RKIND), dimension(:), intent(in) :: lat_MPAS, lon_MPAS_raw ! radians +real (kind=RKIND), dimension(:), intent(in) :: area_MPAS ! approx area of MPAS grid cell (m^2) +real (kind=RKIND), intent(in) :: Re +real (kind=RKIND), dimension(:), intent(out) :: std_dev,convexity,OA1,OA2,OA3,OA4, & + OL1,OL2,OL3,OL4 +logical, dimension(:), intent(out) :: duplicate_oro_data ! flag for 'small' grid cell size + +integer (c_int) :: istatus +integer :: ix, iy +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 + + +real (kind=RKIND) :: DX ! grid size in km + +integer :: i,j,ii,jj +integer :: iErr + +integer, parameter :: tile_x = 8640 ! x-dimension of each tile of global 30-arc-second topography +integer, parameter :: tile_y = 4320 ! y-dimension of each tile of global 30-arc-second topography +integer, parameter :: tile_bdr = 0 ! number of layers of border/halo points surrounding each tile + +integer :: nfinepoints ! number of fine grid points in each coarse grid cell + +real (kind=RKIND) :: sum2, sum4, var + + +real (kind=RKIND), allocatable :: zs(:,:) + +logical :: zs_accum + +real (kind=RKIND) :: zs_mean + +real (kind=RKIND), parameter :: max_convexity = 10._RKIND ! max value for convexity + +integer :: nu, nd, nw, nt +real (kind=RKIND) :: ratio + + +real (kind=R4KIND), allocatable :: HGT_M_fine(:,:) +real (kind=RKIND) :: dlta_lat, dlta_lon + +character(len=StrKIND), pointer :: config_geog_data_path +character(len=StrKIND) :: geog_sub_path +character(len=StrKIND+1) :: geog_data_path ! same as config_geog_data_path, but guaranteed to have a trailing slash + +integer :: i_blk, j_blk +integer :: ii_loc, jj_loc, ii_m, jj_m +integer, dimension(3) :: s_ii, e_ii, s_jj, e_jj +real (kind=RKIND), dimension(3) :: lat_blk, lon_blk + + + +call mpas_log_write('Creating oro_data_ss fields') + +call mpas_pool_get_config(domain % 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 +geog_sub_path = 'topo_ugwp_30s/' + +! +! Retrieve 30s topo data from WPS_GEOG +! +isigned = 1 +endian = 0 +wordsize = 4 +scalefactor = 0.1 +nx = tile_x + 2*tile_bdr +ny = tile_y + 2*tile_bdr +nz = 1 + +allocate(HGT_M_fine(topo_x,topo_y)) +allocate(tile(tile_x+2*tile_bdr,tile_y+2*tile_bdr,1)) +tile_ptr = c_loc(tile) + +do iy=1,topo_y,tile_y +do ix=1,topo_x,tile_x + write(filename,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(geog_data_path)//trim(geog_sub_path), & + ix, '-', (ix+tile_x-1), '.', iy, '-', (iy+tile_y-1) + call mpas_f_to_c_string(filename, c_filename) + call read_geogrid(c_filename, tile_ptr, nx, ny, nz, isigned, endian, & + wordsize, istatus) + tile(:,:,:) = tile(:,:,:) * scalefactor + if (istatus /= 0) then + call mpas_log_write('Error reading topography tile '//trim(filename), messageType=MPAS_LOG_ERR) + iErr = 1 + return + end if + HGT_M_fine(ix:(ix+tile_x-1),iy:(iy+tile_y-1)) = tile((tile_bdr+1):(tile_x+tile_bdr),(tile_bdr+1):(tile_y+tile_bdr),1) +end do +end do + +deallocate(tile) + + +! Calculate fine grid lat/lon in radians +allocate (lat1d_fine(topo_y)) +allocate (lon1d_fine(topo_x)) +do j = 1,topo_y + lat1d_fine(j) = ( -90._RKIND + (180._RKIND/topo_y)*(j-p5) )*Pi/180._RKIND +end do +do i = 1,topo_x + lon1d_fine(i) = (-180._RKIND + (360._RKIND/topo_x)*(i-p5) )*Pi/180._RKIND +end do + + +! Reassign MPAS longitude to vary from -Pi to Pi to match lon1d_fine range +! Transfer data from lon_MPAS_raw to lon_MPAS +allocate (lon_MPAS(nCells)) +do i = 1,nCells + if ( lon_MPAS_raw(i).gt.Pi ) then + lon_MPAS(i) = lon_MPAS_raw(i) - 2*Pi + else + lon_MPAS(i) = lon_MPAS_raw(i) + end if +end do + +! Initialize GWD statistics fields +std_dev(:) = 0._RKIND +convexity(:) = 0._RKIND +OA1(:) = 0._RKIND +OA2(:) = 0._RKIND +OA3(:) = 0._RKIND +OA4(:) = 0._RKIND +OL1(:) = 0._RKIND +OL2(:) = 0._RKIND +OL3(:) = 0._RKIND +OL4(:) = 0._RKIND + +! Determine whether grid size is less than 7.5km -- the limit for large-scale stats. +duplicate_oro_data(:) = .false. +do i = 1,nCells + dX = sqrt(area_MPAS(i)) ! grid size in meters + if ( dX .lt. 7500._RKIND ) duplicate_oro_data(i) = .true. +end do + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! This is a loop over all the MPAS (coarse) grid cells +! The subgrid-scale topographic variables needed for the large-scale +! orographic gravity wave drag schemes are calculated by the following steps: +! 1) Sample the fine-scale (30sec) topography contained within each +! coarse grid cell. +! 2) Calculate the orographic statistics: stddev,convexity,oa1,...oa4, +! ol1,...,ol4 +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + +do i = 1,nCells + + ! Calculate approximate side-lengths of square lat-long "coarse" grid + ! cell centered on MPAS cell (units = radians) + dlta_lat = sqrt(area_MPAS(i))/Re + dlta_lon = sqrt(area_MPAS(i))/(Re*COS(lat_MPAS(i))) + + ! Determine lat/lon of 9 lat-lon block centers + ! Note: lat_blk(2)/lon_blk(2) = lat_MPAS(i)/lon_MPAS(i) + ! Note: abs(lon_blk) may exceed Pi + do i_blk = 1,3 + lon_blk(i_blk) = lon_MPAS(i) + (i_blk-2)*dlta_lon + end do + ! Note: abs(lat_blk) may exceed Pi/2 (90 degrees) + do j_blk = 1,3 + lat_blk(j_blk) = lat_MPAS(i) + (j_blk-2)*dlta_lat + end do + + ! Find starting and ending fine-grid i,j indices for each + ! of the 9 "coarse-grid" blocks + ! Note: Index value of -999 is returned if latitude of grid points + ! exceed 90 degrees north or south + do i_blk = 1,3 + s_ii(i_blk) = nearest_i_east(lon_blk(i_blk)-p5*dlta_lon) + e_ii(i_blk) = nearest_i_west(lon_blk(i_blk)+p5*dlta_lon) + end do + do j_blk = 1,3 + s_jj(j_blk) = nearest_j_north(lat_blk(j_blk)-p5*dlta_lat) + e_jj(j_blk) = nearest_j_south(lat_blk(j_blk)+p5*dlta_lat) + end do + + ! Calculate lat/lon relevant to each "coarse grid" block + do i_blk = 1,3 + + ! "Shave" blocks on north or south due to proximity to poles + ! if necessary + j_blk = 1 ! southern row + ! Check for "shaved" block due to proximity to south pole + if ( (s_jj(j_blk).eq.-999).and.(e_jj(j_blk).ne.-999) ) then + s_jj(j_blk) = 1 ! southern boundary of shaved block + ! Reassign latitude of block center + lat_blk(j_blk) = p5*(lat1d_fine(1)+lat1d_fine(e_jj(j_blk))) + end if + + j_blk = 2 ! center row + ! Check for "shaved" block due to proximity to south or north pole + ! Note: We're assuming e_jj(2) and s_jj(2) can't both be -999 + if ( s_jj(j_blk).eq.-999 ) then + s_jj(j_blk) = 1 ! block shaved on the south + ! Reassign latitude of block center + lat_blk(j_blk) = p5*(lat1d_fine(1)+lat1d_fine(e_jj(j_blk))) + end if + if ( e_jj(j_blk).eq.-999 ) then + e_jj(j_blk) = topo_y ! block shaved on the north + ! Reassign latitude of block center + lat_blk(j_blk) = p5*(lat1d_fine(s_jj(j_blk))+lat1d_fine(topo_y)) + end if + + j_blk = 3 ! northern row + ! Check for "shaved" block due to proximity to north pole + if ( (e_jj(j_blk).eq.-999).and.(s_jj(j_blk).ne.-999) ) then + e_jj(j_blk) = topo_y ! northern boundary of shaved block + ! Reassign latitude of block center + lat_blk(j_blk) = p5*(lat1d_fine(s_jj(j_blk))+lat1d_fine(topo_y)) + end if + + end do + + ! Calculate number of fine-grid points within center coarse block (2,2) + ! Check if center block straddles date line + if ( s_ii(2).gt.e_ii(2) ) then + ii_m = topo_x - s_ii(2) + 1 + e_ii(2) + else + ii_m = e_ii(2) - s_ii(2) + 1 + end if + jj_m = e_jj(2) - s_jj(2) + 1 + + + ! Assign values to "zs", which is the fine-grid surface topography field + ! that we will calculate statistics on, i.e, stddev, convexity, etc. + allocate (zs(ii_m,jj_m)) + + do jj = s_jj(2), e_jj(2) + jj_loc = jj - s_jj(2) + 1 ! local j-index (1 ... jj_m) + ! Check if block straddles the date line + if ( s_ii(2).gt.e_ii(2) ) then + do ii = s_ii(2), topo_x ! west of the date line + ii_loc = ii - s_ii(2) + 1 ! local i-index ( 1 ... ii_m) + zs(ii_loc,jj_loc) = HGT_M_fine(ii,jj) + end do + do ii = 1, e_ii(2) ! east of the date line + ii_loc = ii_loc + 1 ! local i-index ( 1 ... ii_m ) + zs(ii_loc,jj_loc) = HGT_M_fine(ii,jj) + end do + else ! no crossing of the date line + do ii = s_ii(2), e_ii(2) + ii_loc = ii - s_ii(2) + 1 ! local i-index ( 1 ... ii_m) + zs(ii_loc,jj_loc) = HGT_M_fine(ii,jj) + end do + end if + end do + + ! + ! Finally, we can now calculate the topographic statistics fields needed + ! for the gravity wave drag scheme + ! + + ! Make sure statistics are zero if there is no terrain in the grid cell + ! Note: This is a proxy for a landmask + zs_accum = .false. + do jj = 1,jj_m + do ii = 1,ii_m + if ( abs(zs(ii,jj)).gt.1.E-1 ) zs_accum = .true. + end do + end do + if ( .not.zs_accum ) then ! no terrain in the grid cell + std_dev(i) = 0._RKIND + convexity(i) = 0._RKIND + OA1(i) = 0._RKIND + OA2(i) = 0._RKIND + OA3(i) = 0._RKIND + OA4(i) = 0._RKIND + OL1(i) = 0._RKIND + OL2(i) = 0._RKIND + OL3(i) = 0._RKIND + OL4(i) = 0._RKIND + deallocate(zs) + cycle ! move on to next (coarse) grid cell + end if + + ! + ! Calculate standard deviation of subgrid-scale terrain height + ! + + ! Calculate mean height + sum2 = 0._RKIND + nfinepoints = ii_m*jj_m + do jj = 1,jj_m + do ii = 1,ii_m + sum2 = sum2 + zs(ii,jj) + end do + end do + zs_mean = sum2 / real(nfinepoints,RKIND) + + ! Calculate standard deviation + sum2 = 0._RKIND + do jj = 1,jj_m + do ii = 1,ii_m + sum2 = sum2 + ( zs(ii,jj) - zs_mean )**2 + end do + end do + std_dev(i) = sqrt( sum2/real(nfinepoints,RKIND) ) + + ! + ! Calculate convexity of sub-grid-scale terrain + ! + + sum2 = 0._RKIND + sum4 = 0._RKIND + do jj = 1,jj_m + do ii = 1,ii_m + sum2 = sum2 + ( zs(ii,jj) - zs_mean )**2 + sum4 = sum4 + ( zs(ii,jj) - zs_mean )**4 + end do + end do + + var = sum2 / real(nfinepoints,RKIND) + if ( abs(var) < 1.0E-05_RKIND ) then + convexity(i) = 0._RKIND + else + convexity(i) = min( sum4 / ( var**2 * & + real(nfinepoints,RKIND) ), max_convexity ) + end if + + ! + ! Calculate orographic asymmetries + ! + + ! OA1 -- orographic asymmetry in West direction + nu = 0 + nd = 0 + do jj = 1,jj_m + if(mod(ii_m,2).eq.0.) then + do ii = 1,ii_m/2 ! left half of box + if ( zs(ii,jj) > zs_mean ) nu = nu + 1 + end do + else + do ii = 1,ii_m/2+1 ! left half of box + if ( zs(ii,jj) > zs_mean ) nu = nu + 1 + end do + endif + do ii = ii_m/2 + 1, ii_m ! right half of box + if ( zs(ii,jj) > zs_mean ) nd = nd + 1 + end do + end do + if ( nu + nd > 0 ) then + OA1(i) = real((nu - nd),RKIND) / & + real((nu + nd),RKIND) + else + OA1(i) = 0._RKIND + end if + + ! OA2 -- orographic asymmetry in South direction + nu = 0 + nd = 0 + if(mod(jj_m,2).eq.0.) then + do jj = 1,jj_m/2 ! bottom half of box + do ii = 1,ii_m + if ( zs(ii,jj) > zs_mean ) nu = nu + 1 + end do + end do + else + do jj = 1,jj_m/2+1 ! bottom half of box + do ii = 1,ii_m + if ( zs(ii,jj) > zs_mean ) nu = nu + 1 + end do + end do + endif + do jj = jj_m/2 + 1,jj_m ! top half of box + do ii = 1, ii_m + if ( zs(ii,jj) > zs_mean ) nd = nd + 1 + end do + end do + if ( nu + nd > 0 ) then + OA2(i) = real((nu - nd),RKIND) / & + real((nu + nd),RKIND) + else + OA2(i) = 0._RKIND + end if + + ! OA3 -- orographic asymmetry in South-West direction + nu = 0 + nd = 0 + ratio = real(jj_m,RKIND)/real(ii_m,RKIND) + do jj = 1,jj_m + do ii = 1,ii_m + if ( nint(real(ii,RKIND)*ratio) <= (jj_m - jj + 1) ) then + ! south-west half of box + if ( zs(ii,jj) > zs_mean ) nu = nu + 1 + endif + if ( nint(real(ii,RKIND)*ratio) >= (jj_m - jj + 1) ) then + ! north-east half of box + if ( zs(ii,jj) > zs_mean ) nd = nd + 1 + end if + end do + end do + if ( nu + nd > 0 ) then + OA3(i) = real((nu - nd),RKIND) / & + real((nu + nd),RKIND) + else + OA3(i) = 0._RKIND + end if + + ! OA4 -- orographic asymmetry in North-West direction + nu = 0 + nd = 0 + ratio = real(jj_m,RKIND)/real(ii_m,RKIND) + do jj = 1,jj_m + do ii = 1,ii_m + if ( nint(real(ii,RKIND)*ratio) <= jj ) then + ! north-west half of box + if ( zs(ii,jj) > zs_mean ) nu = nu + 1 + end if + if ( nint(real(ii,RKIND)*ratio) >= jj ) then + ! south-east half of box + if ( zs(ii,jj) > zs_mean ) nd = nd + 1 + end if + end do + end do + if ( nu + nd > 0 ) then + OA4(i) = real((nu - nd),RKIND) / & + real((nu + nd),RKIND) + else + OA4(i) = 0._RKIND + end if + + + ! + ! Calculate orographic effective lengths + ! + + ! OL1 -- orographic effective length for Westerly flow + nw = 0 + nt = 0 + do jj = max(jj_m/4,1), 3*jj_m/4 + ! within central east-west band of box + do ii = 1, ii_m + if ( zs(ii,jj) > zs_mean ) nw = nw + 1 + nt = nt + 1 + end do + end do + if ( nt /= 0 ) then + OL1(i) = real(nw,RKIND) / real(nt,RKIND) + else + OL1(i) = 0._RKIND + end if + + ! OL2 -- orographic effective length for Southerly flow + nw = 0 + nt = 0 + do jj = 1, jj_m + do ii = max(ii_m/4,1), 3*ii_m/4 + ! within central north-south band of box + if ( zs(ii,jj) > zs_mean ) nw = nw + 1 + nt = nt + 1 + end do + end do + if ( nt /= 0 ) then + OL2(i) = real(nw,RKIND) / real(nt,RKIND) + else + OL2(i) = 0._RKIND + end if + + ! OL3 -- orographic effective length for South-Westerly flow + nw = 0 + nt = 0 + do jj = 1, jj_m/2 + do ii = 1, ii_m/2 + if ( zs(ii,jj) > zs_mean ) nw = nw + 1 + nt = nt + 1 + end do + end do + do jj = jj_m/2+1, jj_m + do ii = ii_m/2+1, ii_m + if ( zs(ii,jj) > zs_mean ) nw = nw + 1 + nt = nt + 1 + end do + end do + if ( nt /= 0 ) then + OL3(i) = real(nw,RKIND) / real(nt,RKIND) + else + OL3(i) = 0._RKIND + end if + + ! OL4 -- orographic effective length for North-Westerly flow + nw = 0 + nt = 0 + do jj = jj_m/2+1, jj_m + do ii = 1, ii_m/2 + if ( zs(ii,jj) > zs_mean ) nw = nw + 1 + nt = nt + 1 + end do + end do + do jj = 1, jj_m/2 + do ii = ii_m/2+1, ii_m + if ( zs(ii,jj) > zs_mean ) nw = nw + 1 + nt = nt + 1 + end do + end do + if ( nt /= 0 ) then + OL4(i) = real(nw,RKIND) / real(nt,RKIND) + else + OL4(i) = 0._RKIND + end if + + deallocate (zs) + +end do ! i = 1,nCells + + +! Deallocate arrays +deallocate(lat1d_fine) +deallocate(lon1d_fine) +deallocate(lon_MPAS) +deallocate(HGT_M_fine) + + +end subroutine calc_gsl_oro_data_sm_scale + + + +!> Finds nearest fine-grid i index to the east of a given longitude +!! +!! @param[in] lon_in longitude (radians) +!! @return nearest_i_east Nearest grid point i-index east of selected point +!! @author Michael Toy, NOAA/GSL +function nearest_i_east(lon_in) +! Calculates nearest fine-grid i index to the east of (or on) a given longitude +implicit none + +integer :: nearest_i_east +real (kind=RKIND), intent(in) :: lon_in +real (kind=RKIND) :: lon +integer :: i + +lon = lon_in +! Make sure longitude is between -Pi and Pi +do while ( (lon.lt.(-Pi)).or.(lon.gt.Pi) ) + if ( lon.lt.(-Pi) ) lon = lon + 2*Pi + if ( lon.gt.Pi ) lon = lon - 2*Pi +end do + +if ( lon.gt.lon1d_fine(topo_x) ) then + nearest_i_east = 1 +else + i = 1 + do while ( lon1d_fine(i).lt.lon ) + i = i + 1 + end do + nearest_i_east = i +end if + +end function nearest_i_east + +!> Finds nearest fine-grid i index to the west of a given longitude +!! +!! @param[in] lon_in longitude (radians) +!! @return nearest_i_west Nearest grid point i-index west of selected point +!! @author Michael Toy, NOAA/GSL +function nearest_i_west(lon_in) +! Calculates nearest fine-grid i index to the west of a given longitude +implicit none + +integer :: nearest_i_west +real (kind=RKIND), intent(in) :: lon_in +real (kind=RKIND) :: lon +integer :: i + +lon = lon_in +! Make sure longitude is between -Pi and Pi +do while ( (lon.lt.(-Pi)).or.(lon.gt.Pi) ) + if ( lon.lt.(-Pi) ) lon = lon + 2*Pi + if ( lon.gt.Pi ) lon = lon - 2*Pi +end do + +if ( (lon.lt.lon1d_fine(1)).or.(lon.ge.lon1d_fine(topo_x)) ) then + nearest_i_west = topo_x +else + i = 1 + do while ( lon1d_fine(i).le.lon ) + i = i + 1 + end do + nearest_i_west = i - 1 +end if + +end function nearest_i_west + +!> Calculates nearest fine-grid j index to the north of a given latitude +!! +!! @param[in] lat_in Latitude (radians) +!! @return nearest_j_north Nearest fine-grid j index to the north of a given latitude +!! @author Michael Toy, NOAA/GSL +function nearest_j_north(lat_in) +! Calculates nearest fine-grid j index to the north of a given latitude +! Note: If the abs(latitude) is greater than Pi/2 (90 degrees) then +! the value -999 is returned +implicit none + +integer :: nearest_j_north +real (kind=RKIND), intent(in) :: lat_in +real (kind=RKIND) :: lat +integer :: j + +lat = lat_in +if ( abs(lat_in).gt.p5*Pi ) then + nearest_j_north = -999 +else + j = 1 + do while ( (lat1d_fine(j).lt.lat).and.(j.lt.topo_y) ) + j = j + 1 + end do + nearest_j_north = j +end if + +end function nearest_j_north + +!> Calculates nearest fine-grid j index to the south of a given latitude +!! +!! @param[in] lat_in Latitude (radians) +!! @return nearest_j_south Nearest fine-grid j index to the south of a given latitude +!! @author Michael Toy, NOAA/GSL +function nearest_j_south(lat_in) +! Calculates nearest fine-grid j index to the south of a given latitude +! Note: If the abs(latitude) is greater than Pi/2 (90 degrees) then +! the value -999 is returned +implicit none + +integer :: nearest_j_south +real (kind=RKIND), intent(in) :: lat_in +real (kind=RKIND) :: lat +integer :: j + +lat = lat_in +if ( abs(lat_in).gt.p5*Pi ) then + nearest_j_south = -999 +elseif ( lat_in.le.lat1d_fine(1) ) then + nearest_j_south = 1 +else + j = 2 + do while ( (lat1d_fine(j).le.lat).and.(j.le.topo_y) ) + j = j + 1 + end do + nearest_j_south = j - 1 +end if + +end function nearest_j_south + +!> Interpolates (or extrapolates) linear function y = y(x) +!! +!! @param[in] x Input "x" value +!! @param[in] x1 Known point 1 +!! @param[in] x2 Known point 2 +!! @param[in] y1 Known y(x1) +!! @param[in] y2 Known y(x2) +!! @return interp_1d Interpolated y value at x +!! @author Michael Toy, NOAA/GSL +function interp_1d(x,x1,x2,y1,y2) +! Interpolates (or extrapolates) linear function y = y(x) +! to x given y1 = y(x1) and y2 = y(x2) +implicit none + +real (kind=RKIND) :: interp_1d +real (kind=RKIND), intent(in) :: x,x1,x2,y1,y2 +real (kind=RKIND) :: slope + +! Formula for a line: y = y1 + slope*(x - x1) +slope = (y2-y1)/(x2-x1) +interp_1d = y1 + slope*(x-x1) + +end function interp_1d + + + +end module mpas_gsl_oro_data_sm_scale diff --git a/src/core_init_atmosphere/mpas_init_atm_cases.F b/src/core_init_atmosphere/mpas_init_atm_cases.F index 42401430b..44e58bc78 100644 --- a/src/core_init_atmosphere/mpas_init_atm_cases.F +++ b/src/core_init_atmosphere/mpas_init_atm_cases.F @@ -19,6 +19,7 @@ module init_atm_cases use mpas_timer use mpas_init_atm_static use mpas_init_atm_surface + use mpas_init_atm_thompson_aerosols, only: init_atm_thompson_aerosols, init_atm_thompson_aerosols_lbc use mpas_atmphys_constants, only: svpt0,svp1,svp2,svp3 use mpas_atmphys_functions use mpas_atmphys_initialize_real @@ -44,6 +45,7 @@ subroutine init_atm_setup_case(domain, stream_manager) use mpas_stream_manager use mpas_init_atm_gwd, only : compute_gwd_fields + use mpas_init_atm_gwd_gsl, only : calc_gsl_oro_data implicit none @@ -59,12 +61,12 @@ 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 :: tend_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_native_gwd_gsl_static logical, pointer :: config_met_interp logical, pointer :: config_blend_bdy_terrain character (len=StrKIND), pointer :: config_start_time @@ -79,7 +81,7 @@ subroutine init_atm_setup_case(domain, stream_manager) type (MPAS_Time_type) :: curr_time, stop_time, start_time type (MPAS_TimeInterval_type) :: clock_interval, lbc_stream_interval, surface_stream_interval type (MPAS_TimeInterval_type) :: time_since_start - character(len=StrKIND) :: timeString + character(len=StrKIND) :: timeStart,timeString integer, pointer :: nCells integer, pointer :: nEdges @@ -158,7 +160,7 @@ subroutine init_atm_setup_case(domain, stream_manager) call mpas_pool_get_subpool(block_ptr % structs, 'diag', diag) call mpas_log_write(' calling test case setup ') - call init_atm_case_mtn_wave(mesh, nCells, nVertLevels, state, diag, block_ptr % configs) + call init_atm_case_mtn_wave(domain % dminfo, mesh, nCells, nVertLevels, state, diag, block_ptr % configs) call decouple_variables(mesh, nCells, nVertLevels, state, diag) call mpas_log_write(' returned from test case setup ') block_ptr => block_ptr % next @@ -174,6 +176,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_native_gwd_gsl_static', config_native_gwd_gsl_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) @@ -182,7 +185,6 @@ subroutine init_atm_setup_case(domain, stream_manager) 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, 'tend_physics', tend_physics) call mpas_pool_get_dimension(block_ptr % dimensions, 'nCells', nCells) call mpas_pool_get_dimension(block_ptr % dimensions, 'nEdges', nEdges) @@ -228,6 +230,19 @@ subroutine init_atm_setup_case(domain, stream_manager) end if end if + if (config_native_gwd_gsl_static) then + call mpas_log_write(' ') + call mpas_log_write('Computing GWDO static fields for UGWP orog drag on the native MPAS mesh') + call mpas_log_write(' ') + call calc_gsl_oro_data(domain,ierr) + if (ierr /= 0) then + call mpas_log_write('****************************************************************', messageType=MPAS_LOG_ERR) + call mpas_log_write('Error while trying to compute sub-grid-scale GSL orography', messageType=MPAS_LOG_ERR) + call mpas_log_write('statistics for use with the GWDO scheme.', messageType=MPAS_LOG_ERR) + call mpas_log_write('****************************************************************', messageType=MPAS_LOG_CRIT) + end if + end if + ! ! If at this point the mminlu variable is blank, we assume that the static interp step was ! not run, and that we are working with a static file created before there was a choice @@ -243,9 +258,10 @@ subroutine init_atm_setup_case(domain, stream_manager) end if call init_atm_case_gfs(block_ptr, mesh, nCells, nEdges, nVertLevels, fg, state, & - diag, diag_physics, tend_physics, block_ptr % dimensions, block_ptr % configs) + diag, diag_physics, block_ptr % dimensions, block_ptr % configs) if (config_met_interp) then + call init_atm_thompson_aerosols(block_ptr, mesh, block_ptr % configs, diag, state) call physics_initialize_real(mesh, fg, domain % dminfo, block_ptr % dimensions, block_ptr % configs) end if @@ -330,6 +346,9 @@ subroutine init_atm_setup_case(domain, stream_manager) call init_atm_case_lbc(timeString, block_ptr, mesh, nCells, nEdges, nVertLevels, fg, state, & diag, lbc_state, block_ptr % dimensions, block_ptr % configs) + call mpas_get_time(start_time, dateTimeString=timeStart) + call init_atm_thompson_aerosols_lbc(timeString, timeStart, block_ptr, mesh, diag, lbc_state) + block_ptr => block_ptr % next end do @@ -1966,13 +1985,15 @@ end subroutine init_atm_case_squall_line !---------------------------------------------------------------------------------------------------------- - subroutine init_atm_case_mtn_wave(mesh, nCells, nVertLevels, state, diag, configs) + subroutine init_atm_case_mtn_wave(dminfo, mesh, nCells, nVertLevels, state, diag, configs) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - ! Setup baroclinic wave test case from Jablonowski and Williamson 2008 (QJRMS) + ! Setup mountain wave test case from Schär et al. (2001): A New Terrain-Following Vertical + ! Coordinate Formulation for Atmospheric Prediction Models !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! implicit none + type (dm_info), intent(in) :: dminfo type (mpas_pool_type), intent(inout) :: mesh integer, intent(in) :: nCells integer, intent(in) :: nVertLevels @@ -2156,7 +2177,8 @@ subroutine init_atm_case_mtn_wave(mesh, nCells, nVertLevels, state, diag, config ! for hx computation xa = 5000. !SHP - should be changed based on grid distance xla = 4000. - xc = maxval (xCell(:))/2. + call mpas_dmpar_max_real(dminfo, maxval(xCell(:)), xc) + xc = xc * 0.5 ! metrics for hybrid coordinate and vertical stretching str = 1.0 @@ -2608,7 +2630,7 @@ subroutine init_atm_case_mtn_wave(mesh, nCells, nVertLevels, state, diag, config end subroutine init_atm_case_mtn_wave - subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state, diag, diag_physics, tend_physics, dims, configs) + subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state, diag, diag_physics, dims, configs) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Real-data test case using GFS data !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -2631,7 +2653,6 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state type (mpas_pool_type), intent(inout) :: state type (mpas_pool_type), intent(inout) :: diag type (mpas_pool_type), intent(inout):: diag_physics - type (mpas_pool_type), intent(inout):: tend_physics type (mpas_pool_type), intent(inout):: dims type (mpas_pool_type), intent(inout):: configs @@ -2779,7 +2800,6 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state real (kind=RKIND), dimension(:,:), pointer :: uReconstructZ real (kind=RKIND), dimension(:,:), pointer :: uReconstructZonal real (kind=RKIND), dimension(:,:), pointer :: uReconstructMeridional - real (kind=RKIND), dimension(:,:), pointer :: rqvcuten real (kind=RKIND), dimension(:), pointer :: psfc real (kind=RKIND), dimension(:), pointer :: skintemp @@ -2897,7 +2917,6 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state call mpas_pool_get_array(diag, 'theta', theta) call mpas_pool_get_array(diag, 'rho', rho) call mpas_pool_get_array(diag_physics, 'precipw', precipw) - call mpas_pool_get_array(tend_physics, 'rqvcuten', rqvcuten) call mpas_pool_get_array(diag, 'uReconstructX', uReconstructX) call mpas_pool_get_array(diag, 'uReconstructY', uReconstructY) call mpas_pool_get_array(diag, 'uReconstructZ', uReconstructZ) @@ -3469,7 +3488,8 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state do while (istatus == 0) - interp_list(1) = FOUR_POINT + ! interp_list(1) = FOUR_POINT + interp_list(1) = SIXTEEN_POINT interp_list(2) = SEARCH interp_list(3) = 0 @@ -3499,6 +3519,14 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state trim(field % field) == 'SM028100' .or. & trim(field % field) == 'SM100255' .or. & trim(field % field) == 'SM100289' .or. & + trim(field % field) == 'SOILM001' .or. & + trim(field % field) == 'SOILM002' .or. & + trim(field % field) == 'SOILM006' .or. & + trim(field % field) == 'SOILM018' .or. & + trim(field % field) == 'SOILM054' .or. & + trim(field % field) == 'SOILM162' .or. & + trim(field % field) == 'SOILM486' .or. & + trim(field % field) == 'SOILM999' .or. & trim(field % field) == 'ST000010' .or. & trim(field % field) == 'ST010040' .or. & trim(field % field) == 'ST040100' .or. & @@ -3509,6 +3537,14 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state trim(field % field) == 'ST028100' .or. & trim(field % field) == 'ST100255' .or. & trim(field % field) == 'ST100289' .or. & + trim(field % field) == 'SOILT001' .or. & + trim(field % field) == 'SOILT002' .or. & + trim(field % field) == 'SOILT006' .or. & + trim(field % field) == 'SOILT018' .or. & + trim(field % field) == 'SOILT054' .or. & + trim(field % field) == 'SOILT162' .or. & + trim(field % field) == 'SOILT486' .or. & + trim(field % field) == 'SOILT999' .or. & trim(field % field) == 'PRES' .or. & trim(field % field) == 'PRESSURE' .or. & trim(field % field) == 'SNOW' .or. & @@ -3525,6 +3561,14 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state trim(field % field) == 'SM028100' .or. & trim(field % field) == 'SM100255' .or. & trim(field % field) == 'SM100289' .or. & + trim(field % field) == 'SOILM001' .or. & + trim(field % field) == 'SOILM002' .or. & + trim(field % field) == 'SOILM006' .or. & + trim(field % field) == 'SOILM018' .or. & + trim(field % field) == 'SOILM054' .or. & + trim(field % field) == 'SOILM162' .or. & + trim(field % field) == 'SOILM486' .or. & + trim(field % field) == 'SOILM999' .or. & trim(field % field) == 'ST000010' .or. & trim(field % field) == 'ST010040' .or. & trim(field % field) == 'ST040100' .or. & @@ -3535,6 +3579,14 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state trim(field % field) == 'ST028100' .or. & trim(field % field) == 'ST100255' .or. & trim(field % field) == 'ST100289' .or. & + trim(field % field) == 'SOILT001' .or. & + trim(field % field) == 'SOILT002' .or. & + trim(field % field) == 'SOILT006' .or. & + trim(field % field) == 'SOILT018' .or. & + trim(field % field) == 'SOILT054' .or. & + trim(field % field) == 'SOILT162' .or. & + trim(field % field) == 'SOILT486' .or. & + trim(field % field) == 'SOILT999' .or. & trim(field % field) == 'SNOW' .or. & trim(field % field) == 'SEAICE' .or. & trim(field % field) == 'SKINTEMP') then @@ -3560,6 +3612,7 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state ! many unique levels are found using the code above ! if (too_many_fg_levs) then + deallocate(field % slab) call read_next_met_field(field, istatus) cycle end if @@ -3905,6 +3958,166 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state ndims = 2 dzs_fg(k,:) = 289.-100. zs_fg(k,:) = 289. + else if (trim(field % field) == 'SOILM001') then + call mpas_log_write('Interpolating SOILM001') + + interp_list(1) = FOUR_POINT + interp_list(2) = W_AVERAGE4 + interp_list(3) = SEARCH + interp_list(4) = 0 + + maskval = 0.0 + masked = 0 + fillval = 1.0 + + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(fg, 'sm_fg', destField2d) + k = 1 + ndims = 2 + dzs_fg(k,:) = 1.-0. + zs_fg(k,:) = 1. + else if (trim(field % field) == 'SOILM002') then + call mpas_log_write('Interpolating SOILM002') + + interp_list(1) = FOUR_POINT + interp_list(2) = W_AVERAGE4 + interp_list(3) = SEARCH + interp_list(4) = 0 + + maskval = 0.0 + masked = 0 + fillval = 1.0 + + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(fg, 'sm_fg', destField2d) + k = 2 + ndims = 2 + dzs_fg(k,:) = 3.-1. + zs_fg(k,:) = 3. + else if (trim(field % field) == 'SOILM006') then + call mpas_log_write('Interpolating SOILM006') + + interp_list(1) = FOUR_POINT + interp_list(2) = W_AVERAGE4 + interp_list(3) = SEARCH + interp_list(4) = 0 + + maskval = 0.0 + masked = 0 + fillval = 1.0 + + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(fg, 'sm_fg', destField2d) + k = 3 + ndims = 2 + dzs_fg(k,:) = 9.-3. + zs_fg(k,:) = 9. + else if (trim(field % field) == 'SOILM018') then + call mpas_log_write('Interpolating SOILM018') + + interp_list(1) = FOUR_POINT + interp_list(2) = W_AVERAGE4 + interp_list(3) = SEARCH + interp_list(4) = 0 + + maskval = 0.0 + masked = 0 + fillval = 1.0 + + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(fg, 'sm_fg', destField2d) + k = 4 + ndims = 2 + dzs_fg(k,:) = 27.-9. + zs_fg(k,:) = 27. + else if (trim(field % field) == 'SOILM054') then + call mpas_log_write('Interpolating SOILM054') + + interp_list(1) = FOUR_POINT + interp_list(2) = W_AVERAGE4 + interp_list(3) = SEARCH + interp_list(4) = 0 + + maskval = 0.0 + masked = 0 + fillval = 1.0 + + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(fg, 'sm_fg', destField2d) + k = 5 + ndims = 2 + dzs_fg(k,:) = 81.-27. + zs_fg(k,:) = 81. + else if (trim(field % field) == 'SOILM162') then + call mpas_log_write('Interpolating SOILM162') + + interp_list(1) = FOUR_POINT + interp_list(2) = W_AVERAGE4 + interp_list(3) = SEARCH + interp_list(4) = 0 + + maskval = 0.0 + masked = 0 + fillval = 1.0 + + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(fg, 'sm_fg', destField2d) + k = 6 + ndims = 2 + dzs_fg(k,:) = 243.-81. + zs_fg(k,:) = 243. + else if (trim(field % field) == 'SOILM486') then + call mpas_log_write('Interpolating SOILM486') + + interp_list(1) = FOUR_POINT + interp_list(2) = W_AVERAGE4 + interp_list(3) = SEARCH + interp_list(4) = 0 + + maskval = 0.0 + masked = 0 + fillval = 1.0 + + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(fg, 'sm_fg', destField2d) + k = 7 + ndims = 2 + dzs_fg(k,:) = 729.-243. + zs_fg(k,:) = 729. + else if (trim(field % field) == 'SOILM999') then + call mpas_log_write('Interpolating SOILM999') + + interp_list(1) = FOUR_POINT + interp_list(2) = W_AVERAGE4 + interp_list(3) = SEARCH + interp_list(4) = 0 + + maskval = 0.0 + masked = 0 + fillval = 1.0 + + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(fg, 'sm_fg', destField2d) + k = 8 + ndims = 2 + dzs_fg(k,:) = 2187.-729. + zs_fg(k,:) = 2187. else if (trim(field % field) == 'ST000010') then call mpas_log_write('Interpolating ST000010') @@ -4115,6 +4328,174 @@ subroutine init_atm_case_gfs(block, mesh, nCells, nEdges, nVertLevels, fg, state ndims = 2 dzs_fg(k,:) = 289.-100. zs_fg(k,:) = 289. + else if (trim(field % field) == 'SOILT001') then + call mpas_log_write('Interpolating SOILT001') + + interp_list(1) = SIXTEEN_POINT + interp_list(2) = FOUR_POINT + interp_list(3) = W_AVERAGE4 + interp_list(4) = SEARCH + interp_list(5) = 0 + + maskval = 0.0 + masked = 0 + fillval = 285.0 + + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(fg, 'st_fg', destField2d) + k = 1 + ndims = 2 + dzs_fg(k,:) = 1.-0. + zs_fg(k,:) = 1. + else if (trim(field % field) == 'SOILT002') then + call mpas_log_write('Interpolating SOILT002') + + interp_list(1) = SIXTEEN_POINT + interp_list(2) = FOUR_POINT + interp_list(3) = W_AVERAGE4 + interp_list(4) = SEARCH + interp_list(5) = 0 + + maskval = 0.0 + masked = 0 + fillval = 285.0 + + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(fg, 'st_fg', destField2d) + k = 2 + ndims = 2 + dzs_fg(k,:) = 3.-1. + zs_fg(k,:) = 3. + else if (trim(field % field) == 'SOILT006') then + call mpas_log_write('Interpolating SOILT006') + + interp_list(1) = SIXTEEN_POINT + interp_list(2) = FOUR_POINT + interp_list(3) = W_AVERAGE4 + interp_list(4) = SEARCH + interp_list(5) = 0 + + maskval = 0.0 + masked = 0 + fillval = 285.0 + + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(fg, 'st_fg', destField2d) + k = 3 + ndims = 2 + dzs_fg(k,:) = 9.-3. + zs_fg(k,:) = 9. + else if (trim(field % field) == 'SOILT018') then + call mpas_log_write('Interpolating SOILT018') + + interp_list(1) = SIXTEEN_POINT + interp_list(2) = FOUR_POINT + interp_list(3) = W_AVERAGE4 + interp_list(4) = SEARCH + interp_list(5) = 0 + + maskval = 0.0 + masked = 0 + fillval = 285.0 + + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(fg, 'st_fg', destField2d) + k = 4 + ndims = 2 + dzs_fg(k,:) = 27.-9. + zs_fg(k,:) = 27. + else if (trim(field % field) == 'SOILT054') then + call mpas_log_write('Interpolating SOILT054') + + interp_list(1) = SIXTEEN_POINT + interp_list(2) = FOUR_POINT + interp_list(3) = W_AVERAGE4 + interp_list(4) = SEARCH + interp_list(5) = 0 + + maskval = 0.0 + masked = 0 + fillval = 285.0 + + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(fg, 'st_fg', destField2d) + k = 5 + ndims = 2 + dzs_fg(k,:) = 81.-27. + zs_fg(k,:) = 81. + else if (trim(field % field) == 'SOILT162') then + call mpas_log_write('Interpolating SOILT162') + + interp_list(1) = SIXTEEN_POINT + interp_list(2) = FOUR_POINT + interp_list(3) = W_AVERAGE4 + interp_list(4) = SEARCH + interp_list(5) = 0 + + maskval = 0.0 + masked = 0 + fillval = 285.0 + + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(fg, 'st_fg', destField2d) + k = 6 + ndims = 2 + dzs_fg(k,:) = 243.-81. + zs_fg(k,:) = 243. + else if (trim(field % field) == 'SOILT486') then + call mpas_log_write('Interpolating SOILT486') + + interp_list(1) = SIXTEEN_POINT + interp_list(2) = FOUR_POINT + interp_list(3) = W_AVERAGE4 + interp_list(4) = SEARCH + interp_list(5) = 0 + + maskval = 0.0 + masked = 0 + fillval = 285.0 + + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(fg, 'st_fg', destField2d) + k = 7 + ndims = 2 + dzs_fg(k,:) = 729.-243. + zs_fg(k,:) = 729. + else if (trim(field % field) == 'SOILT999') then + call mpas_log_write('Interpolating SOILT999') + + interp_list(1) = SIXTEEN_POINT + interp_list(2) = FOUR_POINT + interp_list(3) = W_AVERAGE4 + interp_list(4) = SEARCH + interp_list(5) = 0 + + maskval = 0.0 + masked = 0 + fillval = 285.0 + + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(fg, 'st_fg', destField2d) + k = 8 + ndims = 2 + dzs_fg(k,:) = 2187.-729. + zs_fg(k,:) = 2187. else if (trim(field % field) == 'SNOW') then call mpas_log_write('Interpolating SNOW') @@ -5261,7 +5642,8 @@ subroutine init_atm_case_lbc(timestamp, block, mesh, nCells, nEdges, nVertLevels do while (istatus == 0) - interp_list(1) = FOUR_POINT + ! interp_list(1) = FOUR_POINT + interp_list(1) = SIXTEEN_POINT interp_list(2) = SEARCH interp_list(3) = 0 @@ -5296,6 +5678,7 @@ subroutine init_atm_case_lbc(timestamp, block, mesh, nCells, nEdges, nVertLevels ! many unique levels are found using the code above ! if (too_many_fg_levs) then + deallocate(field % slab) call read_next_met_field(field, istatus) cycle end if @@ -6701,7 +7084,7 @@ subroutine physics_idealized_init(mesh, fg) dzs(iSoil,iCell) = 0.0 end do - !monthly climatological surface albedo and greeness fraction: + !monthly climatological surface albedo and greenness fraction: do iMonth = 1, nMonths albedo12m(iMonth,iCell) = 0.08 greenfrac(iMonth,iCell) = 0.0 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 6fca9a737..f277a4a72 100644 --- a/src/core_init_atmosphere/mpas_init_atm_core_interface.F +++ b/src/core_init_atmosphere/mpas_init_atm_core_interface.F @@ -112,19 +112,28 @@ function init_atm_setup_packages(configs, streamInfo, packages, iocontext) resul type (mpas_pool_type), intent(inout) :: packages type (mpas_io_context_type), intent(inout) :: iocontext integer :: ierr + logical :: lexist 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 :: gwd_gsl_stage_out logical, pointer :: config_native_gwd_static, config_static_interp, config_vertical_grid, config_met_interp + logical, pointer :: config_native_gwd_gsl_static logical, pointer :: first_guess_field + logical, pointer :: mp_thompson_aers_in integer, pointer :: config_init_case + logical, pointer :: noahmp, config_noahmp_static - ierr = 0 + ierr = init_atm_setup_packages_when(configs, packages) + if (ierr /= 0) then + return + end if call mpas_pool_get_config(configs, 'config_init_case', config_init_case) call mpas_pool_get_config(configs, 'config_static_interp', config_static_interp) call mpas_pool_get_config(configs, 'config_native_gwd_static', config_native_gwd_static) + call mpas_pool_get_config(configs, 'config_native_gwd_gsl_static', config_native_gwd_gsl_static) call mpas_pool_get_config(configs, 'config_vertical_grid', config_vertical_grid) call mpas_pool_get_config(configs, 'config_met_interp', config_met_interp) @@ -143,6 +152,9 @@ function init_atm_setup_packages(configs, streamInfo, packages, iocontext) resul nullify(gwd_stage_out) call mpas_pool_get_package(packages, 'gwd_stage_outActive', gwd_stage_out) + nullify(gwd_gsl_stage_out) + call mpas_pool_get_package(packages, 'gwd_gsl_stage_outActive', gwd_gsl_stage_out) + nullify(vertical_stage_in) call mpas_pool_get_package(packages, 'vertical_stage_inActive', vertical_stage_in) @@ -155,14 +167,19 @@ function init_atm_setup_packages(configs, streamInfo, packages, iocontext) resul nullify(met_stage_out) call mpas_pool_get_package(packages, 'met_stage_outActive', met_stage_out) + nullify(mp_thompson_aers_in) + call mpas_pool_get_package(packages, 'mp_thompson_aers_inActive', mp_thompson_aers_in) + 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(gwd_gsl_stage_out) .or. & .not. associated(vertical_stage_in) .or. & .not. associated(vertical_stage_out) .or. & .not. associated(met_stage_in) .or. & - .not. associated(met_stage_out)) then + .not. associated(met_stage_out) .or. & + .not. associated(mp_thompson_aers_in)) then call mpas_log_write('********************************************************************************', messageType=MPAS_LOG_ERR) call mpas_log_write('* Error while setting up packages for init_atmosphere core.', messageType=MPAS_LOG_ERR) call mpas_log_write('********************************************************************************', messageType=MPAS_LOG_ERR) @@ -180,8 +197,12 @@ function init_atm_setup_packages(configs, streamInfo, packages, iocontext) resul if (config_init_case == 9) then lbcs = .true. + mp_thompson_aers_in = .false. + inquire(file="QNWFA_QNIFA_SIGMA_MONTHLY.dat",exist=lexist) + if(lexist) mp_thompson_aers_in = .true. else lbcs = .false. + mp_thompson_aers_in = .false. end if if (config_init_case == 7) then @@ -194,6 +215,7 @@ function init_atm_setup_packages(configs, streamInfo, packages, iocontext) resul gwd_stage_in = config_native_gwd_static .and. & (.not. config_static_interp) gwd_stage_out = config_native_gwd_static + gwd_gsl_stage_out = config_native_gwd_gsl_static vertical_stage_in = config_vertical_grid .and. & (.not. config_native_gwd_static) .and. & (.not. config_static_interp) @@ -204,9 +226,14 @@ function init_atm_setup_packages(configs, streamInfo, packages, iocontext) resul (.not. config_vertical_grid) met_stage_out = config_met_interp + mp_thompson_aers_in = .false. + inquire(file="QNWFA_QNIFA_SIGMA_MONTHLY.dat",exist=lexist) + if((lexist .and. met_stage_out) .or. (lexist .and. met_stage_in)) mp_thompson_aers_in = .true. + else if (config_init_case == 8) then gwd_stage_in = .false. gwd_stage_out = .false. + gwd_gsl_stage_out = .false. vertical_stage_in = .true. vertical_stage_out = .false. met_stage_in = .false. @@ -219,16 +246,22 @@ function init_atm_setup_packages(configs, streamInfo, packages, iocontext) resul else if (config_init_case == 9) then gwd_stage_in = .false. gwd_stage_out = .false. + gwd_gsl_stage_out = .false. vertical_stage_in = .false. vertical_stage_out = .false. met_stage_in = .true. met_stage_out = .true. + mp_thompson_aers_in = .false. + inquire(file="QNWFA_QNIFA_SIGMA_MONTHLY.dat",exist=lexist) + if((lexist .and. met_stage_out) .or. (lexist .and. met_stage_in)) mp_thompson_aers_in = .true. + initial_conds = .false. ! Also, turn off the initial_conds package to avoid writing the IC "output" stream else if (config_init_case == 13) then gwd_stage_in = .false. gwd_stage_out = .false. + gwd_gsl_stage_out = .false. vertical_stage_in = .false. vertical_stage_out = .true. met_stage_in = .false. @@ -237,6 +270,7 @@ function init_atm_setup_packages(configs, streamInfo, packages, iocontext) resul else gwd_stage_in = .false. gwd_stage_out = .false. + gwd_gsl_stage_out = .false. vertical_stage_in = .false. vertical_stage_out = .false. met_stage_in = .false. @@ -255,6 +289,32 @@ function init_atm_setup_packages(configs, streamInfo, packages, iocontext) resul first_guess_field = .true. end if + ! + ! Noah-MP + ! + nullify(config_noahmp_static) + call mpas_pool_get_config(configs, 'config_noahmp_static', config_noahmp_static) + + nullify(noahmp) + call mpas_pool_get_package(packages, 'noahmpActive', noahmp) + + if (associated(config_noahmp_static) .and. associated(noahmp)) then + noahmp = config_noahmp_static + else + call mpas_log_write('********************************************************************************', & + messageType=MPAS_LOG_ERR) + call mpas_log_write('* Error while setting up packages for init_atmosphere core:', & + messageType=MPAS_LOG_ERR) + call mpas_log_write('* Either the ''noahmp'' package or the ''config_noahmp_static'' namelist', & + messageType=MPAS_LOG_ERR) + call mpas_log_write('* option is not defined.', & + messageType=MPAS_LOG_ERR) + call mpas_log_write('********************************************************************************', & + messageType=MPAS_LOG_ERR) + ierr = 1 + return + end if + end function init_atm_setup_packages @@ -325,9 +385,7 @@ function init_atm_setup_log(logInfo, domain, unitNumbers) result(iErr)!{{{ use mpas_derived_types, only : mpas_log_type, domain_type use mpas_log, only : mpas_log_init, mpas_log_open -#ifdef MPAS_OPENMP - use mpas_threading, only : mpas_threading_get_num_threads -#endif + use mpas_framework, only : mpas_framework_report_settings implicit none @@ -356,53 +414,8 @@ function init_atm_setup_log(logInfo, domain, unitNumbers) result(iErr)!{{{ call mpas_log_write('') call mpas_log_write('MPAS Init-Atmosphere Version '//trim(domain % core % modelVersion)) call mpas_log_write('') - call mpas_log_write('') - call mpas_log_write('Output from ''git describe --dirty'': '//trim(domain % core % git_version)) - call mpas_log_write('') - call mpas_log_write('Compile-time options:') - call mpas_log_write(' Build target: '//trim(domain % core % build_target)) - call mpas_log_write(' OpenMP support: ' // & -#ifdef MPAS_OPENMP - 'yes') -#else - 'no') -#endif - call mpas_log_write(' OpenACC support: ' // & -#ifdef MPAS_OPENACC - 'yes') -#else - 'no') -#endif - call mpas_log_write(' Default real precision: ' // & -#ifdef SINGLE_PRECISION - 'single') -#else - 'double') -#endif - call mpas_log_write(' Compiler flags: ' // & -#ifdef MPAS_DEBUG - 'debug') -#else - 'optimize') -#endif - call mpas_log_write(' I/O layer: ' // & -#ifdef MPAS_PIO_SUPPORT -#ifdef USE_PIO2 - 'PIO 2.x') -#else - 'PIO 1.x') -#endif -#else - 'SMIOL') -#endif - call mpas_log_write('') - call mpas_log_write('Run-time settings:') - call mpas_log_write(' MPI task count: $i', intArgs=[domain % dminfo % nprocs]) -#ifdef MPAS_OPENMP - call mpas_log_write(' OpenMP max threads: $i', intArgs=[mpas_threading_get_max_threads()]) -#endif - call mpas_log_write('') + call mpas_framework_report_settings(domain) end function init_atm_setup_log!}}} @@ -515,6 +528,8 @@ end function init_atm_setup_block #include "define_packages.inc" +#include "setup_packages.inc" + #include "structs_and_variables.inc" #include "namelist_call.inc" diff --git a/src/core_init_atmosphere/mpas_init_atm_gwd.F b/src/core_init_atmosphere/mpas_init_atm_gwd.F index 25ef93c8c..552dc232b 100644 --- a/src/core_init_atmosphere/mpas_init_atm_gwd.F +++ b/src/core_init_atmosphere/mpas_init_atm_gwd.F @@ -19,6 +19,22 @@ module mpas_init_atm_gwd private + integer, parameter :: I1KIND = selected_int_kind(2) + + ! A derived type to hold contents of a tile (both topo and landuse) + type :: mpas_gwd_tile_type + + real (kind=R4KIND), dimension(:,:), pointer :: topo_array => null() + integer (kind=I1KIND), dimension(:,:), pointer :: landuse_array => null() + ! coordinates of the tile to be read. + ! NB: tile_start_x can be used as is to read landuse tiles, but need an + ! adjustment to account for the shifting of topo array start_lon to -180.0. + integer :: tile_start_x = -1, tile_start_y = -1 + ! linked list next pointer + type (mpas_gwd_tile_type), pointer :: next => null() + + end type mpas_gwd_tile_type + interface subroutine read_geogrid(fname, rarray, nx, ny, nz, isigned, endian, & wordsize, status) bind(C) @@ -35,14 +51,15 @@ subroutine read_geogrid(fname, rarray, nx, ny, nz, isigned, endian, & 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 real (kind=RKIND), parameter :: Pi = 2.0_RKIND * asin(1.0_RKIND) real (kind=RKIND), parameter :: rad2deg = 180.0_RKIND / Pi integer, parameter :: topo_x = 43200 ! x-dimension of global 30-arc-second topography array integer, parameter :: topo_y = 21600 ! y-dimension of global 30-arc-second topography array + integer, parameter :: tile_x = 1200 ! x-dimension of each tile of global 30-arc-second topography + integer, parameter :: tile_y = 1200 ! y-dimension of each tile of global 30-arc-second topography + real (kind=RKIND), parameter :: pts_per_degree = real(topo_x,RKIND) / 360.0_RKIND ! The following are set at the beginning of the compute_gwd_fields routine depending @@ -50,17 +67,12 @@ end subroutine read_geogrid real (kind=RKIND) :: start_lat real (kind=RKIND) :: start_lon + ! To introduce an offset in the x-coordinate in the case of GMTED2010 topo data, as the dataset starts at 0.0 longitude + integer :: topo_shift = 0 + ! Nominal delta-x (in meters) for sub-grid topography cells real (kind=RKIND), parameter :: sg_delta = 2.0 * Pi * Re / (360.0_RKIND * real(pts_per_degree,RKIND)) - real (kind=R4KIND), dimension(:,:), pointer :: topo ! Global 30-arc-second topography - real (kind=RKIND), dimension(:,:), pointer :: box ! Subset of topography covering a grid cell - real (kind=RKIND), dimension(:,:), pointer :: dxm ! Size (meters) in zonal direction of a grid cell - real (kind=RKIND) :: box_mean ! Mean value of topography in box - integer :: nx, ny ! Dimensions of box covering grid cell - integer (kind=I1KIND), dimension(:,:), pointer :: landuse ! Global 30-arc-second landuse - integer (kind=I1KIND), dimension(:,:), pointer :: box_landuse ! Subset of landuse covering a grid cell - ! NB: At present, only the USGS GLCC land cover dataset is supported, so we can assume 16 == water ! See the read_global_30s_landuse function integer (kind=I1KIND), parameter :: WATER = 16 @@ -117,14 +129,23 @@ function compute_gwd_fields(domain) result(iErr) character(len=StrKIND) :: geog_sub_path character(len=StrKIND+1) :: geog_data_path ! same as config_geog_data_path, but guaranteed to have a trailing slash + type(mpas_gwd_tile_type), pointer :: tilesHead ! Pointer to linked list of tiles + ! Variables for smoothing variance integer, dimension(:,:), pointer:: cellsOnCell integer (kind=I1KIND) :: sum_landuse real (kind=RKIND) :: sum_var + real (kind=RKIND), dimension(:,:), pointer :: box ! Subset of topography covering a grid cell + real (kind=RKIND), dimension(:,:), pointer :: dxm ! Size (meters) in zonal direction of a grid cell + real (kind=RKIND) :: box_mean ! Mean value of topography in box + integer (kind=I1KIND), dimension(:,:), pointer :: box_landuse ! Subset of landuse covering a grid cell + integer :: nx, ny - allocate(topo(topo_x,topo_y)) - allocate(landuse(topo_x,topo_y)) + box => null() + dxm => null() + box_landuse => null() + tilesHead => null() call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', mesh) call mpas_pool_get_subpool(domain % blocklist % structs, 'state', state) @@ -155,6 +176,8 @@ function compute_gwd_fields(domain) result(iErr) ! by the rest of this code is -180.0. start_lat = -90.0_RKIND start_lon = -180.0_RKIND + ! so we introduce an offset in the x-coordinate of topo_x/2 + topo_shift = topo_x / 2 case('default') call mpas_log_write('*****************************************************************', messageType=MPAS_LOG_ERR) call mpas_log_write('Invalid topography dataset '''//trim(config_topo_data) & @@ -187,25 +210,13 @@ function compute_gwd_fields(domain) result(iErr) 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, 'elvmax', elvmax) -! call mpas_pool_get_array(mesh, 'theta', htheta) -! call mpas_pool_get_array(mesh, 'gamma', hgamma) -! call mpas_pool_get_array(mesh, 'sigma', hsigma) + ! call mpas_pool_get_array(mesh, 'elvmax', elvmax) + ! call mpas_pool_get_array(mesh, 'theta', htheta) + ! call mpas_pool_get_array(mesh, 'gamma', hgamma) + ! call mpas_pool_get_array(mesh, 'sigma', hsigma) allocate(hlanduse(nCells+1)) ! +1, since we access hlanduse(cellsOnCell(i,iCell)) later on for iCell=1,nCells - iErr = read_global_30s_topo(geog_data_path, geog_sub_path) - if (iErr /= 0) then - call mpas_log_write('Error reading global 30-arc-sec topography for GWD statistics', messageType=MPAS_LOG_ERR) - return - end if - - iErr = read_global_30s_landuse(geog_data_path) - if (iErr /= 0) then - call mpas_log_write('Error reading global 30-arc-sec landuse for GWD statistics', messageType=MPAS_LOG_ERR) - return - end if - ! ! It is possible that this code is called before the mesh fields have been scaled ! up to "Earth-sized". Because we need "Earth" distances to cut out bounding @@ -247,43 +258,49 @@ function compute_gwd_fields(domain) result(iErr) ! ! Cut out a rectangular piece of the global 30-arc-second topography - ! data that is centered at the lat/lon of the current cell being + ! data that is centered at the lat/lon (in radians) of the current cell being ! processed and that is just large enough to cover the cell. The - ! rectangular array of topography data is stored in the module - ! variable 'box', and the dimensions of this array are given by the - ! module variables 'nx' and 'ny'. The get_box() routine also + ! rectangular array of topography data is stored in the local + ! variable 'box', and the dimensions of this array are obtained from + ! the routine get_box_size_from_lat() and stored in the + ! local variables 'nx' and 'ny'. The get_box() routine also ! computes the mean elevation in the array and stores that value in - ! the module variable 'box_mean'. + ! the local variable 'box_mean'. 'tilesHead' points to the head of the linked + ! list of tiles, which is used by get_box() and its internal subroutines to search + ! for tile data and add new tiles to the head of this list as necessary. ! - call get_box(latCell(iCell)*rad2deg, lonCell(iCell)*rad2deg, dc) + call get_box_size_from_lat(latCell(iCell), dc, nx, ny) + + call get_box(latCell(iCell)*rad2deg,lonCell(iCell)*rad2deg, nx, ny, & + geog_data_path, geog_sub_path, tilesHead, box, box_landuse, dxm, box_mean) ! ! With a box of 30-arc-second data for the current grid cell, call ! subroutines to compute each sub-grid orography statistic ! - var2d(iCell) = get_var() - con(iCell) = get_con() - oa1(iCell) = get_oa1() - oa2(iCell) = get_oa2() - oa3(iCell) = get_oa3() - oa4(iCell) = get_oa4() + var2d(iCell) = get_var(box, box_mean, nx, ny) + con(iCell) = get_con(box, box_landuse, box_mean, nx, ny) + oa1(iCell) = get_oa1(box, box_mean, nx, ny) + oa2(iCell) = get_oa2(box, box_mean, nx, ny) + oa3(iCell) = get_oa3(box, box_mean, nx, ny) + oa4(iCell) = get_oa4(box, box_mean, nx, ny) ! Critical height, to be used in OL computation ! See Appendix of Kim, Y-J, 1996: Representation of Sub-Grid Scale Orographic Effects ! in a General Circulation Model. J. Climate, 9, 2698-2717. hc = 1116.2_RKIND - 0.878_RKIND * var2d(iCell) - ol1(iCell) = get_ol1() - ol2(iCell) = get_ol2() - ol3(iCell) = get_ol3() - ol4(iCell) = get_ol4() + ol1(iCell) = get_ol1(box, nx, ny) + ol2(iCell) = get_ol2(box, nx, ny) + ol3(iCell) = get_ol3(box, nx, ny) + ol4(iCell) = get_ol4(box, nx, ny) - hlanduse(iCell) = get_dom_landmask() ! get dominant land mask in cell + hlanduse(iCell) = get_dom_landmask(box_landuse, nx, ny) ! get dominant land mask in cell -! elvmax(iCell) = get_elvmax() -! htheta(iCell) = get_htheta() -! hgamma(iCell) = get_hgamma() -! hsigma(iCell) = get_hsigma() + ! elvmax(iCell) = get_elvmax(box, nx, ny) + ! htheta(iCell) = get_htheta(box, dxm, nx, ny) + ! hgamma(iCell) = get_hgamma(box, dxm, nx, ny) + ! hsigma(iCell) = get_hsigma(box, dxm, nx, ny) end do @@ -305,43 +322,233 @@ function compute_gwd_fields(domain) result(iErr) end if end do - - deallocate(topo) - deallocate(landuse) + if (associated(box)) deallocate(box) + if (associated(box_landuse)) deallocate(box_landuse) + if (associated(dxm)) deallocate(dxm) deallocate(hlanduse) - iErr = 0 + iErr = free_tile_list(tilesHead) end function compute_gwd_fields !*********************************************************************** ! - ! function read_global_30s_topo + ! subroutine get_box_size_from_lat + ! + !> \brief Routine to obtain box size given the mean diameter (meters), lat, lon (radians) + !> \author Abishek Gopal + !> \date 05 Sep 2024 + !> \details + !> Routine to obtain box size (nx, ny) given the mean diameter of the grid cell (meters), + ! and the latitude (radians) + ! + !----------------------------------------------------------------------- + subroutine get_box_size_from_lat(lat, dx, nx, ny) + + implicit none + + real (kind=RKIND), intent(in) :: lat + real (kind=RKIND), intent(in) :: dx + integer, intent(out) :: nx + integer, intent(out) :: ny + + ! + ! Get number of points to extract in the zonal direction + ! + if (cos(lat) > (2.0 * pts_per_degree * dx * 180.0) / (real(topo_x,RKIND) * Pi * Re)) then + nx = ceiling((180.0 * dx * pts_per_degree) / (Pi * Re * cos(lat))) + else + nx = topo_x / 2 + end if + + ! + ! Get number of points to extract in the meridional direction + ! + ny = ceiling((180.0 * dx * pts_per_degree) / (Pi * Re)) + + end subroutine get_box_size_from_lat + + + !*********************************************************************** ! - !> \brief Reads global 30-arc-second topography into 'topo' module variable + ! function get_tile_from_box_point + ! + !> \brief Routine to obtain a tile given a box pixel + !> \author Abishek Gopal + !> \date 05 Sep 2024 + !> \details + !> Routine to obtain a tile of type mpas_gwd_tile_type, given the linked + ! list of tiles tilesHead, box coordinates box_x, box_y, and path to + ! static dataset. The function first searches the linked list to locate + ! the tile, and if search fails, adds the target tile to the linked list + ! after reading in the data for the tile from disk + !----------------------------------------------------------------------- + function get_tile_from_box_point(tilesHead, box_x, box_y, path, sub_path, last_tile) result(thisTile) + + implicit none + + type(mpas_gwd_tile_type), pointer, intent(inout) :: tilesHead + integer, intent(in) :: box_x, box_y + character(len=*), intent(in) :: path + character(len=*), intent(in) :: sub_path + type(mpas_gwd_tile_type), pointer, intent(in) :: last_tile + + type(mpas_gwd_tile_type), pointer :: thisTile + + integer :: tile_start_x, tile_start_y, tile_start_x_topo + + ! Need special handling for the x-coordinates of topo tiles, due to the shift by topo_shift + ! in certain datasets. We use tile_start_x, tile_start_y to search for tiles and open landmask tiles, + ! whereas tile_start_x_topo is only required to open the correct topo tiles from disk + if (box_x > topo_shift) then + tile_start_x_topo = floor( real(box_x - topo_shift - 1) / real(tile_x)) * tile_x + 1 + else + tile_start_x_topo = floor( real(box_x + topo_shift - 1) / real(tile_x)) * tile_x + 1 + end if + tile_start_x = floor( real(box_x - 1) / real(tile_x)) * tile_x + 1 + tile_start_y = floor( real(box_y - 1) / real(tile_y)) * tile_y + 1 + + ! First check if the last tile contains the requested pixel + if (associated(last_tile)) then + if (last_tile%tile_start_x==tile_start_x .and. last_tile%tile_start_y==tile_start_y) then + thisTile => last_tile + return + end if + end if + + thisTile => tilesHead + ! Loop over all tiles in the list + do while (associated(thisTile)) + + if (thisTile%tile_start_x==tile_start_x .and. thisTile%tile_start_y==tile_start_y) then + exit + end if + + thisTile => thisTile % next + + end do ! associated(thisTile) + + ! Could not find such a tile, so we add the tile to the front of the linked list + if (.not. associated(thisTile)) then + thisTile => add_tile(tilesHead, tile_start_x, tile_start_y, tile_start_x_topo, path, sub_path) + end if + + end function get_tile_from_box_point + + + !*********************************************************************** + ! + ! function add_tile + ! + !> \brief Routine to read in a new topo and landuse tile, and add + !> these tiles to the head of the linked list tilesHead + !> \author Abishek Gopal + !> \date 05 Sep 2024 + !> \details + !> Routine to read in a new topo and landuse tile, given the tile + ! coordinates + !----------------------------------------------------------------------- + function add_tile(tilesHead, tile_start_x, tile_start_y, tile_start_x_topo, path, sub_path) result(newTile) + + implicit none + + type(mpas_gwd_tile_type), pointer, intent(inout) :: tilesHead + integer, intent(in) :: tile_start_x, tile_start_y, tile_start_x_topo + character(len=*), intent(in) :: path + character(len=*), intent(in) :: sub_path + + type(mpas_gwd_tile_type), pointer :: newTile + + integer :: iErr + + allocate(newTile) + allocate(newTile%topo_array(tile_x,tile_y)) + allocate(newTile%landuse_array(tile_x,tile_y)) + newTile%tile_start_x = tile_start_x + newTile%tile_start_y = tile_start_y + newTile%next => tilesHead + + iErr = read_30s_topo_tile(path, sub_path, newTile%topo_array, tile_start_x_topo, newTile%tile_start_y) + if (iErr /= 0) then + call mpas_log_write('Error reading global 30-arc-sec topography for GWD statistics', messageType=MPAS_LOG_ERR) + return + end if + + iErr = read_30s_landuse_tile(path, newTile%landuse_array, newTile%tile_start_x, newTile%tile_start_y) + if (iErr /= 0) then + call mpas_log_write('Error reading global 30-arc-sec landuse for GWD statistics', messageType=MPAS_LOG_ERR) + return + end if + + tilesHead => newTile + + end function add_tile + + + !*********************************************************************** + ! + ! function free_tile_list + ! + !> \brief Routine to deallocate all tiles in the list + !> \author Abishek Gopal + !> \date 05 Sep 2024 + !> \details + !> Routine to deallocate all tiles in the list + ! + !----------------------------------------------------------------------- + function free_tile_list(tilesHead) result(iErr) + + implicit none + + type(mpas_gwd_tile_type), pointer, intent(inout) :: tilesHead + + integer :: iErr + + type(mpas_gwd_tile_type), pointer :: thisTile + + ! loop over tiles + do while (associated(tilesHead)) + thisTile => tilesHead + tilesHead => thisTile % next + deallocate(thisTile%topo_array) + deallocate(thisTile%landuse_array) + deallocate(thisTile) + end do ! associated(thisTile) + + iErr = 0 + + end function free_tile_list + + + !*********************************************************************** + ! + ! function read_30s_topo_tile + ! + !> \brief Reads a single tile of the global 30-arc-second topography into memory !> \author Michael Duda !> \date 28 August 2017 !> \details - !> This subroutine reads the global 30-arc-second topography from the subdirectory + !> This subroutine reads a single tile of the global 30-arc-second topography from the subdirectory !> identified by the 'sub_path' argument within the 'path' provided as the first argument. ! !----------------------------------------------------------------------- - function read_global_30s_topo(path, sub_path) result(iErr) + function read_30s_topo_tile(path, sub_path, topo, tile_start_x, tile_start_y) result(iErr) implicit none character(len=*), intent(in) :: path character(len=*), intent(in) :: sub_path + real(kind=R4KIND), dimension(:,:), pointer, intent(inout) :: topo + integer, intent(in) :: tile_start_x + integer, intent(in) :: tile_start_y integer :: iErr - integer, parameter :: tile_x = 1200 ! x-dimension of each tile of global 30-arc-second topography 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 (c_int) :: istatus - integer :: ix, iy, ishift, ix_shift + integer :: ix, iy integer (c_int) :: isigned, endian, wordsize, nx, ny, nz real (c_float) :: scalefactor real (c_float), dimension(:,:,:), pointer, contiguous :: tile @@ -360,68 +567,53 @@ function read_global_30s_topo(path, sub_path) result(iErr) ny = tile_y + 2*tile_bdr nz = 1 - ishift = 0 - - ! - ! For GMTED2010 data, the dataset starts at 0.0 longitude, but we need to shift the starting location - ! in the topo array to -180.0, so we introduce an offset in the x-coordinate of topo_x/2 - ! - if (trim(sub_path) == 'topo_gmted2010_30s/') then - ishift = topo_x / 2 + iy = tile_start_y + ix = tile_start_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 mpas_f_to_c_string(filename, c_filename) + call read_geogrid(c_filename, tile_ptr, nx, ny, nz, isigned, endian, & + wordsize, istatus) + tile(:,:,:) = tile(:,:,:) * scalefactor + if (istatus /= 0) then + call mpas_log_write('Error reading topography tile '//trim(filename), messageType=MPAS_LOG_ERR) + iErr = 1 + return end if - - do iy=1,topo_y,tile_y - 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 mpas_f_to_c_string(filename, c_filename) - call read_geogrid(c_filename, tile_ptr, nx, ny, nz, isigned, endian, & - wordsize, istatus) - tile(:,:,:) = tile(:,:,:) * scalefactor - if (istatus /= 0) then - call mpas_log_write('Error reading topography tile '//trim(filename), messageType=MPAS_LOG_ERR) - iErr = 1 - return - end if - - ix_shift = mod((ix-1) + ishift, topo_x) + 1 - topo(ix_shift:(ix_shift+tile_x-1),iy:(iy+tile_y-1)) = tile((tile_bdr+1):(tile_x+tile_bdr),(tile_bdr+1):(tile_y+tile_bdr),1) - - end do - end do + + topo = tile((tile_bdr+1):(tile_x+tile_bdr),(tile_bdr+1):(tile_y+tile_bdr),1) deallocate(tile) iErr = 0 - end function read_global_30s_topo + end function read_30s_topo_tile !*********************************************************************** ! - ! function read_global_30s_landuse + ! function read_30s_landuse_tile ! - !> \brief Reads global 30-arc-second landuse into 'landuse' module variable + !> \brief Reads a single tile of the global 30-arc-second landuse into memory !> \author Michael Duda !> \date 14 March 2017 !> \details - !> This subroutine reads the global 30-arc-second USGS landuse from - !> the subdirectory 'landuse_30s' of the path provided as an argument. + !> This subroutine reads the a single tile of global 30-arc-second USGS landuse + !> from the subdirectory 'landuse_30s' of the path provided as an argument. ! !----------------------------------------------------------------------- - function read_global_30s_landuse(path) result(iErr) + function read_30s_landuse_tile(path, landuse, tile_start_x, tile_start_y) result(iErr) implicit none character(len=*), intent(in) :: path - + integer (kind=I1KIND), dimension(:,:), pointer, intent(inout) :: landuse + integer, intent(in) :: tile_start_x + integer, intent(in) :: tile_start_y + integer :: 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 (c_int) :: istatus - integer :: ix, iy integer (c_int) :: isigned, endian, wordsize, nx, ny, nz real (c_float) :: scalefactor real (c_float), dimension(:,:,:), pointer, contiguous :: tile @@ -440,30 +632,25 @@ function read_global_30s_landuse(path) result(iErr) ny = tile_y nz = 1 - do iy=1,topo_y,tile_y - 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 mpas_f_to_c_string(filename, c_filename) - call read_geogrid(c_filename, tile_ptr, nx, ny, nz, isigned, endian, & - wordsize, istatus) - tile(:,:,:) = tile(:,:,:) * scalefactor - if (istatus /= 0) then - call mpas_log_write('Error reading landuse tile '//trim(filename)) - iErr = 1 - return - end if - - landuse(ix:(ix+tile_x-1),iy:(iy+tile_y-1)) = int(tile(1:tile_x,1:tile_y,1), kind=I1KIND) - - end do - end do + write(filename,'(a,i5.5,a1,i5.5,a1,i5.5,a1,i5.5)') trim(path)//'/landuse_30s/', tile_start_x, '-', (tile_start_x+tile_x-1), '.', & + tile_start_y, '-', (tile_start_y+tile_y-1) + call mpas_f_to_c_string(filename, c_filename) + call read_geogrid(c_filename, tile_ptr, nx, ny, nz, isigned, endian, & + wordsize, istatus) + tile(:,:,:) = tile(:,:,:) * scalefactor + if (istatus /= 0) then + call mpas_log_write('Error reading landuse tile '//trim(filename)) + iErr = 1 + return + end if + + landuse = int(tile(:,:,1), kind=I1KIND) deallocate(tile) iErr = 0 - end function read_global_30s_landuse + end function read_30s_landuse_tile !*********************************************************************** @@ -476,10 +663,13 @@ end function read_global_30s_landuse !> \details 1 = land, 0 = water ! !----------------------------------------------------------------------- - integer (kind=I1KIND) function get_dom_landmask( ) + integer (kind=I1KIND) function get_dom_landmask(box_landuse, nx, ny) implicit none + integer (kind=I1KIND), dimension(:,:), pointer, intent(in) :: box_landuse ! Subset of landuse covering a grid cell + integer, intent(in) :: nx, ny + integer :: i, j real (kind=RKIND) :: xland xland = 0.0_RKIND @@ -508,8 +698,8 @@ end function get_dom_landmask ! subroutine get_box ! !> \brief Cuts out a rectangular box of data centered at a given (lat,lon) - !> \author Michael Duda - !> \date 29 May 2015 + !> \author Michael Duda, Abishek Gopal + !> \date Sep 2024 !> \details !> This subroutine extracts a rectangular sub-array of the 30-arc-second !> global topography dataset, stored in the module variable 'topo'; the @@ -523,30 +713,37 @@ end function get_dom_landmask !> this subroutine and stored in the module variable 'box_mean'. ! !----------------------------------------------------------------------- - subroutine get_box(lat, lon, dx) + subroutine get_box(lat, lon, nx, ny, path, sub_path, tilesHead, box, box_landuse, dxm, box_mean) implicit none - real (kind=RKIND), intent(in) :: lat, lon, dx - - integer :: i, j, ii, jj, ic, jc + real (kind=RKIND), intent(in) :: lat, lon + integer, intent(in) :: nx, ny + character(len=*), intent(in) :: path + character(len=*), intent(in) :: sub_path + type(mpas_gwd_tile_type), pointer, intent(inout) :: tilesHead + real (kind=RKIND), dimension(:,:), pointer :: box ! Subset of topography covering a grid cell + integer (kind=I1KIND), dimension(:,:), pointer :: box_landuse ! Subset of landuse covering a grid cell + real (kind=RKIND), dimension(:,:), pointer :: dxm ! Size (meters) in zonal direction of a grid cell + real (kind=RKIND), intent(inout) :: box_mean ! Mean value of topography in box + + type(mpas_gwd_tile_type), pointer :: thisTile + type(mpas_gwd_tile_type), pointer :: lastTile + integer :: i, j, ii, jj, ic, jc, ix, jx real (kind=RKIND) :: sg_lat + thisTile => null() + lastTile => null() - ! - ! Get number of points to extract in the zonal direction - ! - if (cos(lat/rad2deg) > (2.0 * pts_per_degree * dx * 180.0) / (real(topo_x,RKIND) * Pi * Re)) then - nx = ceiling((180.0 * dx * pts_per_degree) / (Pi * Re * cos(lat/rad2deg))) - else - nx = topo_x / 2 - end if + if (associated(box)) deallocate(box) + allocate(box(nx,ny)) + + if (associated(box_landuse)) deallocate(box_landuse) + allocate(box_landuse(nx,ny)) + if (associated(dxm)) deallocate(dxm) + allocate(dxm(nx,ny)) ! - ! Get number of points to extract in the meridional direction - ! - ny = ceiling((180.0 * dx * pts_per_degree) / (Pi * Re)) - ! ! Find coordinates in global topography array of the box center ! @@ -556,16 +753,6 @@ subroutine get_box(lat, lon, dx) if (ic <= 0) ic = ic + topo_x if (ic > topo_x) ic = ic - topo_x - - if (associated(box)) deallocate(box) - allocate(box(nx,ny)) - - if (associated(box_landuse)) deallocate(box_landuse) - allocate(box_landuse(nx,ny)) - - if (associated(dxm)) deallocate(dxm) - allocate(dxm(nx,ny)) - ! ! Extract sub-array (box) from global array; must properly account for ! the periodicity in the longitude coordinate, as well as the poles @@ -591,9 +778,17 @@ subroutine get_box(lat, lon, dx) do while (ii > topo_x) ii = ii - topo_x end do - - box(i,j) = topo(ii,jj) - box_landuse(i,j) = landuse(ii,jj) + + ! Obtain tile for given box pixel from the linked list of tiles (tilesHead), + ! which would involve reading in the data from disk if said tile is not already in memory + thisTile => get_tile_from_box_point(tilesHead, ii, jj, path, sub_path, lastTile) + ! Save the current tile to possibly speed up the next lookup + lastTile => thisTile + + ix = (ii - thisTile%tile_start_x) + 1 + jx = (jj - thisTile%tile_start_y) + 1 + box(i,j) = thisTile%topo_array(ix, jx) + box_landuse(i,j) = thisTile%landuse_array(ix, jx) sg_lat = (start_lat + (real(jj-1,RKIND) + 0.5) / pts_per_degree) / rad2deg ! Add 0.5 for cell center dxm(i,j) = sg_delta * cos(sg_lat) box_mean = box_mean + box(i,j) @@ -620,10 +815,14 @@ end subroutine get_box !> \details ! !----------------------------------------------------------------------- - real (kind=RKIND) function get_var() + real (kind=RKIND) function get_var(box, box_mean, nx, ny) implicit none + real (kind=RKIND), dimension(:,:), pointer, intent(in) :: box ! Subset of topography covering a grid cell + real (kind=RKIND), intent(in) :: box_mean + integer, intent(in) :: nx, ny + integer :: i, j real (kind=RKIND) :: s2 @@ -650,10 +849,15 @@ end function get_var !> \details ! !----------------------------------------------------------------------- - real (kind=RKIND) function get_con() + real (kind=RKIND) function get_con(box, box_landuse, box_mean, nx, ny) implicit none + real (kind=RKIND), dimension(:,:), pointer, intent(in) :: box ! Subset of topography covering a grid cell + integer (kind=I1KIND), dimension(:,:), pointer, intent(in) :: box_landuse ! Subset of landuse covering a grid cell + real (kind=RKIND), intent(in) :: box_mean + integer, intent(in) :: nx, ny + integer :: i, j real (kind=RKIND) :: s2, s4, var, xland, mean_land, mean_water, oro @@ -727,10 +931,14 @@ end function get_con !> the comment from N. Wood in the footnote of Kim and Doyle (QRJMS, 2005). ! !----------------------------------------------------------------------- - real (kind=RKIND) function get_oa1() + real (kind=RKIND) function get_oa1(box, box_mean, nx, ny) implicit none + real (kind=RKIND), dimension(:,:), pointer, intent(in) :: box ! Subset of topography covering a grid cell + real (kind=RKIND), intent(in) :: box_mean + integer, intent(in) :: nx, ny + integer :: i, j integer :: nu, nd @@ -766,10 +974,14 @@ end function get_oa1 !> the comment from N. Wood in the footnote of Kim and Doyle (QRJMS, 2005). ! !----------------------------------------------------------------------- - real (kind=RKIND) function get_oa2() + real (kind=RKIND) function get_oa2(box, box_mean, nx, ny) implicit none + real (kind=RKIND), dimension(:,:), pointer, intent(in) :: box ! Subset of topography covering a grid cell + real (kind=RKIND), intent(in) :: box_mean + integer, intent(in) :: nx, ny + integer :: i, j integer :: nu, nd @@ -807,10 +1019,14 @@ end function get_oa2 !> the comment from N. Wood in the footnote of Kim and Doyle (QRJMS, 2005). ! !----------------------------------------------------------------------- - real (kind=RKIND) function get_oa3() + real (kind=RKIND) function get_oa3(box, box_mean, nx, ny) implicit none + real (kind=RKIND), dimension(:,:), pointer, intent(in) :: box ! Subset of topography covering a grid cell + real (kind=RKIND), intent(in) :: box_mean + integer, intent(in) :: nx, ny + integer :: i, j integer :: nu, nd real (kind=RKIND) :: ratio @@ -849,10 +1065,14 @@ end function get_oa3 !> the comment from N. Wood in the footnote of Kim and Doyle (QRJMS, 2005). ! !----------------------------------------------------------------------- - real (kind=RKIND) function get_oa4() + real (kind=RKIND) function get_oa4(box, box_mean, nx, ny) implicit none + real (kind=RKIND), dimension(:,:), pointer, intent(in) :: box ! Subset of topography covering a grid cell + real (kind=RKIND), intent(in) :: box_mean + integer, intent(in) :: nx, ny + integer :: i, j integer :: nu, nd real (kind=RKIND) :: ratio @@ -889,10 +1109,13 @@ end function get_oa4 !> \details ! !----------------------------------------------------------------------- - real (kind=RKIND) function get_ol1() + real (kind=RKIND) function get_ol1(box, nx, ny) implicit none + real (kind=RKIND), dimension(:,:), pointer, intent(in) :: box ! Subset of topography covering a grid cell + integer, intent(in) :: nx, ny + integer :: i, j integer :: nw integer :: nt @@ -922,10 +1145,13 @@ end function get_ol1 !> \details ! !----------------------------------------------------------------------- - real (kind=RKIND) function get_ol2() + real (kind=RKIND) function get_ol2(box, nx, ny) implicit none + real (kind=RKIND), dimension(:,:), pointer, intent(in) :: box ! Subset of topography covering a grid cell + integer, intent(in) :: nx, ny + integer :: i, j integer :: nw integer :: nt @@ -955,10 +1181,13 @@ end function get_ol2 !> \details ! !----------------------------------------------------------------------- - real (kind=RKIND) function get_ol3() + real (kind=RKIND) function get_ol3(box, nx, ny) implicit none + real (kind=RKIND), dimension(:,:), pointer, intent(in) :: box ! Subset of topography covering a grid cell + integer, intent(in) :: nx, ny + integer :: i, j integer :: nw integer :: nt @@ -994,10 +1223,13 @@ end function get_ol3 !> \details ! !----------------------------------------------------------------------- - real (kind=RKIND) function get_ol4() + real (kind=RKIND) function get_ol4(box, nx, ny) implicit none + real (kind=RKIND), dimension(:,:), pointer, intent(in) :: box ! Subset of topography covering a grid cell + integer, intent(in) :: nx, ny + integer :: i, j integer :: nw integer :: nt @@ -1033,10 +1265,13 @@ end function get_ol4 !> \details ! !----------------------------------------------------------------------- - real (kind=RKIND) function get_elvmax() + real (kind=RKIND) function get_elvmax(box, nx, ny) implicit none + real (kind=RKIND), dimension(:,:), pointer, intent(in) :: box ! Subset of topography covering a grid cell + integer, intent(in) :: nx, ny + integer :: i, j get_elvmax = box(1,1) @@ -1062,10 +1297,14 @@ end function get_elvmax !> \details Computation following Lott and Miller (QJRMS 1997) ! !----------------------------------------------------------------------- - real (kind=RKIND) function get_htheta() + real (kind=RKIND) function get_htheta(box, dxm, nx, ny) implicit none + real (kind=RKIND), dimension(:,:), pointer, intent(in) :: box ! Subset of topography covering a grid cell + real (kind=RKIND), dimension(:,:), pointer, intent(in) :: dxm ! Size (meters) in zonal direction of a grid cell + integer, intent(in) :: nx, ny + integer :: i, j real (kind=RKIND) :: dx, dy real (kind=RKIND) :: xfp, yfp @@ -1110,10 +1349,14 @@ end function get_htheta !> \details Computation following Lott and Miller (QJRMS 1997) ! !----------------------------------------------------------------------- - real (kind=RKIND) function get_hgamma() + real (kind=RKIND) function get_hgamma(box, dxm, nx, ny) implicit none + real (kind=RKIND), dimension(:,:), pointer, intent(in) :: box ! Subset of topography covering a grid cell + real (kind=RKIND), dimension(:,:), pointer, intent(in) :: dxm ! Size (meters) in zonal direction of a grid cell + integer, intent(in) :: nx, ny + integer :: i, j real (kind=RKIND) :: dx, dy real (kind=RKIND) :: xfp, yfp @@ -1163,10 +1406,14 @@ end function get_hgamma !> \details Computation following Lott and Miller (QJRMS 1997) ! !----------------------------------------------------------------------- - real (kind=RKIND) function get_hsigma() + real (kind=RKIND) function get_hsigma(box, dxm, nx, ny) implicit none + real (kind=RKIND), dimension(:,:), pointer, intent(in) :: box ! Subset of topography covering a grid cell + real (kind=RKIND), dimension(:,:), pointer, intent(in) :: dxm ! Size (meters) in zonal direction of a grid cell + integer, intent(in) :: nx, ny + integer :: i, j real (kind=RKIND) :: dx, dy real (kind=RKIND) :: xfp, yfp diff --git a/src/core_init_atmosphere/mpas_init_atm_gwd_gsl.F b/src/core_init_atmosphere/mpas_init_atm_gwd_gsl.F new file mode 100644 index 000000000..011d98139 --- /dev/null +++ b/src/core_init_atmosphere/mpas_init_atm_gwd_gsl.F @@ -0,0 +1,205 @@ +! Module mpas_init_atm_gwd_gsl +! +! This program calls subroutines which calculate the parameters +! required for the GSL subgrid-scale orographic gravity-wave drag (GWDO) +! suite on the MPAS mesh. These parameters are for the small-scale +! GWD (Tsiringakis et al., 2017) and turbulent orographic form drag (TOFD) +! (Beljaars et al., 2004) schemes of the GSL drag suite. +! The output fields are: +! - stddev standard deviation of subgrid-scale topograpy +! - convexity convexity (kurtosis) of subgrid-scale topography +! - ol{1,2,3,4} orographic effective lengths of subgrid-scale topography +! for 4 orientations: 1-westerly, 2-southerly, 3-southwesterly, 4-northwesterly +! - oa{1,2,3,4} orographic asymmetries of subgrid-scale topography +! for 4 orientations: 1-westerly, 2-southerly, 3-southwesterly, 4-northwesterly +! +! Based on code by Michael Duda provided by NCAR/MMM +! +! Brief description of program: Creates orographic (oro_data) files +! needed by the GSL drag suite physics parameterization +! +! Author: Michael Toy, NOAA/GSL +! +module mpas_init_atm_gwd_gsl + + use mpas_gsl_oro_data_sm_scale, only: calc_gsl_oro_data_sm_scale + use mpas_gsl_oro_data_lg_scale, only: calc_gsl_oro_data_lg_scale + + 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 :: calc_gsl_oro_data + + private + + integer, parameter :: I1KIND = selected_int_kind(2) + + + contains + + + subroutine calc_gsl_oro_data(domain,iErr) + + use mpas_derived_types + use mpas_kind_types + use mpas_timer + use mpas_stream_manager + + implicit none + + type (domain_type), intent(inout) :: domain + integer, intent(inout) :: iErr + + type (mpas_pool_type), pointer :: mesh, state + integer :: iCell, i + real (kind=RKIND) :: dc + real (kind=RKIND), dimension(:), allocatable :: areaCell + real (kind=RKIND), pointer :: config_gwd_cell_scaling + integer, pointer :: nCells + integer, pointer :: nEdges + integer, dimension(:), pointer :: nEdgesOnCell + integer, dimension(:,:), pointer :: edgesOnCell + logical :: onUnitSphere + real (kind=RKIND), pointer :: sphere_radius + real (kind=RKIND), dimension(:), pointer :: latCell, lonCell, dcEdge + real (kind=RKIND), dimension(:), pointer :: var2dls, conls, oa1ls, oa2ls, oa3ls, oa4ls, & + ol1ls, ol2ls, ol3ls, ol4ls + real (kind=RKIND), dimension(:), pointer :: var2dss, conss, oa1ss, oa2ss, oa3ss, oa4ss, & + ol1ss, ol2ss, ol3ss, ol4ss + character(len=StrKIND), pointer :: config_geog_data_path + character(len=StrKIND) :: geog_sub_path + character(len=StrKIND+1) :: geog_data_path ! same as config_geog_data_path, but guaranteed to have a trailing slash + real (kind=RKIND), parameter :: Re = 6371229.0_RKIND ! Earth radius in MPAS-Atmosphere + + logical, dimension(:), allocatable :: duplicate_oro_data ! flag for whether large-scale topographic + ! statistics are duplicated from small-scale values due to grid + ! size being less than 7.5km, i.e., not having enough 2.5 minute + ! topographic points within a grid box + + call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', mesh) + call mpas_pool_get_subpool(domain % blocklist % structs, 'state', state) + + call mpas_pool_get_config(mesh, 'sphere_radius', sphere_radius) + call mpas_pool_get_config(domain % configs, 'config_gwd_cell_scaling', config_gwd_cell_scaling) + + ! + ! Retrieve pointers to arrays holding the latitudes and longitudes of cells, + ! and arrays that will hold the computed GWDO statistics + ! + call mpas_pool_get_dimension(mesh, 'nCells', nCells) + call mpas_pool_get_dimension(mesh, 'nEdges', nEdges) + call mpas_pool_get_array(mesh, 'latCell', latCell) + call mpas_pool_get_array(mesh, 'lonCell', lonCell) + call mpas_pool_get_array(mesh, 'nEdgesOnCell', nEdgesOnCell) + call mpas_pool_get_array(mesh, 'edgesOnCell', edgesOnCell) + call mpas_pool_get_array(mesh, 'dcEdge', dcEdge) + call mpas_pool_get_array(mesh, 'var2dls', var2dls) + call mpas_pool_get_array(mesh, 'conls', conls) + call mpas_pool_get_array(mesh, 'ol1ls', ol1ls) + call mpas_pool_get_array(mesh, 'ol2ls', ol2ls) + call mpas_pool_get_array(mesh, 'ol3ls', ol3ls) + call mpas_pool_get_array(mesh, 'ol4ls', ol4ls) + call mpas_pool_get_array(mesh, 'oa1ls', oa1ls) + call mpas_pool_get_array(mesh, 'oa2ls', oa2ls) + call mpas_pool_get_array(mesh, 'oa3ls', oa3ls) + call mpas_pool_get_array(mesh, 'oa4ls', oa4ls) + call mpas_pool_get_array(mesh, 'var2dss', var2dss) + call mpas_pool_get_array(mesh, 'conss', conss) + call mpas_pool_get_array(mesh, 'ol1ss', ol1ss) + call mpas_pool_get_array(mesh, 'ol2ss', ol2ss) + call mpas_pool_get_array(mesh, 'ol3ss', ol3ss) + call mpas_pool_get_array(mesh, 'ol4ss', ol4ss) + call mpas_pool_get_array(mesh, 'oa1ss', oa1ss) + call mpas_pool_get_array(mesh, 'oa2ss', oa2ss) + call mpas_pool_get_array(mesh, 'oa3ss', oa3ss) + call mpas_pool_get_array(mesh, 'oa4ss', oa4ss) + + + ! + ! It is possible that this code is called before the mesh fields have been scaled + ! up to "Earth-sized". Because we need "Earth" distances to cut out bounding + ! boxes from topography, we try here to detect whether we are on an unscaled + ! unit sphere or not: if the maximum dcEdge value is less than 1.0, assume this + ! is the case. + ! + if (maxval(dcEdge(1:nEdges)) < 1.0_RKIND) then + call mpas_log_write('Computing GSL GWD statistics on a unit sphere') + onUnitSphere = .true. + else + onUnitSphere = .false. + end if + + if (config_gwd_cell_scaling /= 1.0) then + call mpas_log_write('Using effective cell diameters scaled by a factor of $r', realArgs=(/config_gwd_cell_scaling/)) + call mpas_log_write('in the computation of GWD static fields.') + end if + + allocate(areaCell(nCells)) + allocate(duplicate_oro_data(nCells)) + + ! + ! Loop to compute approximate area of each MPAS horizontal grid cell + ! + do iCell=1,nCells + + ! + ! First, get an estimate of the mean diameter (in meters) of the grid + ! cell by averaging the distances to each of the neighboring cells + ! + dc = 0.0 + do i=1,nEdgesOnCell(iCell) + dc = dc + dcEdge(edgesOnCell(i,iCell)) + end do + dc = dc / real(nEdgesOnCell(iCell),RKIND) + if (onUnitSphere) then + dc = dc * sphere_radius + end if + dc = dc * config_gwd_cell_scaling + + ! Assume square shape with MPAS grid cell diameter as length of sides + areaCell(iCell) = dc*dc + + end do + + call calc_gsl_oro_data_sm_scale(nCells,latCell,lonCell,areaCell,Re, & + var2dss,conss,oa1ss,oa2ss,oa3ss,oa4ss, & + ol1ss,ol2ss,ol3ss,ol4ss, & + domain,duplicate_oro_data) + + call calc_gsl_oro_data_lg_scale(nCells,latCell,lonCell,areaCell,Re, & + var2dls,conls,oa1ls,oa2ls,oa3ls,oa4ls, & + ol1ls,ol2ls,ol3ls,ol4ls,domain, & + duplicate_oro_data) + + do iCell=1,nCells + ! Re-assign large-scale statistics with small-scale values if necessary + if ( duplicate_oro_data(iCell) ) then + var2dls(iCell) = var2dss(iCell) + conls(iCell) = conss(iCell) + oa1ls(iCell) = oa1ss(iCell) + oa2ls(iCell) = oa2ss(iCell) + oa3ls(iCell) = oa3ss(iCell) + oa4ls(iCell) = oa4ss(iCell) + ol1ls(iCell) = ol1ss(iCell) + ol2ls(iCell) = ol2ss(iCell) + ol3ls(iCell) = ol3ss(iCell) + ol4ls(iCell) = ol4ss(iCell) + endif + end do + + deallocate(areaCell) + deallocate(duplicate_oro_data) + + call mpas_log_write('End module mpas_init_atm_gwd_gsl') + + iErr = 0 + + return + end subroutine calc_gsl_oro_data + +end module mpas_init_atm_gwd_gsl diff --git a/src/core_init_atmosphere/mpas_init_atm_llxy.F b/src/core_init_atmosphere/mpas_init_atm_llxy.F index 6558fa861..d569701b2 100644 --- a/src/core_init_atmosphere/mpas_init_atm_llxy.F +++ b/src/core_init_atmosphere/mpas_init_atm_llxy.F @@ -140,6 +140,7 @@ MODULE init_atm_llxy USE MPAS_DERIVED_TYPES, ONLY : MPAS_LOG_ERR, MPAS_LOG_CRIT USE MPAS_KIND_TYPES USE MPAS_LOG, ONLY : MPAS_LOG_WRITE + USE ISO_FORTRAN_ENV, ONLY: REAL64 INTEGER, PARAMETER :: HH=4, VV=5 @@ -171,8 +172,6 @@ MODULE init_atm_llxy INTEGER, PUBLIC, PARAMETER :: PROJ_ALBERS_NAD83 = 105 INTEGER, PUBLIC, PARAMETER :: PROJ_ROTLL = 203 - ! Define some private constants - INTEGER, PRIVATE, PARAMETER :: HIGH = 8 TYPE proj_info @@ -1679,10 +1678,10 @@ SUBROUTINE llij_rotlatlon(lat, lon, proj, i_real, j_real) ! Local variables INTEGER :: ii,imt,jj,jmt,ncol,nrow - REAL(KIND=HIGH) :: dphd,dlmd !Grid increments, degrees - REAL(KIND=HIGH) :: glatd !Geographic latitude, positive north - REAL(KIND=HIGH) :: glond !Geographic longitude, positive west - REAL(KIND=HIGH) :: col,d1,d2,d2r,dlm,dlm1,dlm2,dph,glat,glon, & + REAL(KIND=REAL64) :: dphd,dlmd !Grid increments, degrees + REAL(KIND=REAL64) :: glatd !Geographic latitude, positive north + REAL(KIND=REAL64) :: glond !Geographic longitude, positive west + REAL(KIND=REAL64) :: col,d1,d2,d2r,dlm,dlm1,dlm2,dph,glat,glon, & pi,r2d,row,tlat,tlat1,tlat2, & tlon,tlon1,tlon2,tph0,tlm0,x,y,z @@ -1852,7 +1851,7 @@ SUBROUTINE ijll_rotlatlon(i, j, proj, lat,lon) INTEGER :: midcol,midrow REAL (KIND=RKIND) :: i_work, j_work REAL (KIND=RKIND) :: dphd,dlmd !Grid increments, degrees - REAL(KIND=HIGH) :: arg1,arg2,d2r,fctr,glatr,glatd,glond,pi, & + REAL(KIND=REAL64) :: arg1,arg2,d2r,fctr,glatr,glatd,glond,pi, & r2d,tlatd,tlond,tlatr,tlonr,tlm0,tph0 REAL (KIND=RKIND) :: col @@ -1959,14 +1958,14 @@ SUBROUTINE gausll ( nlat , lat_sp ) IMPLICIT NONE INTEGER :: nlat , i - REAL (KIND=HIGH) , PARAMETER :: pi = 3.141592653589793 - REAL (KIND=HIGH) , DIMENSION(nlat) :: cosc , gwt , sinc , colat , wos2 , lat + REAL (KIND=REAL64) , PARAMETER :: pi = 3.141592653589793 + REAL (KIND=REAL64) , DIMENSION(nlat) :: cosc , gwt , sinc , colat , wos2 , lat REAL (KIND=RKIND) , DIMENSION(nlat) :: lat_sp CALL lggaus(nlat, cosc, gwt, sinc, colat, wos2) DO i = 1, nlat - lat(i) = ACOS(sinc(i)) * 180._HIGH / pi + lat(i) = ACOS(sinc(i)) * 180._REAL64 / pi IF (i.gt.nlat/2) lat(i) = -lat(i) END DO @@ -1993,15 +1992,15 @@ SUBROUTINE lggaus( nlat, cosc, gwt, sinc, colat, wos2 ) ! COLAT - the colatitudes in radians ! WOS2 - Gaussian weight over sin**2(colatitude) - REAL (KIND=HIGH) , DIMENSION(nlat) :: cosc , gwt , sinc , colat , wos2 - REAL (KIND=HIGH) , PARAMETER :: pi = 3.141592653589793 + REAL (KIND=REAL64) , DIMENSION(nlat) :: cosc , gwt , sinc , colat , wos2 + REAL (KIND=REAL64) , PARAMETER :: pi = 3.141592653589793 ! Convergence criterion for iteration of cos latitude REAL (KIND=RKIND) , PARAMETER :: xlim = 1.0E-14 INTEGER :: nzero, i, j - REAL (KIND=HIGH) :: fi, fi1, a, b, g, gm, gp, gt, delta, c, d + REAL (KIND=REAL64) :: fi, fi1, a, b, g, gm, gp, gt, delta, c, d ! The number of zeros between pole and equator @@ -2108,14 +2107,14 @@ SUBROUTINE lgord( f, cosc, n ) ! f - the value of the Legendre polynomial of degree N at ! latitude ASIN(cosc) - REAL (KIND=HIGH) :: s1, c4, a, b, fk, f, cosc, colat, c1, fn, ang + REAL (KIND=REAL64) :: s1, c4, a, b, fk, f, cosc, colat, c1, fn, ang INTEGER :: n, k ! Determine the colatitude colat = ACOS(cosc) - c1 = SQRT(2.0_HIGH) + c1 = SQRT(2.0_REAL64) DO k=1,n c1 = c1 * SQRT( 1.0 - 1.0/(4*k*k) ) END DO diff --git a/src/core_init_atmosphere/mpas_init_atm_read_met.F b/src/core_init_atmosphere/mpas_init_atm_read_met.F index 45cd3121b..69c662766 100644 --- a/src/core_init_atmosphere/mpas_init_atm_read_met.F +++ b/src/core_init_atmosphere/mpas_init_atm_read_met.F @@ -9,9 +9,11 @@ module init_atm_read_met + use iso_fortran_env, only: real32 + integer, parameter :: MAX_FILENAME_LEN = 1024 - real (kind=4), parameter :: EARTH_RADIUS_M = 6370000. ! same as MM5 system + real (kind=real32), parameter :: EARTH_RADIUS_M = 6370000. ! same as MM5 system ! Projection codes for proj_info structure: INTEGER, PRIVATE, PARAMETER :: PROJ_LATLON = 0 @@ -24,10 +26,10 @@ module init_atm_read_met ! Derived types type met_data integer :: version, nx, ny, iproj - real (kind=4) :: xfcst, xlvl, startlat, startlon, starti, startj, & + real (kind=real32) :: xfcst, xlvl, startlat, startlon, starti, startj, & deltalat, deltalon, dx, dy, xlonc, & truelat1, truelat2, earth_radius - real (kind=4), pointer, dimension(:,:) :: slab + real (kind=real32), pointer, dimension(:,:) :: slab logical :: is_wind_grid_rel character (len=9) :: field character (len=24) :: hdate diff --git a/src/core_init_atmosphere/mpas_init_atm_static.F b/src/core_init_atmosphere/mpas_init_atm_static.F index a4686f7ce..0c540094d 100644 --- a/src/core_init_atmosphere/mpas_init_atm_static.F +++ b/src/core_init_atmosphere/mpas_init_atm_static.F @@ -89,11 +89,14 @@ end subroutine interp_accumulation_function ! use module level variables for now... ! integer (kind=I8KIND), dimension(:), pointer :: ter_integer + integer (kind=I8KIND), dimension(:,:), pointer :: soilcomp_int + real (kind=RKIND) :: soilcomp_msgval = 255.0_RKIND ! Modified later based on index file for soilcomp integer, dimension(:), pointer :: lu_index integer, dimension(:), pointer :: soilcat_top integer, dimension(:), pointer :: nhs integer, dimension(:,:), allocatable:: ncat - ! Landmask is used by the accumulation function for maxsnoalb so it needs to be a global variable + ! Landmask is used by the accumulation function for maxsnoalb and soilcomp, + ! so it needs to be a global variable integer, dimension(:), pointer :: landmask integer, pointer :: category_min @@ -123,6 +126,8 @@ subroutine init_atm_static(mesh, dims, configs) character(len=StrKIND), pointer :: config_vegfrac_data character(len=StrKIND), pointer :: config_albedo_data character(len=StrKIND), pointer :: config_maxsnowalbedo_data + logical, pointer :: config_noahmp_static + character(len=StrKIND), pointer :: config_soilcat_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 @@ -140,6 +145,7 @@ subroutine init_atm_static(mesh, dims, configs) type(c_ptr) :: rarray_ptr integer, pointer :: supersample_fac + integer, pointer :: supersample_fac_lu integer, pointer :: supersample_fac_30s real(kind=RKIND):: lat,lon,x,y @@ -210,12 +216,15 @@ 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_soilcat_data', config_soilcat_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) + call mpas_pool_get_config(configs, 'config_lu_supersample_factor', supersample_fac_lu) call mpas_pool_get_config(configs, 'config_30s_supersample_factor', supersample_fac_30s) + call mpas_pool_get_config(configs, 'config_noahmp_static', config_noahmp_static) write(geog_data_path, '(a)') config_geog_data_path i = len_trim(geog_data_path) @@ -345,13 +354,14 @@ subroutine init_atm_static(mesh, dims, configs) surface_input_select0: select case(trim(config_landuse_data)) case('USGS') write(mminlu,'(a)') 'USGS' - case('MODIFIED_IGBP_MODIS_NOAH') + case('MODIFIED_IGBP_MODIS_NOAH', 'MODIFIED_IGBP_MODIS_NOAH_15s') write(mminlu,'(a)') 'MODIFIED_IGBP_MODIS_NOAH' case default call mpas_log_write('*****************************************************************', messageType=MPAS_LOG_ERR) call mpas_log_write('Invalid land use dataset '''//trim(config_landuse_data) & //''' selected for config_landuse_data', messageType=MPAS_LOG_ERR) call mpas_log_write(' Possible options are: ''USGS'', ''MODIFIED_IGBP_MODIS_NOAH''', messageType=MPAS_LOG_ERR) + call mpas_log_write(' ''MODIFIED_IGBP_MODIS_NOAH_15s''', 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 select surface_input_select0 @@ -391,24 +401,42 @@ subroutine init_atm_static(mesh, dims, configs) 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('MODIFIED_IGBP_MODIS_NOAH_15s') + call mpas_log_write('Using 20-class MODIS 15-arc-second land cover dataset') + geog_sub_path = 'modis_landuse_20class_15s/' case default call mpas_log_write('*****************************************************************', messageType=MPAS_LOG_ERR) call mpas_log_write('Invalid land use dataset '''//trim(config_landuse_data) & //''' selected for config_landuse_data', messageType=MPAS_LOG_ERR) call mpas_log_write(' Possible options are: ''USGS'', ''MODIFIED_IGBP_MODIS_NOAH''', messageType=MPAS_LOG_ERR) + call mpas_log_write(' ''MODIFIED_IGBP_MODIS_NOAH_15s''', 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 select surface_input_select1 call mpas_log_write('--- start interpolate LU_INDEX') call interp_landuse(mesh, tree, trim(geog_data_path)//trim(geog_sub_path), isice_lu, iswater_lu, & - supersample_fac=supersample_fac_30s) + supersample_fac=supersample_fac_lu) call mpas_log_write('--- end interpolate LU_INDEX') ! ! Interpolate SOILCAT_TOP ! - geog_sub_path = 'soiltype_top_30s/' + select case(trim(config_soilcat_data)) + case('STATSGO') + call mpas_log_write('Using STATSGO 30-arc-second soil type dataset') + geog_sub_path = 'soiltype_top_30s/' + case('BNU') + call mpas_log_write('Using BNU 30-arc-second soil type dataset') + geog_sub_path = 'bnu_soiltype_top/' + case default + call mpas_log_write('*****************************************************************',messageType=MPAS_LOG_ERR) + call mpas_log_write('Invalid soil type dataset'''//trim(config_soilcat_data) & + //''' selected for config_soilcat_data', messageType=MPAS_LOG_ERR) + call mpas_log_write(' Possible options are: ''STATSGO'',''BNU''', 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 select call mpas_log_write('--- start interpolate SOILCAT_TOP') call interp_soilcat(mesh, tree, trim(geog_data_path)//trim(geog_sub_path), iswater_soil, & @@ -1168,6 +1196,60 @@ subroutine init_atm_static(mesh, dims, configs) call mpas_log_write('--- end interpolate ALBEDO12M') + if (config_noahmp_static) then + + ! + ! Interpolate SOILCOMP + ! + geog_sub_path = 'soilgrids/soilcomp/' + + call mpas_log_write('--- start interpolate SOILCOMP') + call interp_soilcomp(mesh, tree, trim(geog_data_path)//trim(geog_sub_path), & + supersample_fac=supersample_fac_30s) + call mpas_log_write('--- end interpolate SOILCOMP') + + ! + ! Interpolate SOILCL1 + ! + geog_sub_path = 'soilgrids/texture_layer1/' + + call mpas_log_write('--- start interpolate SOILCL1') + call interp_soil_texture('soilcl1', mesh, tree, trim(geog_data_path)//trim(geog_sub_path), & + supersample_fac=supersample_fac_30s) + call mpas_log_write('--- end interpolate SOILCL1') + + ! + ! Interpolate SOILCL2 + ! + geog_sub_path = 'soilgrids/texture_layer2/' + + call mpas_log_write('--- start interpolate SOILCL2') + call interp_soil_texture('soilcl2', mesh, tree, trim(geog_data_path)//trim(geog_sub_path), & + supersample_fac=supersample_fac_30s) + call mpas_log_write('--- end interpolate SOILCL2') + + ! + ! Interpolate SOILCL3 + ! + geog_sub_path = 'soilgrids/texture_layer3/' + + call mpas_log_write('--- start interpolate SOILCL3') + call interp_soil_texture('soilcl3', mesh, tree, trim(geog_data_path)//trim(geog_sub_path), & + supersample_fac=supersample_fac_30s) + call mpas_log_write('--- end interpolate SOILCL3') + + ! + ! Interpolate SOILCL4 + ! + geog_sub_path = 'soilgrids/texture_layer4/' + + call mpas_log_write('--- start interpolate SOILCL4') + call interp_soil_texture('soilcl4', mesh, tree, trim(geog_data_path)//trim(geog_sub_path), & + supersample_fac=supersample_fac_30s) + call mpas_log_write('--- end interpolate SOILCL4') + + end if + ! ! Deallocate and free the KD Tree ! @@ -1432,6 +1514,33 @@ subroutine terrain_interp_accumulation(iCell, pixel) end subroutine terrain_interp_accumulation + !*********************************************************************** + ! + ! routine soilcomp_interp_accumulation + ! + !> \brief Accumulate soilcomp dataset values + !> \author Michael G. Duda + !> \date 31 May 2024 + !> \details + !> This routine accumulates soilcomp values for the init_atm_map_static_data + !> routine. + ! + !----------------------------------------------------------------------- + subroutine soilcomp_interp_accumulation(iCell, pixel) + + integer, intent(in) ::iCell + integer (kind=I8KIND), dimension(:), intent(in) :: pixel + + if (landmask(iCell) == 0) return + + if (pixel(1) /= soilcomp_msgval) then + soilcomp_int(:,iCell) = soilcomp_int(:,iCell) + int(pixel(:), kind=I8KIND) + nhs(iCell) = nhs(iCell) + 1 + end if + + end subroutine soilcomp_interp_accumulation + + !*********************************************************************** ! ! routine interp_terrain @@ -1510,6 +1619,104 @@ subroutine interp_terrain(mesh, kdtree, geog_data_path, supersample_fac) end subroutine interp_terrain + !*********************************************************************** + ! + ! routine interp_soilcomp + ! + !> \brief Interpolate the soilcomp field for Noah-MP + !> \author Michael G. Duda + !> \date 31 May 2024 + !> \details + !> Interpolate soilcomp using the init_atm_map_static_data routine, + !> accumulating pixel values into cells using the soilcomp_interp_accumulation + !> method. + !> + !> The mesh argument is an mpas_pool that contains soilcomp as well as + !> the nCells dimension. kdtree is an initialized kdtree of (xCell, yCell, zCell), + !> and geog_data_path specifies the path to the soilcomp dataset. + !> + !> The supersample_fac argument specifies the supersampling factor to be + !> applied to the source dataset. + ! + !----------------------------------------------------------------------- + subroutine interp_soilcomp(mesh, kdtree, geog_data_path, supersample_fac) + + implicit none + + ! Input variables + type (mpas_pool_type), intent(inout) :: mesh + type (mpas_kd_type), pointer, intent(in) :: kdtree + character (len=*), intent(in) :: geog_data_path + integer, intent(in), optional :: supersample_fac + + ! Local variables + type (mpas_geotile_mgr_type) :: mgr + integer, pointer :: nCells, nSoilComps + real (kind=RKIND), pointer :: scalefactor + real (kind=RKIND), pointer :: missing_value + + real (kind=RKIND), dimension(:,:), pointer :: soilcomp + + integer :: iCell + integer :: ierr + + ierr = mgr % init(trim(geog_data_path)) + if (ierr /= 0) then + call mpas_log_write('Error occurred initializing interpolation for '//trim(geog_data_path), & + messageType=MPAS_LOG_CRIT) + + return ! Program execution should not reach this statement + ! since the preceding message is a critical error + end if + + call mpas_pool_get_dimension(mesh, 'nCells', nCells) + call mpas_pool_get_dimension(mesh, 'nSoilComps', nSoilComps) + call mpas_pool_get_array(mesh, 'soilcomp', soilcomp) + + call mpas_pool_get_config(mgr % pool, 'scale_factor', scalefactor) + call mpas_pool_get_config(mgr % pool, 'missing_value', missing_value) + + soilcomp_msgval = missing_value + + allocate(soilcomp_int(nSoilComps,nCells)) + allocate(nhs(nCells)) + + ! + ! Store tile values as a I8KIND integer temporarily to avoid floating + ! point round off differences and to have +/- 9.22x10^18 range of representative + ! values. For example, a 120 km mesh with a 1 meter data set with 6 decimal of + ! precision will allow for values of 180x10^12. + ! + soilcomp(:,:) = 0.0 + soilcomp_int(:,:) = 0 + nhs(:) = 0 + + call init_atm_map_static_data(mesh, mgr, kdtree, continuous_interp_criteria, & + soilcomp_interp_accumulation, & + supersample_fac=supersample_fac) + + do iCell = 1, nCells + if (nhs(iCell) > 0) then + soilcomp(:,iCell) = real(real(soilcomp_int(:,iCell), kind=R8KIND) & + / real(nhs(iCell), kind=R8KIND), kind=RKIND) + end if + end do + soilcomp(:,:) = soilcomp(:,:) * scalefactor + + deallocate(soilcomp_int) + deallocate(nhs) + + ierr = mgr % finalize() + if (ierr /= 0) then + call mpas_log_write('Error occurred finalizing interpolation for '//trim(geog_data_path), & + messageType=MPAS_LOG_CRIT) + + return ! Program execution should not reach this statement + ! since the preceding message is a critical error + end if + + end subroutine interp_soilcomp + !-------------------------------------------------------------------------------------------------- ! Categorical interpolations - Landuse and Soiltype !-------------------------------------------------------------------------------------------------- @@ -1895,6 +2102,85 @@ subroutine interp_soiltemp(mesh, dims, configs) end subroutine interp_soiltemp + !*********************************************************************** + ! + ! routine interp_soil_texture + ! + !> \brief Interpolate soil texture category for Noah-MP + !> \author Michael G. Duda + !> \date 31 May 2024 + !> \details + !> Interpolate soil texture category fields by using the init_atm_map_static_data + !> routine, accumulating the pixel values into each cell using + !> categorical_interp_accumulation. + !> + !> The fieldname argument specifies the specific soil texture category + !> field from the mesh pool onto which the dataset specified by geog_data_path + !> should be remapped. + !> + !> The mesh argument is an mpas_pool_type that contains the specified fieldname, + !> kdtree is an initialized mpas_kd_type tree with (xCell, yCell, zCell), and + !> supersample_fac is the supersampling factor to be applied to the source dataset. + !> + !----------------------------------------------------------------------- + subroutine interp_soil_texture(fieldname, mesh, kdtree, geog_data_path, supersample_fac) + + implicit none + + ! Input variables + character (len=*), intent(in) :: fieldname + type (mpas_pool_type), intent(inout) :: mesh + type (mpas_kd_type), pointer, intent(in) :: kdtree + character (len=*), intent(in) :: geog_data_path + integer, intent(in), optional :: supersample_fac + + ! Local variables + real, dimension(:), pointer :: soilclx + type (mpas_geotile_mgr_type) :: mgr + integer, pointer :: nCells + + integer :: iCell + integer :: ierr + + ierr = mgr % init(trim(geog_data_path)) + if (ierr /= 0) then + call mpas_log_write('Error occured initalizing interpolation for '//trim(geog_data_path), & + messageType=MPAS_LOG_CRIT) + return + end if + + call mpas_pool_get_dimension(mesh, 'nCells', nCells) + call mpas_pool_get_array(mesh, trim(fieldname), soilclx) + call mpas_pool_get_config(mgr % pool, 'category_min', category_min) + call mpas_pool_get_config(mgr % pool, 'category_max', category_max) + + allocate(ncat(category_min:category_max, nCells)) + ncat(:,:) = 0 + + call init_atm_map_static_data(mesh, mgr, kdtree, categorical_interp_criteria, & + categorical_interp_accumulation, & + supersample_fac=supersample_fac) + + do iCell = 1, nCells + ! Because maxloc returns the location of the maximum value of an array as if the + ! starting index of the array is 1, and dataset categories do not necessarily start + ! at 1, we need to use category_min to ensure the correct category location is chosen. + soilclx(iCell) = real(maxloc(ncat(:,iCell), dim=1) - 1 + category_min, kind=RKIND) + end do + deallocate(ncat) + + ierr = mgr % finalize() + if (ierr /= 0) then + call mpas_log_write('Error occured finalizing interpolation for '//trim(geog_data_path), & + messageType=MPAS_LOG_CRIT) + return + end if + + nullify(category_min) + nullify(category_max) + + end subroutine interp_soil_texture + !================================================================================================== subroutine init_atm_check_read_error(istatus, fname) !================================================================================================== diff --git a/src/core_init_atmosphere/mpas_init_atm_thompson_aerosols.F b/src/core_init_atmosphere/mpas_init_atm_thompson_aerosols.F new file mode 100644 index 000000000..bb8a12722 --- /dev/null +++ b/src/core_init_atmosphere/mpas_init_atm_thompson_aerosols.F @@ -0,0 +1,866 @@ +! Copyright (c) 2024 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_init_atm_thompson_aerosols + use mpas_derived_types + use mpas_kind_types + use mpas_log + use mpas_dmpar + use mpas_pool_routines + + use init_atm_read_met + use init_atm_hinterp + use init_atm_llxy + use init_atm_vinterp + use mpas_atmphys_date_time + use mpas_atmphys_utilities + + implicit none + private + public:: init_atm_thompson_aerosols,init_atm_thompson_aerosols_lbc + +!mpas_init_atm_thompson_aerosols contains the subroutines needed for the interpolation of climatological +!monthly-averaged hygroscopic ("water friendly") and nonhygroscopic ("ice friendly") aerosols used in the +!Thompson parameterization of cloud microphysics with Gocart CCN and IN nucleation. +!Laura D. Fowler (laura@ucar.edu) / 2024-04-10. + + + contains + + +!================================================================================================================= + subroutine init_atm_thompson_aerosols(block,mesh,configs,diag,state) +!================================================================================================================= + +!input arguments: + type (mpas_pool_type),intent(in):: configs + type(mpas_pool_type),intent(in):: diag + +!inout arguments: + type(block_type),intent(inout),target:: block + type(mpas_pool_type),intent(inout) :: mesh + type(mpas_pool_type),intent(inout) :: state +!local variables and pointers: + character (len=StrKIND),pointer:: config_start_time + character(len=StrKIND):: filename_gocart + character(len=StrKIND):: initial_date,mess + + logical:: lexist + +!----------------------------------------------------------------------------------------------------------------- +!call mpas_log_write('--- enter subroutine init_atm_thompson_aerosols:') + +!inquire if the GOCART input file exists: + lexist = .false. + filename_gocart = "QNWFA_QNIFA_SIGMA_MONTHLY.dat" + + inquire(file=filename_gocart,exist=lexist) + if(lexist) then + + call mpas_pool_get_config(configs,'config_start_time',config_start_time) + + !--- horizontal interpolation of the climatological monthly-averaged GOCART data to the MPAS mesh: + call init_hinterp_gocart(block,mesh) + + !--- interpolation of the monthly-averaged GOCART data to the initial date, and vertical interpolation to + ! the MPAS levels: + initial_date = trim(config_start_time) + call init_vinterp_gocart(initial_date,mesh,diag,state) + else + call mpas_log_write('QNWFA_QNIFA_SIGMA_MONTHLY.dat was not found in local directory:') + call mpas_log_write('nwfa and nifa are set to zero and not interpolated from climatological data.') + endif + +!call mpas_log_write('--- end subroutine init_atm_thompson_aerosols.') + call mpas_log_write(' ') + + end subroutine init_atm_thompson_aerosols + +!================================================================================================================= + subroutine init_vinterp_gocart(initial_date,mesh,diag,state) +!================================================================================================================= + +!input arguments: + character(len=StrKIND),intent(in):: initial_date + type(mpas_pool_type),intent(in):: diag + +!inout arguments: + type(mpas_pool_type),intent(inout):: mesh + type(mpas_pool_type),intent(inout):: state + +!local variables and pointers: + integer,pointer:: nCells,nGocartLevels,nVertLevels,nMonths + integer,pointer:: index_nifa,index_nwfa + integer:: iCell,k,kk,n + + real(kind=RKIND),dimension(:,:),pointer :: nifa,nwfa,pressure + real(kind=RKIND),dimension(:,:,:),pointer:: nifa_clim,nwfa_clim,pwif_clim + real(kind=RKIND),dimension(:,:,:),pointer:: scalars + + real(kind=RKIND):: target_p + real(kind=RKIND),dimension(:,:),allocatable:: nifa_int,nwfa_int,pwif_int,sorted_arr + + real(kind=RKIND),dimension(:),allocatable:: dummy2 + real(kind=RKIND),dimension(:,:),allocatable:: dummy1 + +!----------------------------------------------------------------------------------------------------------------- +!call mpas_log_write('--- enter subroutine init_vinterp_gocart:') + + call mpas_pool_get_dimension(mesh,'nCells' ,nCells ) + call mpas_pool_get_dimension(mesh,'nGocartLevels',nGocartLevels) + call mpas_pool_get_dimension(mesh,'nVertLevels' ,nVertLevels ) + call mpas_pool_get_dimension(mesh,'nMonths' ,nMonths ) + + call mpas_pool_get_dimension(state,'index_nifa',index_nifa) + call mpas_pool_get_dimension(state,'index_nwfa',index_nwfa) + + call mpas_pool_get_array(diag,'pressure_base',pressure) + + call mpas_pool_get_array(mesh,'nifa_gocart_clim',nifa_clim) + call mpas_pool_get_array(mesh,'nwfa_gocart_clim',nwfa_clim) + call mpas_pool_get_array(mesh,'pwif_gocart_clim',pwif_clim) + + call mpas_pool_get_array(state,'scalars',scalars) + nifa => scalars(index_nifa,:,:) + nwfa => scalars(index_nwfa,:,:) + + if(.not.allocated(nifa_int) ) allocate(nifa_int(nGocartLevels,nCells)) + if(.not.allocated(nwfa_int) ) allocate(nwfa_int(nGocartLevels,nCells)) + if(.not.allocated(pwif_int) ) allocate(pwif_int(nGocartLevels,nCells)) + if(.not.allocated(sorted_arr)) allocate(sorted_arr(2,nGocartLevels)) + +!--- interpolation of the monthly-averaged GOCART data to the initial date, and vertical interpolation to the +! MPAS levels: + if(.not.allocated(dummy2)) allocate(dummy2(nCells)) + if(.not.allocated(dummy1)) allocate(dummy1(nMonths,nCells)) + + do k = 1, nGocartLevels + dummy2(1:nCells) = 0._RKIND + dummy1(1:nMonths,1:nCells) = pwif_clim(1:nMonths,k,1:nCells) + call monthly_interp_to_date(nCells,initial_date,dummy1,dummy2) + pwif_int(k,1:nCells) = dummy2(1:nCells) + enddo + +!--- nifa: + do k = 1, nGocartLevels + dummy2(1:nCells) = 0._RKIND + dummy1(1:nMonths,1:nCells) = nifa_clim(1:nMonths,k,1:nCells) + call monthly_interp_to_date(nCells,initial_date,dummy1,dummy2) + nifa_int(k,1:nCells) = dummy2(1:nCells) + enddo + do iCell = 1, nCells + sorted_arr(1,1:nGocartLevels) = 0._RKIND + sorted_arr(2,1:nGocartLevels) = 0._RKIND + do k = 1, nGocartLevels + kk = nGocartLevels + 1 -k + sorted_arr(1,kk) = pwif_int(k,iCell) + sorted_arr(2,kk) = nifa_int(k,iCell) + enddo + do k = nVertLevels, 1, -1 + target_p = pressure(k,iCell) + nifa(k,iCell) = vertical_interp(target_p,nGocartLevels-1, & + sorted_arr(:,1:nGocartLevels-1),order=1,extrap=0) + if(target_p >= pwif_int(1,iCell) .and. k < nVertLevels) nifa(k,iCell) = nifa(k+1,iCell) + enddo + enddo + +!--- nwfa: + do k = 1, nGocartLevels + dummy2(1:nCells) = 0._RKIND + dummy1(1:nMonths,1:nCells) = nwfa_clim(1:nMonths,k,1:nCells) + call monthly_interp_to_date(nCells,initial_date,dummy1,dummy2) + nwfa_int(k,1:nCells) = dummy2(1:nCells) + enddo + do iCell = 1, nCells + sorted_arr(1,1:nGocartLevels) = 0._RKIND + sorted_arr(2,1:nGocartLevels) = 0._RKIND + do k = 1, nGocartLevels + kk = nGocartLevels + 1 -k + sorted_arr(1,kk) = pwif_int(k,iCell) + sorted_arr(2,kk) = nwfa_int(k,iCell) + enddo + do k = nVertLevels, 1, -1 + target_p = pressure(k,iCell) + nwfa(k,iCell) = vertical_interp(target_p,nGocartLevels-1, & + sorted_arr(:,1:nGocartLevels-1),order=1,extrap=0) + if(target_p >= pwif_int(1,iCell) .and. k < nVertLevels) nwfa(k,iCell) = nwfa(k+1,iCell) + enddo + enddo + +!--- deallocation of local arrays: + if(allocated(dummy1) ) deallocate(dummy1 ) + if(allocated(dummy2) ) deallocate(dummy2 ) + if(allocated(nifa_int) ) deallocate(nifa_int ) + if(allocated(nwfa_int) ) deallocate(nwfa_int ) + if(allocated(pwif_int) ) deallocate(pwif_int ) + if(allocated(sorted_arr)) deallocate(sorted_arr) + +!call mpas_log_write('--- end subroutine init_vinterp_gocart:') + + end subroutine init_vinterp_gocart + +!================================================================================================================= + subroutine init_hinterp_gocart(block,mesh) +!================================================================================================================= + +!inout arguments: + type(block_type),intent(inout),target:: block + type (mpas_pool_type),intent(inout) :: mesh + +!local variables: + type(dm_info),pointer:: dminfo + type(met_data) :: field !real*4 meteorological data. + type(proj_info):: proj + + character(len=StrKIND):: filename_gocart + logical:: have_landmask + + integer,pointer:: nCells + integer:: i,j + integer:: iCell,istatus,k,masked,nmonths,nInterpPoints + integer,dimension(5):: interp_list + integer,dimension(:),pointer:: landmask + integer,dimension(:),pointer:: mask_array + + real(kind=RKIND):: fillval,maskval,msgval + real(kind=RKIND):: lat,lon,x,y + real(kind=RKIND),dimension(:),pointer :: latCell,lonCell + real(kind=RKIND),dimension(:),pointer :: latPoints,lonPoints + real(kind=RKIND),dimension(:,:,:),pointer:: nifa_clim,nwfa_clim,pwif_clim + real(kind=RKIND),dimension(:,:,:),pointer:: destField3d + + real(kind=RKIND),dimension(:,:),allocatable:: maskslab,rslab + +!----------------------------------------------------------------------------------------------------------------- +!call mpas_log_write('--- enter subroutine init_hinterp_gocart:') + + dminfo => block%domain%dminfo + + filename_gocart = "QNWFA_QNIFA_SIGMA_MONTHLY.dat" + + call mpas_pool_get_dimension(mesh,'nCells',nCells) + + 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,'nifa_gocart_clim',nifa_clim) + call mpas_pool_get_array(mesh,'nwfa_gocart_clim',nwfa_clim) + call mpas_pool_get_array(mesh,'pwif_gocart_clim',pwif_clim) + +!open intermediate file: + istatus = 0 + call read_met_init(trim(filename_gocart),.true.,'not needed',istatus) + if(istatus /= 0) then + call mpas_log_write('********************************************************************************') + call mpas_log_write('Error opening gocart file '//trim(filename_gocart)) + call mpas_log_write('********************************************************************************') + call mpas_dmpar_abort(dminfo) + else + call mpas_log_write('Processing file '//trim(filename_gocart)) + end if + +!scan through all fields in the file, looking for the LANDSEA field: + have_landmask = .false. + call read_next_met_field(field,istatus) + do while (istatus == 0) + if(index(field % field, 'LANDSEA') /= 0) then + have_landmask = .true. + if(.not.allocated(maskslab)) allocate(maskslab(-2:field%nx+3,field%ny)) + + maskslab(1:field%nx,1:field%ny) = field%slab(1:field%nx,1:field%ny) + maskslab(0 ,1:field%ny) = field%slab(field%nx ,1:field%ny) + maskslab(-1,1:field%ny) = field%slab(field%nx-1,1:field%ny) + maskslab(-2,1:field%ny) = field%slab(field%nx-2,1:field%ny) + maskslab(field%nx+1,1:field%ny) = field%slab(1,1:field%ny) + maskslab(field%nx+2,1:field%ny) = field%slab(2,1:field%ny) + maskslab(field%nx+3,1:field%ny) = field%slab(3,1:field%ny) +! call mpas_log_write('minval, maxval of LANDSEA = $r $r',realArgs=(/minval(maskslab),maxval(maskslab)/)) + end if + deallocate(field%slab) + call read_next_met_field(field,istatus) + end do + call read_met_close() + + if(.not. have_landmask) then + call mpas_log_write('********************************************************************************') + call mpas_log_write('Landsea mask not available from the surface file') + call mpas_log_write('********************************************************************************') + end if + + +!read gocart data: + istatus = 0 + call read_met_init(trim(filename_gocart),.true.,'not needed',istatus) + if(istatus /= 0) then + call mpas_log_write('********************************************************************************') + call mpas_log_write('Error opening gocart file '// trim(filename_gocart)) + call mpas_log_write('********************************************************************************') + call mpas_dmpar_abort(dminfo) + endif + call read_next_met_field(field, istatus) + +!horizontally interpolate GOCART data: + do while(istatus == 0) + + interp_list(1) = FOUR_POINT + interp_list(2) = W_AVERAGE4 + interp_list(3) = W_AVERAGE16 + interp_list(4) = SEARCH + interp_list(5) = 0 + + maskval = -1.0 + masked = -1 + fillval = 0.0 + msgval = 0.0 + + mask_array => landmask + + if(index(field % field, 'QNIFA_JAN') /= 0 .or. & + index(field % field, 'QNIFA_FEB') /= 0 .or. & + index(field % field, 'QNIFA_MAR') /= 0 .or. & + index(field % field, 'QNIFA_APR') /= 0 .or. & + index(field % field, 'QNIFA_MAY') /= 0 .or. & + index(field % field, 'QNIFA_JUN') /= 0 .or. & + index(field % field, 'QNIFA_JUL') /= 0 .or. & + index(field % field, 'QNIFA_AUG') /= 0 .or. & + index(field % field, 'QNIFA_SEP') /= 0 .or. & + index(field % field, 'QNIFA_OCT') /= 0 .or. & + index(field % field, 'QNIFA_NOV') /= 0 .or. & + index(field % field, 'QNIFA_DEC') /= 0 .or. & + index(field % field, 'QNWFA_JAN') /= 0 .or. & + index(field % field, 'QNWFA_FEB') /= 0 .or. & + index(field % field, 'QNWFA_MAR') /= 0 .or. & + index(field % field, 'QNWFA_APR') /= 0 .or. & + index(field % field, 'QNWFA_MAY') /= 0 .or. & + index(field % field, 'QNWFA_JUN') /= 0 .or. & + index(field % field, 'QNWFA_JUL') /= 0 .or. & + index(field % field, 'QNWFA_AUG') /= 0 .or. & + index(field % field, 'QNWFA_SEP') /= 0 .or. & + index(field % field, 'QNWFA_OCT') /= 0 .or. & + index(field % field, 'QNWFA_NOV') /= 0 .or. & + index(field % field, 'QNWFA_DEC') /= 0 .or. & + index(field % field, 'P_WIF_JAN') /= 0 .or. & + index(field % field, 'P_WIF_FEB') /= 0 .or. & + index(field % field, 'P_WIF_MAR') /= 0 .or. & + index(field % field, 'P_WIF_APR') /= 0 .or. & + index(field % field, 'P_WIF_MAY') /= 0 .or. & + index(field % field, 'P_WIF_JUN') /= 0 .or. & + index(field % field, 'P_WIF_JUL') /= 0 .or. & + index(field % field, 'P_WIF_AUG') /= 0 .or. & + index(field % field, 'P_WIF_SEP') /= 0 .or. & + index(field % field, 'P_WIF_OCT') /= 0 .or. & + index(field % field, 'P_WIF_NOV') /= 0 .or. & + index(field % field, 'P_WIF_DEC') /= 0) then + + ! + !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)) + elseif(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)) + endif + + ! + !horizontally interpolate field at level k: + ! + if(index(field%field,'QNIFA_JAN') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating QNIFA_JAN at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'nifa_gocart_clim',destField3d) + nmonths = 1 + elseif(index(field%field,'QNIFA_FEB') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating QNIFA_FEB at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'nifa_gocart_clim',destField3d) + nmonths = 2 + elseif(index(field%field,'QNIFA_MAR') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating QNIFA_MAR at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'nifa_gocart_clim',destField3d) + nmonths = 3 + elseif(index(field%field,'QNIFA_APR') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating QNIFA_APR at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'nifa_gocart_clim',destField3d) + nmonths = 4 + elseif(index(field%field,'QNIFA_MAY') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating QNIFA_MAY at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'nifa_gocart_clim',destField3d) + nmonths = 5 + elseif(index(field%field,'QNIFA_JUN') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating QNIFA_JUN at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'nifa_gocart_clim',destField3d) + nmonths = 6 + elseif(index(field%field,'QNIFA_JUL') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating QNIFA_JUL at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'nifa_gocart_clim',destField3d) + nmonths = 7 + elseif(index(field%field,'QNIFA_AUG') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating QNIFA_AUG at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'nifa_gocart_clim',destField3d) + nmonths = 8 + elseif(index(field%field,'QNIFA_SEP') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating QNIFA_SEP at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'nifa_gocart_clim',destField3d) + nmonths = 9 + elseif(index(field%field,'QNIFA_OCT') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating QNIFA_OCT at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'nifa_gocart_clim',destField3d) + nmonths = 10 + elseif(index(field%field,'QNIFA_NOV') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating QNIFA_NOV at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'nifa_gocart_clim',destField3d) + nmonths = 11 + elseif(index(field%field,'QNIFA_DEC') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating QNIFA_DEC at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'nifa_gocart_clim',destField3d) + nmonths = 12 + elseif(index(field%field,'QNWFA_JAN') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating QNWFA_JAN at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'nwfa_gocart_clim',destField3d) + nmonths = 1 + elseif(index(field%field,'QNWFA_FEB') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating QNWFA_FEB at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'nwfa_gocart_clim',destField3d) + nmonths = 2 + elseif(index(field%field,'QNWFA_MAR') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating QNWFA_MAR at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'nwfa_gocart_clim',destField3d) + nmonths = 3 + elseif(index(field%field,'QNWFA_APR') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating QNWFA_APR at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'nwfa_gocart_clim',destField3d) + nmonths = 4 + elseif(index(field%field,'QNWFA_MAY') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating QNWFA_MAY at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'nwfa_gocart_clim',destField3d) + nmonths = 5 + elseif(index(field%field,'QNWFA_JUN') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating QNWFA_JUN at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'nwfa_gocart_clim',destField3d) + nmonths = 6 + elseif(index(field%field,'QNWFA_JUL') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating QNWFA_JUL at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'nwfa_gocart_clim',destField3d) + nmonths = 7 + elseif(index(field%field,'QNWFA_AUG') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating QNWFA_AUG at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'nwfa_gocart_clim',destField3d) + nmonths = 8 + elseif(index(field%field,'QNWFA_SEP') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating QNWFA_SEP at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'nwfa_gocart_clim',destField3d) + nmonths = 9 + elseif(index(field%field,'QNWFA_OCT') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating QNWFA_OCT at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'nwfa_gocart_clim',destField3d) + nmonths = 10 + elseif(index(field%field,'QNWFA_NOV') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating QNWFA_NOV at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'nwfa_gocart_clim',destField3d) + nmonths = 11 + elseif(index(field%field,'QNWFA_DEC') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating QNWFA_DEC at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'nwfa_gocart_clim',destField3d) + nmonths = 12 + elseif(index(field%field,'P_WIF_JAN') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating P_WIF_JAN at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'pwif_gocart_clim',destField3d) + nmonths = 1 + elseif(index(field%field,'P_WIF_FEB') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating P_WIF_FEB at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'pwif_gocart_clim',destField3d) + nmonths = 2 + elseif(index(field%field,'P_WIF_MAR') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating P_WIF_MAR at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'pwif_gocart_clim',destField3d) + nmonths = 3 + elseif(index(field%field,'P_WIF_APR') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating P_WIF_APR at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'pwif_gocart_clim',destField3d) + nmonths = 4 + elseif(index(field%field,'P_WIF_MAY') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating P_WIF_MAY at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'pwif_gocart_clim',destField3d) + nmonths = 5 + elseif(index(field%field,'P_WIF_JUN') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating P_WIF_JUN at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'pwif_gocart_clim',destField3d) + nmonths = 6 + elseif(index(field%field,'P_WIF_JUL') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating P_WIF_JUL at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'pwif_gocart_clim',destField3d) + nmonths = 7 + elseif(index(field%field,'P_WIF_AUG') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating P_WIF_AUG at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'pwif_gocart_clim',destField3d) + nmonths = 8 + elseif(index(field%field,'P_WIF_SEP') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating P_WIF_SEP at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'pwif_gocart_clim',destField3d) + nmonths = 9 + elseif(index(field%field,'P_WIF_OCT') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating P_WIF_OCT at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'pwif_gocart_clim',destField3d) + nmonths = 10 + elseif(index(field%field,'P_WIF_NOV') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating P_WIF_NOV at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'pwif_gocart_clim',destField3d) + nmonths = 11 + elseif(index(field%field,'P_WIF_DEC') /= 0) then + k = field%xlvl + call mpas_log_write('Interpolating P_WIF_DEC at $i',intArgs=(/k/)) + nInterpPoints = nCells + latPoints => latCell + lonPoints => lonCell + call mpas_pool_get_array(mesh,'pwif_gocart_clim',destField3d) + nmonths = 12 + endif + + 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 iCell = 1, nInterpPoints + if(mask_array(iCell) /= masked) then + lat = latPoints(iCell)*DEG_PER_RAD + lon = lonPoints(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) + elseif(x > real(field%nx,kind=RKIND)+ 0.5) then + lon = lon - 360.0 + call latlon_to_ij(proj,lat,lon,x,y) + endif + + if(maskval /= -1.0) then + destField3d(nmonths,k,iCell) = interp_sequence(x,y,1,rslab,-2,field%nx+3,1,field%ny,1,1,msgval, & + interp_list,1,maskval=maskval,mask_array=maskslab) + else + destField3d(nmonths,k,iCell) = interp_sequence(x,y,1,rslab,-2,field%nx+3,1,field%ny,1,1,msgval, & + interp_list,1) + endif + else + destField3d(nmonths,k,iCell) = fillval + endif + enddo + deallocate(rslab) + + endif + deallocate(field%slab) + call read_next_met_field(field,istatus) + + enddo + + call read_met_close() + +!call mpas_log_write('--- end subroutine init_hinterp_gocart:') + + end subroutine init_hinterp_gocart + +!================================================================================================================= + subroutine init_atm_thompson_aerosols_lbc(timestamp,timestart,block,mesh,diag,lbc_state) +!================================================================================================================= + +!input arguments: + character(len=StrKIND),intent(in):: timestart,timestamp + type(mpas_pool_type),intent(in):: diag + +!inout arguments: + type(block_type),intent(inout),target:: block + type(mpas_pool_type),intent(inout):: mesh + type(mpas_pool_type),intent(inout):: lbc_state + +!local variables and pointers: + logical:: lexist + character(len=StrKIND):: filename_gocart + + integer,pointer:: nCells,nGocartLevels,nVertLevels,nMonths + integer,pointer:: index_nifa,index_nwfa + integer:: iCell,k,kk,n + + real(kind=RKIND),dimension(:,:),pointer :: nifa,nwfa,pressure + real(kind=RKIND),dimension(:,:,:),pointer:: nifa_clim,nwfa_clim,pwif_clim + real(kind=RKIND),dimension(:,:,:),pointer:: scalars + + real(kind=RKIND):: target_p + real(kind=RKIND),dimension(:,:),allocatable:: nifa_int,nwfa_int,pwif_int,sorted_arr + + real(kind=RKIND),dimension(:),allocatable:: dummy2 + real(kind=RKIND),dimension(:,:),allocatable:: dummy1 + +!----------------------------------------------------------------------------------------------------------------- +!call mpas_log_write('--- enter subroutine init_lbc_gocart at time: ' //trim(timestamp)) + +!inquire if the GOCART input file exists: + lexist = .false. + filename_gocart = "QNWFA_QNIFA_SIGMA_MONTHLY.dat" + inquire(file=filename_gocart,exist=lexist) + if(.not. lexist) return + + +!horizontally interpolate GOCART input when computing when the initial conditions at start time: + if(timestamp == timestart) then + call init_hinterp_gocart(block,mesh) + endif + + + call mpas_pool_get_dimension(mesh,'nCells' ,nCells ) + call mpas_pool_get_dimension(mesh,'nGocartLevels',nGocartLevels) + call mpas_pool_get_dimension(mesh,'nVertLevels' ,nVertLevels ) + call mpas_pool_get_dimension(mesh,'nMonths' ,nMonths ) + + call mpas_pool_get_dimension(lbc_state,'index_lbc_nifa',index_nifa) + call mpas_pool_get_dimension(lbc_state,'index_lbc_nwfa',index_nwfa) + + call mpas_pool_get_array(diag,'pressure_base',pressure) + + call mpas_pool_get_array(mesh,'nifa_gocart_clim',nifa_clim) + call mpas_pool_get_array(mesh,'nwfa_gocart_clim',nwfa_clim) + call mpas_pool_get_array(mesh,'pwif_gocart_clim',pwif_clim) + + call mpas_pool_get_array(lbc_state,'lbc_scalars',scalars) + nifa => scalars(index_nifa,:,:) + nwfa => scalars(index_nwfa,:,:) + + if(.not.allocated(nifa_int) ) allocate(nifa_int(nGocartLevels,nCells)) + if(.not.allocated(nwfa_int) ) allocate(nwfa_int(nGocartLevels,nCells)) + if(.not.allocated(pwif_int) ) allocate(pwif_int(nGocartLevels,nCells)) + if(.not.allocated(sorted_arr)) allocate(sorted_arr(2,nGocartLevels)) + + nifa(:,:) = 0._RKIND + nwfa(:,:) = 0._RKIND + +!--- interpolation of the monthly-averaged GOCART data to the initial date, and vertical interpolation to the +! MPAS levels: + if(.not.allocated(dummy2)) allocate(dummy2(nCells)) + if(.not.allocated(dummy1)) allocate(dummy1(nMonths,nCells)) + + do k = 1, nGocartLevels + dummy2(1:nCells) = 0._RKIND + dummy1(1:nMonths,1:nCells) = pwif_clim(1:nMonths,k,1:nCells) + call monthly_interp_to_date(nCells,timestamp,dummy1,dummy2) + pwif_int(k,1:nCells) = dummy2(1:nCells) + enddo + +!--- nifa: + do k = 1, nGocartLevels + dummy2(1:nCells) = 0._RKIND + dummy1(1:nMonths,1:nCells) = nifa_clim(1:nMonths,k,1:nCells) + call monthly_interp_to_date(nCells,timestamp,dummy1,dummy2) + nifa_int(k,1:nCells) = dummy2(1:nCells) + enddo + do iCell = 1, nCells + sorted_arr(1,1:nGocartLevels) = 0._RKIND + sorted_arr(2,1:nGocartLevels) = 0._RKIND + do k = 1, nGocartLevels + kk = nGocartLevels + 1 -k + sorted_arr(1,kk) = pwif_int(k,iCell) + sorted_arr(2,kk) = nifa_int(k,iCell) + enddo + do k = nVertLevels, 1, -1 + target_p = pressure(k,iCell) + nifa(k,iCell) = vertical_interp(target_p,nGocartLevels-1, & + sorted_arr(:,1:nGocartLevels-1),order=1,extrap=0) + if(target_p >= pwif_int(1,iCell) .and. k < nVertLevels) nifa(k,iCell) = nifa(k+1,iCell) + enddo + enddo + +!--- nwfa: + do k = 1, nGocartLevels + dummy2(1:nCells) = 0._RKIND + dummy1(1:nMonths,1:nCells) = nwfa_clim(1:nMonths,k,1:nCells) + call monthly_interp_to_date(nCells,timestamp,dummy1,dummy2) + nwfa_int(k,1:nCells) = dummy2(1:nCells) + enddo + do iCell = 1, nCells + sorted_arr(1,1:nGocartLevels) = 0._RKIND + sorted_arr(2,1:nGocartLevels) = 0._RKIND + do k = 1, nGocartLevels + kk = nGocartLevels + 1 -k + sorted_arr(1,kk) = pwif_int(k,iCell) + sorted_arr(2,kk) = nwfa_int(k,iCell) + enddo + do k = nVertLevels, 1, -1 + target_p = pressure(k,iCell) + nwfa(k,iCell) = vertical_interp(target_p,nGocartLevels-1, & + sorted_arr(:,1:nGocartLevels-1),order=1,extrap=0) + if(target_p >= pwif_int(1,iCell) .and. k < nVertLevels) nwfa(k,iCell) = nwfa(k+1,iCell) + enddo + enddo + +!--- deallocation of local arrays: + if(allocated(dummy1) ) deallocate(dummy1 ) + if(allocated(dummy2) ) deallocate(dummy2 ) + if(allocated(nifa_int) ) deallocate(nifa_int ) + if(allocated(nwfa_int) ) deallocate(nwfa_int ) + if(allocated(pwif_int) ) deallocate(pwif_int ) + if(allocated(sorted_arr)) deallocate(sorted_arr) + +!call mpas_log_write('--- end subroutine init_lbc_gocart:') + + end subroutine init_atm_thompson_aerosols_lbc + +!================================================================================================================= + end module mpas_init_atm_thompson_aerosols +!================================================================================================================= diff --git a/src/core_landice/Makefile b/src/core_landice/Makefile index d7dc35bd0..89280f29e 100644 --- a/src/core_landice/Makefile +++ b/src/core_landice/Makefile @@ -31,7 +31,7 @@ core_reg: gen_includes: $(CPP) $(CPPFLAGS) $(CPPINCLUDES) Registry.xml > Registry_processed.xml (if [ ! -d inc ]; then mkdir -p inc; fi) # To generate *.inc files - (cd inc; $(REG_PARSE) < ../Registry_processed.xml ) + (cd inc; $(REG_PARSE) ../Registry_processed.xml $(CPPFLAGS) ) post_build: if [ ! -e $(ROOT_DIR)/default_inputs ]; then mkdir $(ROOT_DIR)/default_inputs; fi diff --git a/src/core_landice/Registry.xml b/src/core_landice/Registry.xml index 91db32ee9..9edf2853d 100644 --- a/src/core_landice/Registry.xml +++ b/src/core_landice/Registry.xml @@ -1,5 +1,5 @@ - + diff --git a/src/core_landice/mode_forward/mpas_li_core_interface.F b/src/core_landice/mode_forward/mpas_li_core_interface.F index db27f3830..e003bceb2 100644 --- a/src/core_landice/mode_forward/mpas_li_core_interface.F +++ b/src/core_landice/mode_forward/mpas_li_core_interface.F @@ -90,10 +90,11 @@ end subroutine li_setup_domain!}}} !> *not* allocated until after this routine is called. ! !----------------------------------------------------------------------- - function li_setup_packages(configPool, packagePool, iocontext) result(ierr) + function li_setup_packages(configPool, streamInfo, packagePool, iocontext) result(ierr) implicit none type (mpas_pool_type), intent(inout) :: configPool + type (MPAS_streamInfo_type), intent(inout) :: streamInfo type (mpas_pool_type), intent(inout) :: packagePool type (mpas_io_context_type), intent(inout) :: iocontext integer :: ierr @@ -236,11 +237,12 @@ end function li_setup_log!}}} !> are available. ! !----------------------------------------------------------------------- - function li_get_mesh_stream(configs, stream) result(ierr) + function li_get_mesh_stream(configs, streamInfo, stream) result(ierr) implicit none type (mpas_pool_type), intent(inout) :: configs + type (MPAS_streamInfo_type), intent(inout) :: streamInfo character(len=StrKIND), intent(out) :: stream integer :: ierr diff --git a/src/core_ocean/Makefile b/src/core_ocean/Makefile index 24ae63199..a793d0960 100644 --- a/src/core_ocean/Makefile +++ b/src/core_ocean/Makefile @@ -31,7 +31,7 @@ core_input_gen: gen_includes: $(CPP) $(CPPFLAGS) $(CPPINCLUDES) Registry.xml > Registry_processed.xml (if [ ! -d inc ]; then mkdir -p inc; fi) # To generate *.inc files - (cd inc; $(REG_PARSE) < ../Registry_processed.xml ) + (cd inc; $(REG_PARSE) ../Registry_processed.xml $(CPPFLAGS) ) post_build: if [ ! -e $(ROOT_DIR)/default_inputs ]; then mkdir $(ROOT_DIR)/default_inputs; fi diff --git a/src/core_ocean/Registry.xml b/src/core_ocean/Registry.xml index a5f42e4d4..5b30da852 100644 --- a/src/core_ocean/Registry.xml +++ b/src/core_ocean/Registry.xml @@ -1,5 +1,5 @@ - + *not* allocated until after this routine is called. ! !----------------------------------------------------------------------- - function ocn_setup_packages(configPool, packagePool, iocontext) result(ierr)!{{{ + function ocn_setup_packages(configPool, streamInfo, packagePool, iocontext) result(ierr)!{{{ use ocn_analysis_driver type (mpas_pool_type), intent(inout) :: configPool + type (MPAS_streamInfo_type), intent(inout) :: streamInfo type (mpas_pool_type), intent(inout) :: packagePool type (mpas_io_context_type), intent(inout) :: iocontext @@ -529,7 +530,7 @@ end function ocn_setup_log!}}} !> are available. ! !----------------------------------------------------------------------- - function ocn_get_mesh_stream(configs, stream) result(ierr)!{{{ + function ocn_get_mesh_stream(configs, streamInfo, stream) result(ierr)!{{{ use mpas_derived_types use mpas_pool_routines @@ -537,6 +538,7 @@ function ocn_get_mesh_stream(configs, stream) result(ierr)!{{{ implicit none type (mpas_pool_type), intent(inout) :: configs + type (MPAS_streamInfo_type), intent(inout) :: streamInfo character(len=StrKIND), intent(out) :: stream integer :: ierr diff --git a/src/core_seaice/Makefile b/src/core_seaice/Makefile index f24c5e017..798ad2a57 100644 --- a/src/core_seaice/Makefile +++ b/src/core_seaice/Makefile @@ -9,7 +9,7 @@ core_seaice: column_package shared analysis_members model_forward gen_includes: $(CPP) $(CPPFLAGS) $(CPPINCLUDES) Registry.xml > Registry_processed.xml (if [ ! -d inc ]; then mkdir -p inc; fi) # To generate *.inc files - (cd inc; $(REG_PARSE) < ../Registry_processed.xml ) + (cd inc; $(REG_PARSE) ../Registry_processed.xml $(CPPFLAGS) ) core_input_gen: if [ ! -e default_inputs ]; then mkdir default_inputs; fi diff --git a/src/core_seaice/Registry.xml b/src/core_seaice/Registry.xml index a649c2b62..a0f8e28d2 100644 --- a/src/core_seaice/Registry.xml +++ b/src/core_seaice/Registry.xml @@ -1,5 +1,5 @@ - + *not* allocated until after this routine is called. ! !----------------------------------------------------------------------- - function seaice_setup_packages(configPool, packagePool, iocontext) result(ierr)!{{{ + function seaice_setup_packages(configPool, streamInfo, packagePool, iocontext) result(ierr)!{{{ use mpas_derived_types implicit none type (mpas_pool_type), intent(inout) :: configPool + type (MPAS_streamInfo_type), intent(inout) :: streamInfo type (mpas_pool_type), intent(inout) :: packagePool type (mpas_io_context_type), intent(inout) :: iocontext @@ -718,7 +719,7 @@ end function seaice_setup_log!}}} !> are available. ! !----------------------------------------------------------------------- - function seaice_get_mesh_stream(configs, stream) result(ierr)!{{{ + function seaice_get_mesh_stream(configs, streamInfo, stream) result(ierr)!{{{ use mpas_derived_types use mpas_pool_routines @@ -726,6 +727,7 @@ function seaice_get_mesh_stream(configs, stream) result(ierr)!{{{ implicit none type (mpas_pool_type), intent(inout) :: configs + type (MPAS_streamInfo_type), intent(inout) :: streamInfo character(len=StrKIND), intent(out) :: stream integer :: ierr diff --git a/src/core_sw/Makefile b/src/core_sw/Makefile index eb19b5a29..34ccfe5bc 100644 --- a/src/core_sw/Makefile +++ b/src/core_sw/Makefile @@ -21,7 +21,7 @@ core_input_gen: gen_includes: $(CPP) $(CPPFLAGS) $(CPPINCLUDES) Registry.xml > Registry_processed.xml (if [ ! -d inc ]; then mkdir -p inc; fi) # To generate *.inc files - (cd inc; $(REG_PARSE) < ../Registry_processed.xml ) + (cd inc; $(REG_PARSE) ../Registry_processed.xml $(CPPFLAGS) ) post_build: if [ ! -e $(ROOT_DIR)/default_inputs ]; then mkdir $(ROOT_DIR)/default_inputs; fi diff --git a/src/core_sw/Registry.xml b/src/core_sw/Registry.xml index 868918cf3..85372d51c 100644 --- a/src/core_sw/Registry.xml +++ b/src/core_sw/Registry.xml @@ -1,5 +1,5 @@ - + diff --git a/src/core_sw/mpas_sw_core_interface.F b/src/core_sw/mpas_sw_core_interface.F index 7596acf82..04df23f19 100644 --- a/src/core_sw/mpas_sw_core_interface.F +++ b/src/core_sw/mpas_sw_core_interface.F @@ -89,13 +89,14 @@ end subroutine sw_setup_domain!}}} !> *not* allocated until after this routine is called. ! !----------------------------------------------------------------------- - function sw_setup_packages(configPool, packagePool, iocontext) result(ierr)!{{{ + function sw_setup_packages(configPool, streamInfo, packagePool, iocontext) result(ierr)!{{{ use mpas_derived_types implicit none type (mpas_pool_type), intent(inout) :: configPool + type (MPAS_streamInfo_type), intent(inout) :: streamInfo type (mpas_pool_type), intent(inout) :: packagePool type (mpas_io_context_type), intent(inout) :: iocontext integer :: ierr @@ -234,7 +235,7 @@ end function sw_setup_log!}}} !> are available. ! !----------------------------------------------------------------------- - function sw_get_mesh_stream(configs, stream) result(ierr)!{{{ + function sw_get_mesh_stream(configs, streamInfo, stream) result(ierr)!{{{ use mpas_derived_types use mpas_pool_routines @@ -242,6 +243,7 @@ function sw_get_mesh_stream(configs, stream) result(ierr)!{{{ implicit none type (mpas_pool_type), intent(inout) :: configs + type (MPAS_streamInfo_type), intent(inout) :: streamInfo character(len=StrKIND), intent(out) :: stream integer :: ierr diff --git a/src/core_test/Makefile b/src/core_test/Makefile index d47059490..5518eceda 100644 --- a/src/core_test/Makefile +++ b/src/core_test/Makefile @@ -7,7 +7,11 @@ OBJS = mpas_test_core.o \ mpas_test_core_field_tests.o \ mpas_test_core_timekeeping_tests.o \ mpas_test_core_sorting.o \ - mpas_halo_testing.o + mpas_halo_testing.o \ + mpas_test_core_string_utils.o \ + mpas_test_core_dmpar.o \ + mpas_test_core_stream_inquiry.o \ + mpas_test_openacc.o all: core_test @@ -25,7 +29,7 @@ core_input_gen: gen_includes: $(CPP) $(CPPFLAGS) $(CPPINCLUDES) Registry.xml > Registry_processed.xml (if [ ! -d inc ]; then mkdir -p inc; fi) # To generate *.inc files - (cd inc; $(REG_PARSE) < ../Registry_processed.xml ) + (cd inc; $(REG_PARSE) ../Registry_processed.xml $(CPPFLAGS) ) post_build: if [ ! -e $(ROOT_DIR)/default_inputs ]; then mkdir $(ROOT_DIR)/default_inputs; fi @@ -36,7 +40,9 @@ mpas_test_core_interface.o: mpas_test_core.o mpas_test_core.o: mpas_test_core_halo_exch.o mpas_test_core_streams.o \ mpas_test_core_field_tests.o mpas_test_core_timekeeping_tests.o \ - mpas_test_core_sorting.o mpas_halo_testing.o + mpas_test_core_sorting.o mpas_halo_testing.o \ + mpas_test_core_string_utils.o mpas_test_core_dmpar.o \ + mpas_test_core_stream_inquiry.o mpas_test_openacc.o mpas_test_core_halo_exch.o: diff --git a/src/core_test/Registry.xml b/src/core_test/Registry.xml index 102cce6de..000ca901e 100644 --- a/src/core_test/Registry.xml +++ b/src/core_test/Registry.xml @@ -1,5 +1,5 @@ - + @@ -71,6 +71,19 @@ + + + + + + + @@ -171,7 +184,10 @@ + - + + + diff --git a/src/core_test/mpas_halo_testing.F b/src/core_test/mpas_halo_testing.F index 447663ffa..8ad155198 100644 --- a/src/core_test/mpas_halo_testing.F +++ b/src/core_test/mpas_halo_testing.F @@ -1,4 +1,4 @@ -! Copyright (c) 2023, The University Corporation for Atmospheric Research (UCAR). +! Copyright (c) 2023-2024, 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 @@ -30,7 +30,7 @@ module mpas_halo_testing !----------------------------------------------------------------------- subroutine mpas_halo_tests(domain, ierr) - use mpas_derived_types, only : domain_type, mpas_pool_type, field2DReal, field3DReal + use mpas_derived_types, only : domain_type, mpas_pool_type, field1DReal, field2DReal, field3DReal use mpas_kind_types, only : StrKIND, RKIND use mpas_log, only : mpas_log_write use mpas_dmpar, only : mpas_dmpar_max_int @@ -50,8 +50,10 @@ subroutine mpas_halo_tests(domain, ierr) character(len=StrKIND) :: test_mesg type (mpas_pool_type), pointer :: haloExchTest_pool type (mpas_pool_type), pointer :: mesh_pool + type (field1DReal), pointer :: scratch_1d type (field2DReal), pointer :: scratch_2d type (field3DReal), pointer :: scratch_3d + real (kind=RKIND), dimension(:), pointer :: array_1d real (kind=RKIND), dimension(:,:), pointer :: array_2d real (kind=RKIND), dimension(:,:,:), pointer :: array_3d integer, dimension(:), pointer :: indexToCellID @@ -98,6 +100,9 @@ subroutine mpas_halo_tests(domain, ierr) call mpas_halo_exch_group_create(domain, 'persistent_group', ierr_local) ierr = ior(ierr, ierr_local) + call mpas_halo_exch_group_add_field(domain, 'persistent_group', 'cellPersistReal1D', iErr=ierr_local) + ierr = ior(ierr, ierr_local) + call mpas_halo_exch_group_add_field(domain, 'persistent_group', 'cellPersistReal2D', iErr=ierr_local) ierr = ior(ierr, ierr_local) @@ -127,6 +132,9 @@ subroutine mpas_halo_tests(domain, ierr) call mpas_halo_exch_group_add_field(domain, 'scratch_group', 'cellScratchReal2D', iErr=ierr_local) ierr = ior(ierr, ierr_local) + call mpas_halo_exch_group_add_field(domain, 'scratch_group', 'cellScratchReal1D', iErr=ierr_local) + ierr = ior(ierr, ierr_local) + call mpas_halo_exch_group_complete(domain, 'scratch_group', ierr_local) ierr = ior(ierr, ierr_local) @@ -142,6 +150,10 @@ subroutine mpas_halo_tests(domain, ierr) ! write(test_mesg, '(a)') ' Exchanging a halo group with persistent fields: ' + call mpas_pool_get_array(haloExchTest_pool, 'cellPersistReal1D', array_1d) + array_1d(:) = -1.0_RKIND + array_1d(1:nCellsSolve) = real(indexToCellID(1:nCellsSolve), kind=RKIND) + call mpas_pool_get_array(haloExchTest_pool, 'cellPersistReal2D', array_2d) do k = 1, size(array_2d, dim=1) array_2d(k,:) = -1.0_RKIND @@ -160,6 +172,9 @@ subroutine mpas_halo_tests(domain, ierr) ierr = ior(ierr, ierr_local) diff = 0.0_RKIND + + diff = diff + sum(abs(array_1d(1:nCells) - real(indexToCellID(1:nCells), kind=RKIND))) + do k = 1, size(array_2d, dim=1) diff = diff + sum(abs(array_2d(k,1:nCells) - real(indexToCellID(1:nCells), kind=RKIND))) end do @@ -187,12 +202,18 @@ subroutine mpas_halo_tests(domain, ierr) ! write(test_mesg, '(a)') ' Exchanging a halo group with scratch fields: ' + call mpas_pool_get_field(haloExchTest_pool, 'cellScratchReal1D', scratch_1d) call mpas_pool_get_field(haloExchTest_pool, 'cellScratchReal2D', scratch_2d) call mpas_pool_get_field(haloExchTest_pool, 'cellScratchReal3D', scratch_3d) + call mpas_allocate_scratch_field(scratch_1d) call mpas_allocate_scratch_field(scratch_2d) call mpas_allocate_scratch_field(scratch_3d) + call mpas_pool_get_array(haloExchTest_pool, 'cellScratchReal1D', array_1d) + array_1d(:) = -1.0_RKIND + array_1d(1:nCellsSolve) = real(indexToCellID(1:nCellsSolve), kind=RKIND) + call mpas_pool_get_array(haloExchTest_pool, 'cellScratchReal2D', array_2d) do k = 1, size(array_2d, dim=1) array_2d(k,:) = -1.0_RKIND @@ -211,6 +232,9 @@ subroutine mpas_halo_tests(domain, ierr) ierr = ior(ierr, ierr_local) diff = 0.0_RKIND + + diff = diff + sum(abs(array_1d(1:nCells) - real(indexToCellID(1:nCells), kind=RKIND))) + do k = 1, size(array_2d, dim=1) diff = diff + sum(abs(array_2d(k,1:nCells) - real(indexToCellID(1:nCells), kind=RKIND))) end do @@ -221,6 +245,7 @@ subroutine mpas_halo_tests(domain, ierr) end do end do + call mpas_deallocate_scratch_field(scratch_1d) call mpas_deallocate_scratch_field(scratch_2d) call mpas_deallocate_scratch_field(scratch_3d) diff --git a/src/core_test/mpas_test_core.F b/src/core_test/mpas_test_core.F index fc746aba4..b9824d7db 100644 --- a/src/core_test/mpas_test_core.F +++ b/src/core_test/mpas_test_core.F @@ -93,7 +93,11 @@ function test_core_run(domain) result(iErr)!{{{ use test_core_streams, only : test_core_streams_test use test_core_sorting, only : test_core_test_sorting use mpas_halo_testing, only : mpas_halo_tests - + use test_core_string_utils, only : mpas_test_string_utils + use mpas_test_core_dmpar, only : mpas_test_dmpar + use mpas_test_core_stream_inquiry, only : mpas_test_stream_inquiry + use mpas_test_core_openacc, only : mpas_test_openacc + implicit none type (domain_type), intent(inout) :: domain @@ -167,6 +171,34 @@ function test_core_run(domain) result(iErr)!{{{ call mpas_log_write('Stream I/O tests: FAILURE', MPAS_LOG_ERR) end if + ! Run string util tests + call mpas_log_write('') + call mpas_test_string_utils(iErr) + call mpas_log_write('') + + ! + ! Run mpas_dmpar tests + ! + call mpas_log_write('') + iErr = mpas_test_dmpar(domain % dminfo) + if (iErr == 0) then + call mpas_log_write('All tests PASSED') + else + call mpas_log_write('$i tests FAILED', intArgs=[iErr]) + end if + call mpas_log_write('') + + ! + ! Run mpas_stream_inquiry tests + ! + call mpas_log_write('') + iErr = mpas_test_stream_inquiry(domain % dminfo) + if (iErr == 0) then + call mpas_log_write('All tests PASSED') + else + call mpas_log_write('$i tests FAILED', intArgs=[iErr]) + end if + call mpas_log_write('') call test_core_test_intervals(domain, threadErrs, iErr) @@ -180,6 +212,35 @@ function test_core_run(domain) result(iErr)!{{{ call mpas_stream_mgr_write(domain % streamManager, forceWriteNow=.true.) + ! + ! Run mpas_test_openacc + ! + call mpas_log_write('') +#ifdef MPAS_OPENACC + iErr = mpas_test_openacc(domain) + if (iErr == 0) then + call mpas_log_write('All tests PASSED') + else + call mpas_log_write('$i tests FAILED', intArgs=[iErr]) + end if +#else + call mpas_log_write('MPAS_OPENACC not defined, skipping OpenACC tests') +#endif + call mpas_log_write('') + + ! + ! Test functionality of adjustments to alarm reference time + ! + call mpas_log_write('') + call mpas_log_write('Testing mpas_adjust_alarm_to_reference_time:') + call mpas_adjust_alarm_tests(domain, iErr) + if (iErr == 0) then + call mpas_log_write('* mpas_adjust_alarm_tests tests - all tests passed: SUCCESS') + else + call mpas_log_write('* mpas_adjust_alarm_tests tests - $i failed tests: FAILURE', intArgs=[iErr]) + end if + call mpas_log_write('') + deallocate(threadErrs) end function test_core_run!}}} diff --git a/src/core_test/mpas_test_core_dmpar.F b/src/core_test/mpas_test_core_dmpar.F new file mode 100644 index 000000000..dde2e40c9 --- /dev/null +++ b/src/core_test/mpas_test_core_dmpar.F @@ -0,0 +1,160 @@ +! Copyright (c) 2023 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 https://mpas-dev.github.io/license.html . +! +module mpas_test_core_dmpar + + use mpas_derived_types, only : dm_info + use mpas_log, only : mpas_log_write + + private + + public :: mpas_test_dmpar + + + contains + + + !----------------------------------------------------------------------- + ! routine mpas_test_dmpar + ! + !> \brief Main driver for tests of the mpas_dmpar module + !> \author Michael Duda + !> \date 14 November 2023 + !> \details + !> This routine invokes tests for individual routines in the mpas_dmpar + !> module, and reports PASSED/FAILED for each of those tests. + !> + !> Return value: The total number of test that failed on any MPI rank. + ! + !----------------------------------------------------------------------- + function mpas_test_dmpar(dminfo) result(ierr_count) + + use mpas_dmpar, only : mpas_dmpar_max_int + use mpas_kind_types, only : StrKIND + + implicit none + + ! Arguments + type (dm_info), intent(inout) :: dminfo + + ! Return value + integer :: ierr_count + + ! Local variables + integer :: ierr, ierr_global + character(len=StrKIND) :: routine_name + + + ierr_count = 0 + + call mpas_log_write('--- Begin dmpar tests') + + ! + ! Test mpas_dmpar_sum_int8 routine + ! + routine_name = 'mpas_dmpar_sum_int8' + ierr = test_sum_int8(dminfo) + call mpas_dmpar_max_int(dminfo, ierr, ierr_global) + if (ierr_global == 0) then + call mpas_log_write(' '//trim(routine_name)//' - PASSED') + else + ierr_count = ierr_count + 1 + call mpas_log_write(' '//trim(routine_name)//' - FAILED') + end if + + end function mpas_test_dmpar + + + !----------------------------------------------------------------------- + ! routine test_sum_int8 + ! + !> \brief Tests the mpas_dmpar_sum_int8 routine + !> \author Michael Duda + !> \date 14 November 2023 + !> \details + !> This routine tests the mpas_dmpar_sum_int8 routine. + !> + !> Return value: The total number of test that failed on the calling rank. + ! + !----------------------------------------------------------------------- + function test_sum_int8(dminfo) result(ierr_count) + + use mpas_dmpar, only : mpas_dmpar_sum_int8 + use mpas_kind_types, only : I8KIND + + implicit none + + ! Arguments + type (dm_info), intent(inout) :: dminfo + + ! Return value + integer :: ierr_count + + ! Local variables + integer(kind=I8KIND) :: ival, ival_sum + integer :: nranks, myrank + + ierr_count = 0 + + myrank = dminfo % my_proc_id + nranks = dminfo % nprocs + + ! + ! Compute sum(huge(ival) / nranks) + ! Correct result should be at least (huge(ival) - nranks) when accounting + ! for truncation in the integer division operation + ! + ival = huge(ival) / nranks + call mpas_dmpar_sum_int8(dminfo, ival, ival_sum) + if (ival_sum >= huge(ival) - nranks) then + call mpas_log_write(' int8 sum to HUGE() - PASSED') + else + call mpas_log_write(' int8 sum to HUGE() - FAILED') + ierr_count = 1 + end if + + ! + ! Compute sum(-huge(ival) / nranks) + ! Correct result should be at most (-huge(ival) + nranks) when accounting + ! for truncation in the integer division operation + ! + ival = -huge(ival) / nranks + call mpas_dmpar_sum_int8(dminfo, ival, ival_sum) + if (ival_sum <= -huge(ival) + nranks) then + call mpas_log_write(' int8 sum to -HUGE() - PASSED') + else + call mpas_log_write(' int8 sum to -HUGE() - FAILED') + ierr_count = 1 + end if + + ! + ! Compute sum of N alternating positive and negative values, where N is + ! the largest even number not greater than the number of ranks. + ! The magnitude of the values to be summed is (huge(ival) / nranks) to + ! avoid overflow for any order of summation. + ! + ival = huge(ival) / nranks + if (mod(myrank, 2) == 1) then + ival = -ival + end if + + ! If we have an odd number of ranks, set value on rank 0 to zero + if (mod(nranks, 2) /= 0) then + if (myrank == 0) then + ival = 0 + end if + end if + call mpas_dmpar_sum_int8(dminfo, ival, ival_sum) + if (ival_sum == 0_I8KIND) then + call mpas_log_write(' int8 sum to zero - PASSED') + else + call mpas_log_write(' int8 sum to zero - FAILED') + ierr_count = 1 + end if + + end function test_sum_int8 + +end module mpas_test_core_dmpar diff --git a/src/core_test/mpas_test_core_field_tests.F b/src/core_test/mpas_test_core_field_tests.F index 54493fc39..50114398c 100644 --- a/src/core_test/mpas_test_core_field_tests.F +++ b/src/core_test/mpas_test_core_field_tests.F @@ -82,19 +82,21 @@ subroutine test_core_attribute_list_test(domain, threadErrs, ierr)!{{{ integer, intent(out) :: ierr type ( att_list_type ), pointer :: srcList, destList - integer :: srcInt, destInt - integer, dimension(:), pointer :: srcIntA, destIntA - real (kind=RKIND) :: srcReal, destReal + integer :: srcInt, destInt, modifyInt + integer, dimension(:), pointer :: srcIntA, destIntA, modifyIntA + real (kind=RKIND) :: srcReal, destReal, modifyReal real (kind=RKIND), dimension(:), pointer :: srcRealA, destRealA - character (len=StrKIND) :: srcText, destText + real (kind=RKIND), dimension(:), pointer :: modifyRealA + character (len=StrKIND) :: srcText, destText, modifyText integer :: threadNum iErr = 0 + threadErrs = 0 - threadNum = mpas_threading_get_thread_num() + threadNum = mpas_threading_get_thread_num() + 1 - if ( threadNum == 0 ) then + if ( threadNum == 1 ) then allocate(srcList) nullify(destList) @@ -153,9 +155,61 @@ subroutine test_core_attribute_list_test(domain, threadErrs, ierr)!{{{ call mpas_log_write(' Duplicate string does not match', MPAS_LOG_ERR) end if + deallocate(destIntA) + deallocate(destRealA) + allocate(modifyIntA(3)) + allocate(modifyRealA(5)) + + modifyInt = 2 + modifyIntA(:) = 2 + modifyReal = 2.0_RKIND + modifyRealA(:) = 2.0_RKIND + modifyText = 'Modified' + + call mpas_modify_att(srcList, 'testInt', modifyInt) + call mpas_modify_att(srcList, 'testIntA', modifyIntA) + call mpas_modify_att(srcList, 'testReal', modifyReal) + call mpas_modify_att(srcList, 'testRealA', modifyRealA) + call mpas_modify_att(srcList, 'testText', modifyText) + + call mpas_get_att(srcList, 'testInt', destInt) + call mpas_get_att(srcList, 'testIntA', destIntA) + call mpas_get_att(srcList, 'testReal', destReal) + call mpas_get_att(srcList, 'testRealA', destRealA) + call mpas_get_att(srcList, 'testText', destText) + + if ( destInt /= modifyInt ) then + threadErrs( threadNum ) = 1 + call mpas_log_write(' Int not modified correctly', MPAS_LOG_ERR) + end if + + if (sum(destIntA) /= sum(modifyIntA)) then + threadErrs( threadNum ) = 1 + call mpas_log_write(' IntA not modified correctly', MPAS_LOG_ERR) + end if + + if ( destReal /= modifyReal ) then + threadErrs( threadNum ) = 1 + call mpas_log_write(' Real not modified correctly', MPAS_LOG_ERR) + end if + + if ( sum(destRealA) /= sum(modifyRealA) ) then + threadErrs( threadNum ) = 1 + call mpas_log_write(' RealA not modified correctly', MPAS_LOG_ERR) + end if + + if ( trim(destText) /= trim(modifyText) ) then + threadErrs( threadNum ) = 1 + call mpas_log_write(' Text not modified correctly', MPAS_LOG_ERR) + end if + call mpas_deallocate_attlist(srcList) call mpas_deallocate_attlist(destList) - + + deallocate(destIntA) + deallocate(destRealA) + deallocate(modifyRealA) + deallocate(modifyIntA) deallocate(srcIntA) deallocate(srcRealA) end if diff --git a/src/core_test/mpas_test_core_halo_exch.F b/src/core_test/mpas_test_core_halo_exch.F index 88f41b1ab..b098fcfc6 100644 --- a/src/core_test/mpas_test_core_halo_exch.F +++ b/src/core_test/mpas_test_core_halo_exch.F @@ -7,6 +7,7 @@ ! !#define HALO_EXCH_DEBUG +!#define HALO_EXCH_DEBUG_VERBOSE module test_core_halo_exch @@ -51,7 +52,7 @@ subroutine test_core_halo_exch_test(domain, threadErrs, err)!{{{ call mpas_timer_start('halo exch tests') if ( threadNum == 0 ) then - call mpas_log_write(' - Performing exchange group tests') + call mpas_log_write(' - Performing group halo exchange tests') end if call test_core_halo_exch_group_test(domain, threadErrs, iErr) call mpas_threading_barrier() @@ -80,6 +81,16 @@ subroutine test_core_halo_exch_test(domain, threadErrs, err)!{{{ err = ior(err, iErr) end if + if ( threadNum == 0 ) then + call mpas_log_write(' - Performing halo exchange adjoint tests') + end if + call test_halo_adj_exch_fields(domain, threadErrs, iErr) + call mpas_threading_barrier() + if ( threadNum == 0 ) then + call mpas_log_write(' -- Return code: $i', intArgs=(/iErr/)) + err = ior(err, iErr) + end if + call mpas_timer_stop('halo exch tests') end subroutine test_core_halo_exch_test!}}} @@ -104,8 +115,7 @@ subroutine test_core_halo_exch_full_test(domain, threadErrs, err)!{{{ integer, dimension(:), intent(out) :: threadErrs integer, intent(out) :: err - type (block_type), pointer :: block - type (mpas_pool_type), pointer :: meshPool, haloExchTestPool + type (mpas_pool_type), pointer :: haloExchTestPool type (field5DReal), pointer :: real5DField type (field4DReal), pointer :: real4DField @@ -116,27 +126,7 @@ subroutine test_core_halo_exch_full_test(domain, threadErrs, err)!{{{ type (field2DInteger), pointer :: int2DField type (field1DInteger), pointer :: int1DField - real (kind=RKIND), dimension(:, :, :, :, :), pointer :: real5D - real (kind=RKIND), dimension(:, :, :, :), pointer :: real4D - real (kind=RKIND), dimension(:, :, :), pointer :: real3D - real (kind=RKIND), dimension(:, :), pointer :: real2D - real (kind=RKIND), dimension(:), pointer :: real1D - - real (kind=RKIND) :: realValue - integer :: integerValue - - integer, dimension(:, :, :), pointer :: int3D - integer, dimension(:, :), pointer :: int2D - integer, dimension(:), pointer :: int1D - - integer :: i, j, k, l, m - integer :: iDim1, iDim2, iDim3, iDim4, iDim5 - integer, pointer :: nCells, nEdges, nVertices - integer, pointer :: nCellsSolve, nEdgesSolve, nVerticesSolve - integer, dimension(:), pointer :: indexToCellID - integer, dimension(:), pointer :: indexToEdgeID - integer, dimension(:), pointer :: indexToVertexID - + integer :: iErr integer :: threadNum threadNum = mpas_threading_get_thread_num() + 1 @@ -269,7 +259,8 @@ subroutine test_core_halo_exch_full_test(domain, threadErrs, err)!{{{ call mpas_threading_barrier() - call test_core_halo_exch_validate_fields(domain, threadErrs, err) + call test_core_halo_exch_validate_fields(domain, threadErrs, iErr) + err = ior(err, iErr) end subroutine test_core_halo_exch_full_test!}}} @@ -992,6 +983,131 @@ subroutine test_core_halo_exch_setup_fields(domain, threadErrs, err)!{{{ end subroutine test_core_halo_exch_setup_fields!}}} + !*********************************************************************** + ! routine computeErrors + ! + !> \brief compare the provided array elements with the provided + !> expected values + !> \details + !> Goes through the provided data arrays, comparing data elements with corresponding + !> values in an array of expected values. + !> Return non-zero if any elements don't match their expected value, + !> else return zero + !----------------------------------------------------------------------- + function computeErrors(nColumns, expectedValues, real5D, real4D, real3D, real2D, real1D, & + int3d, int2d, int1d) result(errorCode) + + integer, intent(in) :: nColumns !< the outermost dimension size to be checked + integer, dimension(:), pointer, intent(in) :: expectedValues !< an array of expected values + !< the following are multi-dimension arrays whose elements are checked + real (kind=RKIND), dimension(:, :, :, :, :), pointer, intent(inout) :: real5D + real (kind=RKIND), dimension(:, :, :, :), pointer, intent(inout) :: real4D + real (kind=RKIND), dimension(:, :, :), pointer, intent(inout) :: real3D + real (kind=RKIND), dimension(:, :), pointer, intent(inout) :: real2D + real (kind=RKIND), dimension(:), pointer, intent(inout) :: real1D + integer, dimension(:, :, :), pointer, intent(inout) :: int3D + integer, dimension(:, :), pointer, intent(inout) :: int2D + integer, dimension(:), pointer, intent(inout) :: int1D + + integer :: iDim2, iDim3, iDim4, iDim5 + integer :: i, j, k, l, m + integer integerValue + real (kind=RKIND) realValue + integer errorCode + + iDim2 = size(real5D, dim=4) + iDim3 = size(real5D, dim=3) + iDim4 = size(real5D, dim=2) + iDim5 = size(real5D, dim=1) + + errorCode = 0 + !$omp do schedule(runtime) private(j, k, l, m, realValue, integerValue) + do i = 1, nColumns + realValue = real(expectedValues(i), kind=RKIND) + integerValue = expectedValues(i) + do j = 1, iDim2 + do k = 1, iDim3 + do l = 1, iDim4 + do m = 1, iDim5 + if (real5D(m, l, k, j, i) - realValue /= 0.0_RKIND) then + errorCode = 1 +#ifdef HALO_EXCH_DEBUG + call mpas_log_write(' real5D($i, $i, $i, $i, $i) - realValue:$r', & + intArgs=(/m, l, k, j, i/), realArgs=(/real5D(m, l, k, j, i) - realValue/)) +#else + return +#endif + end if + end do + if (real4D(l, k, j, i) - realValue /= 0.0_RKIND) then + errorCode = 1 +#ifdef HALO_EXCH_DEBUG + call mpas_log_write(' real4D($i, $i, $i, $i) - realValue:$r', & + intArgs=(/l, k, j, i/), realArgs=(/real4D(l, k, j, i) - realValue/)) +#else + return +#endif + end if + end do + if (real3D(k, j, i) - realValue /= 0.0_RKIND) then + errorCode = 1 +#ifdef HALO_EXCH_DEBUG + call mpas_log_write(' real3D($i, $i, $i) - realValue:$r', & + intArgs=(/k, j, i/), realArgs=(/real3D(k, j, i) - realValue/)) +#else + return +#endif + endif + if (int3D(k, j, i) - integerValue /= 0) then + errorCode = 1 +#ifdef HALO_EXCH_DEBUG + call mpas_log_write(' int3D($i, $i, $i, $i, $i) - intValue:$i', & + intArgs=(/k, j, i, int3D(k, j, i) - integerValue/)) +#else + return +#endif + end if + end do + if (real2D(j, i) - realValue /= 0.0_RKIND) then + errorCode = 1 +#ifdef HALO_EXCH_DEBUG + call mpas_log_write(' real2D($i, $i) - realValue:$r', & + intArgs=(/j, i/), realArgs=(/real2D(j, i) - realValue/)) +#else + return +#endif + end if + if (int2D(j, i) - integerValue /= 0) then + errorCode = 1 +#ifdef HALO_EXCH_DEBUG + call mpas_log_write(' int2D($i, $i) - integerValue:$i', & + intArgs=(/j, i, int2D(j, i) - integerValue/)) +#else + return +#endif + end if + end do + if (real1D(i) - realValue /= 0.0_RKIND) then + errorCode = 1 +#ifdef HALO_EXCH_DEBUG + call mpas_log_write(' real1D($i) - realValue:$r', & + intArgs=(/i/), realArgs=(/real1D(i) - realValue/)) +#else + return +#endif + end if + if (int1D(i) - integerValue /= 0) then + errorCode = 1 +#ifdef HALO_EXCH_DEBUG + call mpas_log_write(' int1D($i) - integerValue:$i', & + intArgs=(/i, int1D(i) - integerValue/)) +#else + return +#endif + endif + end do + end function computeErrors + !*********************************************************************** ! ! routine test_core_halo_exch_validate_fields @@ -1031,15 +1147,10 @@ subroutine test_core_halo_exch_validate_fields(domain, threadErrs, err)!{{{ real (kind=RKIND), dimension(:, :), pointer :: real2D real (kind=RKIND), dimension(:), pointer :: real1D - real (kind=RKIND) :: realValue - integer :: integerValue - integer, dimension(:, :, :), pointer :: int3D integer, dimension(:, :), pointer :: int2D integer, dimension(:), pointer :: int1D - integer :: i, j, k, l, m - integer :: iDim1, iDim2, iDim3, iDim4, iDim5 integer, pointer :: nCells, nEdges, nVertices integer, pointer :: nCellsSolve, nEdgesSolve, nVerticesSolve integer, dimension(:), pointer :: indexToCellID @@ -1083,71 +1194,13 @@ subroutine test_core_halo_exch_validate_fields(domain, threadErrs, err)!{{{ call mpas_pool_get_array(haloExchTestPool, 'cellPersistInt2D', int2D) call mpas_pool_get_array(haloExchTestPool, 'cellPersistInt1D', int1D) - ! Subtract index from all peristent cell fields - iDim1 = size(real5D, dim=5) - iDim2 = size(real5D, dim=4) - iDim3 = size(real5D, dim=3) - iDim4 = size(real5D, dim=2) - iDim5 = size(real5D, dim=1) - - !$omp do schedule(runtime) private(j, k, l, m, realValue, integerValue) - do i = 1, iDim1 - realValue = real(indexToCellID(i), kind=RKIND) - integerValue = indexToCellID(i) - do j = 1, iDim2 - do k = 1, iDim3 - do l = 1, iDim4 - do m = 1, iDim5 - real5D(m, l, k, j, i) = real5D(m, l, k, j, i) - realValue - end do - real4D(l, k, j, i) = real4D(l, k, j, i) - realValue - end do - real3D(k, j, i) = real3D(k, j, i) - realValue - int3D(k, j, i) = int3D(k, j, i) - integerValue - end do - real2D(j, i) = real2D(j, i) - realValue - int2D(j, i) = int2D(j, i) - integerValue - end do - real1D(i) = real1D(i) - realValue - int1D(i) = int1D(i) - integerValue - end do - !$omp end do - ! Validate that all differences are zero. #ifdef HALO_EXCH_DEBUG call mpas_log_write(' -- Testing persistent cell fields') #endif - if ( sum(real5D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(real4D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(real3D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(real2D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(real1D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if + threadErrs(threadNum) = computeErrors(nCells, indexToCellID, real5D, real4D, real3D, real2D, real1D, & + int3d, int2d, int1d) - if ( sum(int3D) /= 0 ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(int2D) /= 0 ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(int1D) /= 0 ) then - threadErrs(threadNum) = 1 - end if #ifdef HALO_EXCH_DEBUG call mpas_log_write(' -- Test result: $i', intArgs=(/threadErrs(threadNum)/)) #endif @@ -1162,71 +1215,13 @@ subroutine test_core_halo_exch_validate_fields(domain, threadErrs, err)!{{{ call mpas_pool_get_array(haloExchTestPool, 'edgePersistInt2D', int2D) call mpas_pool_get_array(haloExchTestPool, 'edgePersistInt1D', int1D) - ! Subtract index from all peristent edge fields - iDim1 = size(real5D, dim=5) - iDim2 = size(real5D, dim=4) - iDim3 = size(real5D, dim=3) - iDim4 = size(real5D, dim=2) - iDim5 = size(real5D, dim=1) - - !$omp do schedule(runtime) private(j, k, l, m, realValue, integerValue) - do i = 1, iDim1 - realValue = real(indexToEdgeID(i), kind=RKIND) - integerValue = indexToEdgeID(i) - do j = 1, iDim2 - do k = 1, iDim3 - do l = 1, iDim4 - do m = 1, iDim5 - real5D(m, l, k, j, i) = real5D(m, l, k, j, i) - realValue - end do - real4D(l, k, j, i) = real4D(l, k, j, i) - realValue - end do - real3D(k, j, i) = real3D(k, j, i) - realValue - int3D(k, j, i) = int3D(k, j, i) - integerValue - end do - real2D(j, i) = real2D(j, i) - realValue - int2D(j, i) = int2D(j, i) - integerValue - end do - real1D(i) = real1D(i) - realValue - int1D(i) = int1D(i) - integerValue - end do - !$omp end do - ! Validate that all differences are zero. #ifdef HALO_EXCH_DEBUG call mpas_log_write(' -- Testing persistent Edge fields') #endif - if ( sum(real5D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if + threadErrs(threadNum) = computeErrors(nEdges, indexToEdgeID, real5D, real4D, real3D, real2D, real1D, & + int3d, int2d, int1d) - if ( sum(real4D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(real3D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(real2D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(real1D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(int3D) /= 0 ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(int2D) /= 0 ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(int1D) /= 0 ) then - threadErrs(threadNum) = 1 - end if #ifdef HALO_EXCH_DEBUG call mpas_log_write(' -- Test result: $i', intArgs=(/threadErrs(threadNum)/)) #endif @@ -1241,63 +1236,13 @@ subroutine test_core_halo_exch_validate_fields(domain, threadErrs, err)!{{{ call mpas_pool_get_array(haloExchTestPool, 'vertexPersistInt2D', int2D) call mpas_pool_get_array(haloExchTestPool, 'vertexPersistInt1D', int1D) - ! Subtract index from all peristent vertex fields - iDim1 = size(real5D, dim=5) - iDim2 = size(real5D, dim=4) - iDim3 = size(real5D, dim=3) - iDim4 = size(real5D, dim=2) - iDim5 = size(real5D, dim=1) - - !$omp do schedule(runtime) private(j, k, l, m, realValue, integerValue) - do i = 1, iDim1 - realValue = real(indexToVertexID(i), kind=RKIND) - integerValue = indexToVertexID(i) - do j = 1, iDim2 - do k = 1, iDim3 - do l = 1, iDim4 - do m = 1, iDim5 - real5D(m, l, k, j, i) = real5D(m, l, k, j, i) - realValue - end do - real4D(l, k, j, i) = real4D(l, k, j, i) - realValue - end do - real3D(k, j, i) = real3D(k, j, i) - realValue - int3D(k, j, i) = int3D(k, j, i) - integerValue - end do - real2D(j, i) = real2D(j, i) - realValue - int2D(j, i) = int2D(j, i) - integerValue - end do - real1D(i) = real1D(i) - realValue - int1D(i) = int1D(i) - integerValue - end do - !$omp end do - ! Validate that all differences are zero. #ifdef HALO_EXCH_DEBUG call mpas_log_write(' -- Testing persistent Vertex fields') #endif - if ( sum(real5D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(real4D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if + threadErrs(threadNum) = computeErrors(nVertices, indexToVertexID, real5D, real4D, real3D, real2D, real1D, & + int3d, int2d, int1d) - if ( sum(real3D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(real2D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(real1D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(int3D) /= 0 ) then - threadErrs(threadNum) = 1 - end if #ifdef HALO_EXCH_DEBUG call mpas_log_write(' -- Test result: $i', intArgs=(/threadErrs(threadNum)/)) #endif @@ -1312,71 +1257,13 @@ subroutine test_core_halo_exch_validate_fields(domain, threadErrs, err)!{{{ call mpas_pool_get_array(haloExchTestPool, 'cellScratchInt2D', int2D) call mpas_pool_get_array(haloExchTestPool, 'cellScratchInt1D', int1D) - ! Subtract index from all peristent cell fields - iDim1 = size(real5D, dim=5) - iDim2 = size(real5D, dim=4) - iDim3 = size(real5D, dim=3) - iDim4 = size(real5D, dim=2) - iDim5 = size(real5D, dim=1) - - !$omp do schedule(runtime) private(j, k, l, m, realValue, integerValue) - do i = 1, iDim1 - realValue = real(indexToCellID(i), kind=RKIND) - integerValue = indexToCellID(i) - do j = 1, iDim2 - do k = 1, iDim3 - do l = 1, iDim4 - do m = 1, iDim5 - real5D(m, l, k, j, i) = real5D(m, l, k, j, i) - realValue - end do - real4D(l, k, j, i) = real4D(l, k, j, i) - realValue - end do - real3D(k, j, i) = real3D(k, j, i) - realValue - int3D(k, j, i) = int3D(k, j, i) - integerValue - end do - real2D(j, i) = real2D(j, i) - realValue - int2D(j, i) = int2D(j, i) - integerValue - end do - real1D(i) = real1D(i) - realValue - int1D(i) = int1D(i) - integerValue - end do - !$omp end do - ! Validate that all differences are zero. #ifdef HALO_EXCH_DEBUG call mpas_log_write(' -- Testing scratch cell fields') #endif - if ( sum(real5D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(real4D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(real3D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(real2D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if + threadErrs(threadNum) = computeErrors(nCells, indexToCellID, real5D, real4D, real3D, real2D, real1D, & + int3d, int2d, int1d) - if ( sum(real1D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(int3D) /= 0 ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(int2D) /= 0 ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(int1D) /= 0 ) then - threadErrs(threadNum) = 1 - end if #ifdef HALO_EXCH_DEBUG call mpas_log_write(' -- Test result: $i', intArgs=(/threadErrs(threadNum)/)) #endif @@ -1391,73 +1278,15 @@ subroutine test_core_halo_exch_validate_fields(domain, threadErrs, err)!{{{ call mpas_pool_get_array(haloExchTestPool, 'edgeScratchInt2D', int2D) call mpas_pool_get_array(haloExchTestPool, 'edgeScratchInt1D', int1D) - ! Subtract index from all peristent edge fields - iDim1 = size(real5D, dim=5) - iDim2 = size(real5D, dim=4) - iDim3 = size(real5D, dim=3) - iDim4 = size(real5D, dim=2) - iDim5 = size(real5D, dim=1) - - !$omp do schedule(runtime) private(j, k, l, m) - do i = 1, iDim1 - realValue = real(indexToEdgeID(i), kind=RKIND) - integerValue = indexToEdgeID(i) - do j = 1, iDim2 - do k = 1, iDim3 - do l = 1, iDim4 - do m = 1, iDim5 - real5D(m, l, k, j, i) = real5D(m, l, k, j, i) - realValue - end do - real4D(l, k, j, i) = real4D(l, k, j, i) - realValue - end do - real3D(k, j, i) = real3D(k, j, i) - realValue - int3D(k, j, i) = int3D(k, j, i) - integerValue - end do - real2D(j, i) = real2D(j, i) - realValue - int2D(j, i) = int2D(j, i) - integerValue - end do - real1D(i) = real1D(i) - realValue - int1D(i) = int1D(i) - integerValue - end do - !$omp end do - ! Validate that all differences are zero. #ifdef HALO_EXCH_DEBUG call mpas_log_write(' -- Testing scratch edge fields') #endif - if ( sum(real5D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(real4D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(real3D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(real2D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(real1D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(int3D) /= 0 ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(int2D) /= 0 ) then - threadErrs(threadNum) = 1 - end if + threadErrs(threadNum) = computeErrors(nEdges, indexToEdgeID, real5D, real4D, real3D, real2D, real1D, & + int3d, int2d, int1d) - if ( sum(int1D) /= 0 ) then - threadErrs(threadNum) = 1 - end if #ifdef HALO_EXCH_DEBUG - call mpas_log_write(' -- Test result: $i', intArgs=(/threadErrs(threadNum)/) + call mpas_log_write(' -- Test result: $i', intArgs=(/threadErrs(threadNum)/)) #endif ! Compare scratch vertex fields @@ -1470,77 +1299,19 @@ subroutine test_core_halo_exch_validate_fields(domain, threadErrs, err)!{{{ call mpas_pool_get_array(haloExchTestPool, 'vertexScratchInt2D', int2D) call mpas_pool_get_array(haloExchTestPool, 'vertexScratchInt1D', int1D) - ! Subtract index from all peristent vertex fields - iDim1 = size(real5D, dim=5) - iDim2 = size(real5D, dim=4) - iDim3 = size(real5D, dim=3) - iDim4 = size(real5D, dim=2) - iDim5 = size(real5D, dim=1) - - !$omp do schedule(runtime) private(j, k, l, m, realValue, integerValue) - do i = 1, iDim1 - realValue = real(indexToVertexID(i), kind=RKIND) - integerValue = indexToVertexID(i) - do j = 1, iDim2 - do k = 1, iDim3 - do l = 1, iDim4 - do m = 1, iDim4 - real5D(m, l, k, j, i) = real5D(m, l, k, j, i) - realValue - end do - real4D(l, k, j, i) = real4D(l, k, j, i) - realValue - end do - real3D(k, j, i) = real3D(k, j, i) - realValue - int3D(k, j, i) = int3D(k, j, i) - integerValue - end do - real2D(j, i) = real2D(j, i) - realValue - int2D(j, i) = int2D(j, i) - integerValue - end do - real1D(i) = real1D(i) - realValue - int1D(i) = int1D(i) - integerValue - end do - !$omp end do - ! Validate that all differences are zero. #ifdef HALO_EXCH_DEBUG call mpas_log_write(' -- Testing scratch vertex fields') #endif - if ( sum(real5D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(real4D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(real3D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(real2D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(real1D) /= 0.0_RKIND ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(int3D) /= 0 ) then - threadErrs(threadNum) = 1 - end if + threadErrs(threadNum) = computeErrors(nVertices, indexToVertexID, real5D, real4D, real3D, real2D, real1D, & + int3d, int2d, int1d) - if ( sum(int2D) /= 0 ) then - threadErrs(threadNum) = 1 - end if - - if ( sum(int1D) /= 0 ) then - threadErrs(threadNum) = 1 - end if #ifdef HALO_EXCH_DEBUG call mpas_log_write(' -- Test result: $i', intArgs=(/threadErrs(threadNum)/)) #endif block => block % next - end do + end do call mpas_threading_barrier() @@ -1613,5 +1384,262 @@ subroutine test_core_halo_exch_validate_fields(domain, threadErrs, err)!{{{ end subroutine test_core_halo_exch_validate_fields!}}} + !*********************************************************************** + !> \brief Identify cells that are adjacent to other marked cells + !> \author Michael Duda + !> \date 24 January 2024 + !> \details + !> Given a cell mask field, cellMask, and a specified (positive) non-zero mask + !> value, sentinelValue, this routine sets the cell mask field to (sentinelValue+1) + !> for all cells that are (1) adjacent to cells with the sentinelValue mask value + !> and (2) that have an initial cellMask value of zero. + !> + !> Cell adjacency is determined by the cellsOnCell and nEdgesOnCell fields. + !> + !> This routine returns the total number of cells that were marked as being + !> adjacent to cells with the sentinelValue mask value. + !----------------------------------------------------------------------- + function mark_interior_cells(cellMask, sentinelValue, cellsOnCell, nEdgesOnCell) result(nCellsMarked) + + ! Arguments + integer, dimension(:), intent(inout) :: cellMask !< mask field + integer, intent(in) :: sentinelValue !< value in mask field for which adjacent cells are marked + integer, dimension(:,:), intent(in) :: cellsOnCell !< indices of cell neighbors for each cell + integer, dimension(:), intent(in) :: nEdgesOnCell !< number of cell neighbors for each cell + + ! Return value + integer :: nCellsMarked + + ! Local variables + integer :: iCell, j + + + nCellsMarked = 0 + + do iCell = 1, size(cellMask) + if (cellMask(iCell) == 0) then + do j = 1, nEdgesOnCell(iCell) + if (cellMask(cellsOnCell(j, iCell)) == sentinelValue) then + cellMask(iCell) = sentinelValue + 1 + nCellsMarked = nCellsMarked + 1 +#ifdef HALO_EXCH_DEBUG_VERBOSE + call mpas_log_write(' mark_interior iCell:$i abuts:$i', & + intArgs = (/iCell, cellsOnCell(j,iCell)/)) +#endif + exit + end if + end do + end if + end do + +#ifdef HALO_EXCH_DEBUG_VERBOSE + call mpas_log_write(' mark_interior nCellsMarked:$i sentinel:$i', & + intArgs=(/nCellsMarked, sentinelValue/)) +#endif + + end function mark_interior_cells + + !*********************************************************************** + !> \brief Identify cells in the outermost N layers of owned cells in a block + !> \author Jim Wittig, Michael Duda + !> \date 29 January 2024 + !> \details + !> This function identifies cells that are in the outermost N layers of owned + !> cells in a block, where N is the number of halo layers (nHaloLayers). The + !> function returns an array of values indicating the location of a cell. + !> In the returned array, a value of zero indicates that the cell is not in + !> the outermost N layers of owned cells, and non-zero values indicate: + !> 1. the cell is a halo cell (not owned by this block) + !> 2. the cell is a distance of 1 away from a halo cell (i.e., adjacent to a halo cell) + !> 3. the cell is a distance of 2 away from a halo cell (i.e., adjacent to a cell marked '2') + !> 4. the cell is a distance of 3 away from a halo cell (i.e., adjacent to a cell marked '3') + !> + !> The result of this routine may be used to determine which cells will be modified + !> by the adjoint of a halo exchange; for example: + !> - cells marked with a 2 will be updated from halo layer 1, + !> - cells marked with a 3 will be updated from halo layer 2, etc. + !> + !----------------------------------------------------------------------- + function findExteriorCells(nCellsSolve, nCells, cellsOnCell, edgesOnCell, nHaloLayers) & + result(exteriorCells) + + ! Arguments + integer, intent(in) :: nCellsSolve !< the number of cells in this block + integer, intent(in) :: nCells !< total number of cells (cells in this block plus halo cells) + integer, dimension(:,:), intent(in) :: cellsOnCell !< array with adjacent cells for each cell + integer, dimension(:), intent(in) :: edgesOnCell !< array with edges for each cell + integer, intent(in) :: nHaloLayers !< the number of halo layers + + ! Return value + integer, dimension(:), allocatable :: exteriorCells + + ! Local variables + integer nInterior, nEdge, nLayers + + allocate(exteriorCells(nCells)) + exteriorCells(1:nCellsSolve) = 0 !< mark all owned cells as interior + exteriorCells(nCellsSolve+1:nCells) = 1 !< mark all halo cells as edge + nInterior = 0 + nEdge = 0 +#ifdef HALO_EXCH_DEBUG_VERBOSE + call mpas_log_write(' halo cellsOnCell($i x $i)', & + intArgs=(/size(cellsOnCell, dim=1), size(cellsOnCell, dim=2)/)) +#endif + + ! At this point, only halo cells are marked 1, and all owned cells are marked 0 + ! for each halo layer, mark cells adjacent to already marked cells with next highest marker + do nLayers = 1, nHaloLayers + nEdge = nEdge + mark_interior_cells(exteriorCells(1:nCells), nLayers, cellsOnCell, edgesOnCell) + end do + + nInterior = nCellsSolve - nEdge + +#ifdef HALO_EXCH_DEBUG_VERBOSE + call mpas_log_write(' halo nInterior:$i nEdge:$i', intArgs=(/nInterior, nEdge/)) +#endif + + end function findExteriorCells + + !*********************************************************************** + !> \brief MPAS Test Core halo adjoint exchange + !> \author Jim Wittig + !> \date 29 January 2024 + !> \details + !> This routine applies the adjoint of a halo exchangeto a 2-d array and + !> verifies that (1) the values for cells more than a distance N away from + !> a halo cell do not change (where N is the number of halo layers), and + !> (2) cells within a distance of N from a halo cell are updated. + !> + !> This routine assumes that a halo exchange has already been applied to + !> the cellPersistReal2D field before this routine has been called. + !> + !> Upon success, a value of 0 is returned; otherwise, a non-zero status + !> code is returned. + !----------------------------------------------------------------------- + subroutine test_halo_adj_exch_fields(domain, threadErrs, err) + + ! Arguments + type (domain_type), intent(inout) :: domain + integer, dimension(:), intent(out) :: threadErrs + integer, intent(out) :: err + + ! Local variables + type (block_type), pointer :: block + type (mpas_pool_type), pointer :: meshPool, haloExchTestPool + type (field2DReal), pointer :: real2DField + real (kind=RKIND), dimension(:, :), pointer :: real2D + real (kind=RKIND), dimension(:, :), allocatable :: real2Dorig + integer, dimension(:,:), pointer :: cellsOnCell + integer, dimension(:), pointer :: nEdgesOnCell + integer, dimension(:), allocatable :: exteriorCells + integer, pointer :: nCells, nCellsSolve + integer :: iCell, iEdgeOnCell, nInterior, nEdge, nHaloLayers + + err = 0 + + ! get a variable to call the adjoint halo on + block => domain % blocklist + + call mpas_pool_get_subpool(block % structs, 'haloExchTest', haloExchTestPool) + call mpas_pool_get_subpool(block % structs, 'mesh', meshPool) + call mpas_pool_get_field(haloExchTestPool, 'cellPersistReal2D', real2DField) + call mpas_pool_get_dimension(haloExchTestPool, 'nCells', nCells) + call mpas_pool_get_dimension(haloExchTestPool, 'nCellsSolve', nCellsSolve) +#ifdef HALO_EXCH_DEBUG_VERBOSE + call mpas_log_write(' test_halo_adj_exch_fields nCellsSolve:$i nCells:$i', & + intArgs=(/nCellsSolve, nCells/)) +#endif + + ! make a copy of the data before applying the adjoint halo + call mpas_pool_get_array(haloExchTestPool, 'cellPersistReal2D', real2D) + allocate(real2Dorig(size(real2D, 2), size(real2D, 1))) + real2Dorig = real2D + + ! find cells with adjoining ghost cells + call MPAS_pool_get_array(meshPool, 'cellsOnCell', cellsOnCell) + call MPAS_pool_get_array(meshPool, 'nEdgesOnCell', nEdgesOnCell) +#ifdef HALO_EXCH_DEBUG_VERBOSE + call mpas_log_write(' halo_adj_ cellsOnCell size:$ix$i', & + intArgs=(/size(cellsOnCell,2), size(cellsOnCell, 1)/)) +#endif + + nHaloLayers = size(real2DField % sendList % halos) + exteriorCells = findExteriorCells(nCellsSolve, nCells, cellsOnCell, nEdgesOnCell, nHaloLayers) + + ! run the adjoint halo, this will update owned cells + call mpas_dmpar_exch_halo_adj_field(real2DField) + + do while ( associated(block) ) + + ! get the real2D array after calling mpas_dmpar_exch_halo_adj_field + call mpas_pool_get_array(haloExchTestPool, 'cellPersistReal2D', real2D) + + ! check the adjoint halo operation populated fields correctly + err = check_adjoint_values(nCellsSolve, real2Dorig, real2D, exteriorCells) + block => block % next + end do + + end subroutine test_halo_adj_exch_fields + + !*********************************************************************** + !> \brief MPAS Test check pre and post adjoint exchange values + !> \author Jim Wittig + !> \date 29 January 2024 + !> \details + !> This routine checks the pre-adjoint halo exchange values aganst + !> post-adjoint halo exhange values. + !> Interior cell's values aren't expected to change, and border cell's values are + !> expected to change. + !> Returns 0 on success, non-0 on failure. + !----------------------------------------------------------------------- + integer function check_adjoint_values(nCellsSolve, orig, adjoint, exteriorCells) + + integer, pointer, intent(in) :: nCellsSolve !< the number of local owned cells + real (kind=RKIND), dimension(:,:), intent(in) :: orig !< values of the cells before applying the adjoint exchange + real (kind=RKIND), dimension(:,:), intent(in) :: adjoint !< values of cells after applying the adjoint exchange + integer, dimension(:), intent(in) :: exteriorCells !< array indicating a cell is interior or on the edge + + integer :: i, j, nError, nInterior, nEdge + integer :: iDim1, iDim2 + + nError = 0 + iDim1 = nCellsSolve + iDim2 = size(orig, dim=1) + nInterior = 0 + nEdge = 0 + + do i = 1, iDim1 + do j = 1, iDim2 + if (exteriorCells(i) == 0) then + if (j == 1) then + nInterior = nInterior + 1 + ! interior cells shouldn't have changed + if (orig(j, i) /= adjoint(j, i)) then + call mpas_log_write(' halo changed value for interior cell at:$i:$i orig:$r new:$r', & + intArgs=(/j,i/), realArgs=(/orig(j,i), adjoint(j,i)/)) + nError = nError + 1 + end if + end if + else + if (j == 1) then + nEdge = nEdge + 1 + ! edge cells should change + if (orig(j, i) == adjoint(j, i)) then + call mpas_log_write(' halo unchanged value for edge cell at:$i:$i $r vs $r', & + intArgs=(/i,j/), realArgs=(/orig(j, i), adjoint(j, i)/)) + nError = nError + 1 + end if + end if + end if + end do + end do +#ifdef HALO_EXCH_DEBUG_VERBOSE + call mpas_log_write(' halo nInterior:$i nEdge:$i, nError:$i', & + intArgs=(/nInterior, nEdge, nError/)) +#endif + + check_adjoint_values = nError + + end function check_adjoint_values end module test_core_halo_exch diff --git a/src/core_test/mpas_test_core_interface.F b/src/core_test/mpas_test_core_interface.F index c0bce7d7f..e600824bc 100644 --- a/src/core_test/mpas_test_core_interface.F +++ b/src/core_test/mpas_test_core_interface.F @@ -89,13 +89,14 @@ end subroutine test_setup_domain!}}} !> *not* allocated until after this routine is called. ! !----------------------------------------------------------------------- - function test_setup_packages(configPool, packagePool, iocontext) result(ierr)!{{{ + function test_setup_packages(configPool, streamInfo, packagePool, iocontext) result(ierr)!{{{ use mpas_derived_types implicit none type (mpas_pool_type), intent(inout) :: configPool + type (MPAS_streamInfo_type), intent(inout) :: streamInfo type (mpas_pool_type), intent(inout) :: packagePool type (mpas_io_context_type), intent(inout) :: iocontext integer :: ierr @@ -226,6 +227,7 @@ function test_setup_log(logInfo, domain, unitNumbers) result(iErr)!{{{ use mpas_derived_types use mpas_log + use mpas_framework, only : mpas_framework_report_settings implicit none @@ -251,6 +253,8 @@ function test_setup_log(logInfo, domain, unitNumbers) result(iErr)!{{{ call mpas_log_open(err=local_err) iErr = ior(iErr, local_err) + call mpas_framework_report_settings(domain) + end function test_setup_log!}}} @@ -268,7 +272,7 @@ end function test_setup_log!}}} !> are available. ! !----------------------------------------------------------------------- - function test_get_mesh_stream(configs, stream) result(ierr)!{{{ + function test_get_mesh_stream(configs, streamInfo, stream) result(ierr)!{{{ use mpas_derived_types use mpas_pool_routines @@ -276,6 +280,7 @@ function test_get_mesh_stream(configs, stream) result(ierr)!{{{ implicit none type (mpas_pool_type), intent(inout) :: configs + type (MPAS_streamInfo_type), intent(inout) :: streamInfo character(len=StrKIND), intent(out) :: stream integer :: ierr diff --git a/src/core_test/mpas_test_core_stream_inquiry.F b/src/core_test/mpas_test_core_stream_inquiry.F new file mode 100644 index 000000000..796e46fbb --- /dev/null +++ b/src/core_test/mpas_test_core_stream_inquiry.F @@ -0,0 +1,225 @@ +! Copyright (c) 2023 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 https://mpas-dev.github.io/license.html . +! +module mpas_test_core_stream_inquiry + + use mpas_derived_types, only : dm_info, MPAS_streamInfo_type + use mpas_log, only : mpas_log_write + + private + + public :: mpas_test_stream_inquiry + + + contains + + + !----------------------------------------------------------------------- + ! routine mpas_test_stream_inquiry + ! + !> \brief Main driver for tests of the mpas_stream_inquiry module + !> \author Michael Duda + !> \date 17 November 2023 + !> \details + !> This routine invokes tests for individual routines in the + !> mpas_stream_inquiry module, and reports PASSED/FAILED for each of + !> those tests. + !> + !> Return value: The total number of test that failed on any MPI rank. + ! + !----------------------------------------------------------------------- + function mpas_test_stream_inquiry(dminfo) result(ierr_count) + + use mpas_kind_types, only : StrKIND + use mpas_dmpar, only : mpas_dmpar_max_int + use mpas_stream_inquiry, only : MPAS_stream_inquiry_new_streaminfo + + implicit none + + ! Arguments + type (dm_info), intent(inout) :: dminfo + + ! Return value + integer :: ierr_count + + ! Local variables + integer :: ierr, ierr_global + character(len=StrKIND) :: routine_name + type (MPAS_streamInfo_type), pointer :: streamInfo + + ierr_count = 0 + + call mpas_log_write('--- Begin stream_inquiry tests') + + ! + ! Create a new instance of the MPAS_streamInfo_type derived type + ! + nullify(streamInfo) + streamInfo => MPAS_stream_inquiry_new_streaminfo() + + ! + ! Initialize the instance with the streams.test file + ! A failure here on any task causes this routine to return early + ! + routine_name = 'streamInfo % init' + ierr = streamInfo % init(dminfo % comm, 'streams.test') + call mpas_dmpar_max_int(dminfo, ierr, ierr_global) + if (ierr_global == 0) then + call mpas_log_write(' '//trim(routine_name)//' - PASSED') + else + ierr_count = ierr_count + 1 + call mpas_log_write(' '//trim(routine_name)//' - FAILED') + deallocate(streamInfo) + return + end if + + ! + ! Test streamInfo % query routine + ! + routine_name = 'streamInfo % query' + ierr = test_streaminfo_query(streamInfo) + call mpas_dmpar_max_int(dminfo, ierr, ierr_global) + if (ierr_global == 0) then + call mpas_log_write(' '//trim(routine_name)//' - PASSED') + else + ierr_count = ierr_count + 1 + call mpas_log_write(' '//trim(routine_name)//' - FAILED') + end if + + ! + ! Finalize the MPAS_streamInfo_type instance + ! + routine_name = 'streamInfo % finalize' + ierr = streamInfo % finalize() + call mpas_dmpar_max_int(dminfo, ierr, ierr_global) + if (ierr_global == 0) then + call mpas_log_write(' '//trim(routine_name)//' - PASSED') + else + ierr_count = ierr_count + 1 + call mpas_log_write(' '//trim(routine_name)//' - FAILED') + end if + + deallocate(streamInfo) + + end function mpas_test_stream_inquiry + + + !----------------------------------------------------------------------- + ! routine test_streaminfo_query + ! + !> \brief Tests the streaminfo_query / streamInfo % query routine + !> \author Michael Duda + !> \date 17 November 2023 + !> \details + !> This routine tests the streaminfo_query routine. + !> + !> Return value: The total number of test that failed on the calling rank. + ! + !----------------------------------------------------------------------- + function test_streaminfo_query(streamInfo) result(ierr_count) + + use mpas_kind_types, only : StrKIND + + implicit none + + ! Arguments + type (MPAS_streamInfo_type), intent(inout) :: streamInfo + + ! Return value + integer :: ierr_count + + ! Local variables + logical :: success + character(len=StrKIND) :: attvalue + + ierr_count = 0 + + + ! + ! Query about the existence of an immutable stream that exists + ! + if (streamInfo % query('input')) then + call mpas_log_write(' query existence of an immutable stream that exists - PASSED') + else + call mpas_log_write(' query existence of an immutable stream that exists - FAILED') + ierr_count = ierr_count + 1 + end if + + ! + ! Query about the existence of a mutable stream that exists + ! + if (streamInfo % query('mutable_test')) then + call mpas_log_write(' query existence of a mutable stream that exists - PASSED') + else + call mpas_log_write(' query existence of a mutable stream that exists - FAILED') + ierr_count = ierr_count + 1 + end if + + ! + ! Query about the existence of a stream that does not exist + ! + if (.not. streamInfo % query('foobar')) then + call mpas_log_write(' query existence of a stream that does not exist - PASSED') + else + call mpas_log_write(' query existence of a stream that does not exist - FAILED') + ierr_count = ierr_count + 1 + end if + + ! + ! Query about the existence of an attribute that exists (immutable stream) + ! + if (streamInfo % query('input', attname='filename_template')) then + call mpas_log_write(' query existence of an attribute that exists (immutable stream) - PASSED') + else + call mpas_log_write(' query existence of an attribute that exists (immutable stream) - FAILED') + ierr_count = ierr_count + 1 + end if + + ! + ! Query about the existence of an attribute that exists (mutable stream) + ! + if (streamInfo % query('mutable_test', attname='type')) then + call mpas_log_write(' query existence of an attribute that exists (mutable stream) - PASSED') + else + call mpas_log_write(' query existence of an attribute that exists (mutable stream) - FAILED') + ierr_count = ierr_count + 1 + end if + + ! + ! Query about the existence of an attribute that does not exist + ! + if (.not. streamInfo % query('input', attname='input_start_time')) then + call mpas_log_write(' query existence of an attribute that does not exist - PASSED') + else + call mpas_log_write(' query existence of an attribute that does not exist - FAILED') + ierr_count = ierr_count + 1 + end if + + ! + ! Query the value of an attribute (immutable stream) + ! + success = streamInfo % query('input', attname='input_interval', attvalue=attvalue) + if (success .and. trim(attvalue) == 'initial_only') then + call mpas_log_write(' query value of an attribute (immutable stream) - PASSED') + else + call mpas_log_write(' query value of an attribute (immutable stream) - FAILED') + ierr_count = ierr_count + 1 + end if + + ! + ! Query the value of an attribute (mutable stream) + ! + success = streamInfo % query('mutable_test', attname='filename_template', attvalue=attvalue) + if (success .and. trim(attvalue) == 'mutable_test.nc') then + call mpas_log_write(' query value of an attribute (mutable stream) - PASSED') + else + call mpas_log_write(' query value of an attribute (mutable stream) - FAILED') + ierr_count = ierr_count + 1 + end if + + end function test_streaminfo_query + +end module mpas_test_core_stream_inquiry diff --git a/src/core_test/mpas_test_core_string_utils.F b/src/core_test/mpas_test_core_string_utils.F new file mode 100644 index 000000000..6e6c85c7c --- /dev/null +++ b/src/core_test/mpas_test_core_string_utils.F @@ -0,0 +1,183 @@ +! Copyright (c) 2023, 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 test_core_string_utils + + use mpas_derived_types + use mpas_log + + private + + public :: mpas_test_string_utils + + contains + + subroutine mpas_test_string_replace(err) + + use mpas_string_utils, only : mpas_string_replace + + implicit none + + ! Arguments + integer, intent(out) :: err + + ! Local variables + character(len=StrKIND) :: testString + character(len=StrKIND) :: outString + character :: targetCharacter, toReplace + + err = 0 + + ! Basic functionality + testString = 'Test_String' + targetCharacter = '-' + toReplace = '_' + outString = mpas_string_replace(testString, toReplace, targetCharacter) + if (trim(outString) /= 'Test-String') then + err = err + 1 + call mpas_log_write('FAILED TO REPLACE STRING #1 CORRECTLY', & + MPAS_LOG_ERR) + end if + + ! Whitespace replacement + testString = 'Test String' + targetCharacter = '-' + toReplace = ' ' + outString = mpas_string_replace(testString, toReplace, targetCharacter) + if (trim(outString) /= 'Test-String') then + err = err + 1 + call mpas_log_write('FAILED TO REPLACE STRING #2 CORRECTLY', & + MPAS_LOG_ERR) + end if + + ! Consecutive charcters + testString = 'Test__String' + toReplace = '_' + outString = mpas_string_replace(testString, toReplace, targetCharacter) + if (trim(outString) /= 'Test--String') then + err = err + 1 + call mpas_log_write('FAILED TO REPLACE STRING #3 CORRECTLY', & + MPAS_LOG_ERR) + end if + + ! No Replacement + testString = 'Test String' + toReplace = '-' + outString = mpas_string_replace(testString, toReplace, targetCharacter) + if (trim(outString) /= 'Test String') then + err = err + 1 + call mpas_log_write('FAILED TO REPLACE STRING #4 CORRECTLY', & + MPAS_LOG_ERR) + end if + + end subroutine mpas_test_string_replace + + subroutine mpas_test_split_string(err) + + use mpas_string_utils, only : mpas_split_string + + implicit none + + character(len=StrKIND) :: testString + character :: delimiter + character(len=StrKIND), pointer, dimension(:) :: splitStrings + integer, intent(out) :: err + integer :: i + + err = 0 + + ! Test a basic case + delimiter = ' ' + testString = 'This is a basic test' + call mpas_split_string(testString, delimiter, splitStrings) + + if (size(splitStrings) /= 5) then + err = err + 1 + call mpas_log_write('FAILED TO SPLIT STRING #1 CORRECTLY: WRONG'//& + ' SUBSTRING COUNT', MPAS_LOG_ERR) + return + end if + + if (trim(splitStrings(1)) /= 'This' .or. & + trim(splitStrings(2)) /= 'is' .or. & + trim(splitStrings(3)) /= 'a' .or. & + trim(splitStrings(4)) /= 'basic' .or. & + trim(splitStrings(5)) /= 'test') then + err = err + 1 + call mpas_log_write('FAILED TO SPLIT STRING #1 CORRECTLY', & + MPAS_LOG_ERR) + end if + + ! Test a string without delimiters + testString = 'This-is-a-test' + call mpas_split_string(testString, delimiter, splitStrings) + + if (size(splitStrings) /= 1) then + err = err + 1 + call mpas_log_write('FAILED TO SPLIT STRING #2 CORRECTLY: WRONG'//& + ' SUBSTRING COUNT', MPAS_LOG_ERR) + return + end if + + if (trim(splitStrings(1)) /= 'This-is-a-test') then + err = err + 1 + call mpas_log_write('FAILED TO SPLIT STRING #2 CORRECTLY', & + MPAS_LOG_ERR) + end if + + ! Test a string with consecutive delimiters + testString = 'This--is-a-test' + delimiter = '-' + call mpas_split_string(testString, delimiter, splitStrings) + + if (size(splitStrings) /= 5) then + err = err + 1 + call mpas_log_write('FAILED TO SPLIT STRING #3 CORRECTLY: WRONG'//& + ' SUBSTRING COUNT', MPAS_LOG_ERR) + return + end if + + if (trim(splitStrings(1)) /= 'This' .or. & + trim(splitStrings(2)) /= '' .or. & + trim(splitStrings(3)) /= 'is' .or. & + trim(splitStrings(4)) /= 'a' .or. & + trim(splitStrings(5)) /= 'test') then + err = err + 1 + call mpas_log_write('FAILED TO SPLIT STRING #3 CORRECTLY', & + MPAS_LOG_ERR) + end if + + end subroutine mpas_test_split_string + + subroutine mpas_test_string_utils(err) + + implicit none + + integer, intent(out) :: err + + err = 0 + + call mpas_log_write('String Utils Tests') + + call mpas_test_split_string(err) + if (err == 0) then + call mpas_log_write(' mpas_split_string: SUCCESS') + else + call mpas_log_write(' mpas_split_string: FAILURE', MPAS_LOG_ERR) + end if + + call mpas_test_string_replace(err) + if (err == 0) then + call mpas_log_write(' mpas_string_replace: SUCCESS') + else + call mpas_log_write(' mpas_string_replace: FAILURE', & + MPAS_LOG_ERR) + end if + + end subroutine mpas_test_string_utils + +end module test_core_string_utils diff --git a/src/core_test/mpas_test_core_timekeeping_tests.F b/src/core_test/mpas_test_core_timekeeping_tests.F index 44c0ff01a..a2b214c6b 100644 --- a/src/core_test/mpas_test_core_timekeeping_tests.F +++ b/src/core_test/mpas_test_core_timekeeping_tests.F @@ -5,6 +5,9 @@ ! 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 ! + +#define MPAS_ADJUST_ALARM_VERBOSE( M ) ! M + module test_core_timekeeping_tests use mpas_derived_types @@ -19,7 +22,8 @@ module test_core_timekeeping_tests implicit none private - public :: test_core_test_intervals + public :: test_core_test_intervals, & + mpas_adjust_alarm_tests contains @@ -178,4 +182,283 @@ subroutine test_core_interval_test(ref_str, int1_str, int2_str, expected_divs, e end subroutine test_core_interval_test!}}} + !*********************************************************************** + ! + ! routine mpas_adjust_alarm_tests + ! + !> \brief Tests functionality of mpas_adjust_alarm_to_reference_time + !> \author Michael Duda + !> \date 25 Feb 2025 + !> \details + !> This routine tests the functionality of the + !> mpas_adjust_alarm_to_reference_time routine for combinations of the + !> following possibilities: + !> + !> - The current time is aligned with the new alarm time grid + !> - The current time is not aligned with the new alarm time grid + !> + !> - The reference time is before the current time on the clock + !> - The reference time is the same as the current time on the clock + !> - The reference time is after the current time on the clock + !> + !> - The clock is running forwards + !> - The clock is running backwards + !> + !> Upon return, the ierr arugment is set to the number of failed tests. + ! + !----------------------------------------------------------------------- + subroutine mpas_adjust_alarm_tests(domain, ierr) + + use mpas_derived_types, only : domain_type, MPAS_Clock_type, MPAS_Time_type, MPAS_TimeInterval_type + use mpas_kind_types, only : StrKIND + use mpas_log, only : mpas_log_write + use mpas_timekeeping, only : mpas_set_time, mpas_set_timeInterval, mpas_create_clock, & + mpas_add_clock_alarm, mpas_is_alarm_ringing, mpas_reset_clock_alarm + + implicit none + + type (domain_type), intent(inout) :: domain + integer, intent(out) :: ierr + + integer :: istep + integer :: ierr_local + character(len=StrKIND) :: test_mesg + type (MPAS_Clock_type) :: test_clock + type (MPAS_Time_type) :: test_startTime + type (MPAS_Time_type) :: test_stopTime + type (MPAS_Time_type) :: test_currTime + type (MPAS_Time_type) :: test_alarmTime + type (MPAS_Time_type) :: test_refTime + type (MPAS_TimeInterval_type) :: test_timeStep + type (MPAS_TimeInterval_type) :: test_alarmTimeInterval + MPAS_ADJUST_ALARM_VERBOSE( character(len=StrKIND) :: timeStamp ) + + ierr = 0 + + ! + ! Create a clock with an initial time of 2000-01-01_00 and with a 1-hour 'tick' length + ! (The stopping time is set to 2100-01-01_00.) + ! + call mpas_set_time(test_startTime, YYYY=2000, MM=01, DD=01, H=0, M=0, S=0, S_n=0, S_d=0, ierr=ierr_local) + call mpas_set_time(test_stopTime, YYYY=2100, MM=01, DD=01, H=0, M=0, S=0, S_n=0, S_d=0, ierr=ierr_local) + call mpas_set_timeInterval(test_timeStep, dt=3600.0_RKIND, ierr=ierr_local) + + call mpas_create_clock(test_clock, test_startTime, test_timeStep, test_stopTime, ierr=ierr_local) + + ! + ! Add a recurring alarm to the clock with an initial reference time of 2000-01-01_00 and + ! a ringing interval of 1 day. + ! + call mpas_set_time(test_alarmTime, YYYY=2000, MM=01, DD=01, H=0, M=0, S=0, S_n=0, S_d=0, ierr=ierr_local) + call mpas_set_timeInterval(test_alarmTimeInterval, dt=86400.0_RKIND, ierr=ierr_local) + + call mpas_add_clock_alarm(test_clock, 'foobar', test_alarmTime, test_alarmTimeInterval, ierr_local) + +#ifdef MPAS_ADVANCE_TEST_CLOCK + do istep = 1, 24*365 + if (mpas_is_alarm_ringing(test_clock, 'foobar', ierr=ierr_local)) then + call mpas_reset_clock_alarm(test_clock, 'foobar', ierr=ierr_local) + test_currTime = mpas_get_clock_time(test_clock, MPAS_NOW, iErr) + call mpas_get_time(test_currTime, dateTimeString=timeStamp) + call mpas_log_write('**ALARM** '//trim(timeStamp)) + end if + call mpas_advance_clock(test_clock, ierr=ierr_local) + end do +#endif + + MPAS_ADJUST_ALARM_VERBOSE( test_currTime = mpas_get_clock_time(test_clock, MPAS_NOW, iErr) ) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_get_time(test_currTime, dateTimeString=timeStamp) ) + + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('') ) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('Now it is '//trim(timeStamp)) ) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('') ) + + + write(test_mesg, '(a)') ' forward clock, ref_time < now, now is on new alarm time grid: ' + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('=================================') ) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('Setting ref time to 1999-06-15_00') ) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('---------------------------------') ) + call mpas_set_time(test_refTime, YYYY=1999, MM=6, DD=15, H=0, M=0, S=0, S_n=0, S_d=0, ierr=ierr_local) + call mpas_adjust_alarm_to_reference_time(test_clock, 'foobar', test_refTime, ierr_local) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_print_alarm(test_clock, 'foobar', ierr_local) ) + if (mpas_is_alarm_ringing(test_clock, 'foobar', ierr=ierr_local)) then + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('-> Alarm is RINGING') ) + test_mesg = trim(test_mesg)//' SUCCESS' + else + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('-> Alarm is NOT ringing') ) + test_mesg = trim(test_mesg)//' FAILURE' + ierr = ierr + 1 + end if + call mpas_log_write(trim(test_mesg)) + call mpas_reset_clock_alarm(test_clock, 'foobar', ierr=ierr_local) + + write(test_mesg, '(a)') ' forward clock, ref_time > now, now is on new alarm time grid: ' + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('=================================') ) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('Setting ref time to 2010-02-01_00') ) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('---------------------------------') ) + call mpas_set_time(test_refTime, YYYY=2010, MM=2, DD=1, H=0, M=0, S=0, S_n=0, S_d=0, ierr=ierr_local) + call mpas_adjust_alarm_to_reference_time(test_clock, 'foobar', test_refTime, ierr_local) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_print_alarm(test_clock, 'foobar', ierr_local) ) + if (mpas_is_alarm_ringing(test_clock, 'foobar', ierr=ierr_local)) then + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('-> Alarm is RINGING') ) + test_mesg = trim(test_mesg)//' SUCCESS' + else + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('-> Alarm is NOT ringing') ) + test_mesg = trim(test_mesg)//' FAILURE' + ierr = ierr + 1 + end if + call mpas_log_write(trim(test_mesg)) + call mpas_reset_clock_alarm(test_clock, 'foobar', ierr=ierr_local) + + write(test_mesg, '(a)') ' forward clock, ref_time = now, now is on new alarm time grid: ' + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('=================================') ) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('Setting ref time to 2000-01-01_00') ) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('---------------------------------') ) + call mpas_set_time(test_refTime, YYYY=2000, MM=1, DD=1, H=0, M=0, S=0, S_n=0, S_d=0, ierr=ierr_local) + call mpas_adjust_alarm_to_reference_time(test_clock, 'foobar', test_refTime, ierr_local) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_print_alarm(test_clock, 'foobar', ierr_local) ) + if (mpas_is_alarm_ringing(test_clock, 'foobar', ierr=ierr_local)) then + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('-> Alarm is RINGING') ) + test_mesg = trim(test_mesg)//' SUCCESS' + else + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('-> Alarm is NOT ringing') ) + test_mesg = trim(test_mesg)//' FAILURE' + ierr = ierr + 1 + end if + call mpas_log_write(trim(test_mesg)) + call mpas_reset_clock_alarm(test_clock, 'foobar', ierr=ierr_local) + + write(test_mesg, '(a)') ' forward clock, ref_time < now, now is NOT on new alarm time grid: ' + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('=================================') ) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('Setting ref time to 1999-06-15_08') ) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('---------------------------------') ) + call mpas_set_time(test_refTime, YYYY=1999, MM=6, DD=15, H=8, M=0, S=0, S_n=0, S_d=0, ierr=ierr_local) + call mpas_adjust_alarm_to_reference_time(test_clock, 'foobar', test_refTime, ierr_local) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_print_alarm(test_clock, 'foobar', ierr_local) ) + if (mpas_is_alarm_ringing(test_clock, 'foobar', ierr=ierr_local)) then + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('-> Alarm is RINGING') ) + test_mesg = trim(test_mesg)//' SUCCESS' + else + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('-> Alarm is NOT ringing') ) + test_mesg = trim(test_mesg)//' FAILURE' + ierr = ierr + 1 + end if + call mpas_log_write(trim(test_mesg)) + call mpas_reset_clock_alarm(test_clock, 'foobar', ierr=ierr_local) + + write(test_mesg, '(a)') ' forward clock, ref_time > now, now is NOT on new alarm time grid: ' + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('=================================') ) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('Setting ref time to 2010-02-01_18') ) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('---------------------------------') ) + call mpas_set_time(test_refTime, YYYY=2010, MM=2, DD=1, H=18, M=0, S=0, S_n=0, S_d=0, ierr=ierr_local) + call mpas_adjust_alarm_to_reference_time(test_clock, 'foobar', test_refTime, ierr_local) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_print_alarm(test_clock, 'foobar', ierr_local) ) + if (mpas_is_alarm_ringing(test_clock, 'foobar', ierr=ierr_local)) then + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('-> Alarm is RINGING') ) + test_mesg = trim(test_mesg)//' SUCCESS' + else + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('-> Alarm is NOT ringing') ) + test_mesg = trim(test_mesg)//' FAILURE' + ierr = ierr + 1 + end if + call mpas_log_write(trim(test_mesg)) + call mpas_reset_clock_alarm(test_clock, 'foobar', ierr=ierr_local) + + ! + ! Set clock to run backwards in time + ! + call mpas_set_clock_direction(test_clock, MPAS_BACKWARD, ierr_local) + + write(test_mesg, '(a)') ' backward clock, ref_time < now, now is on new alarm time grid: ' + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('=================================') ) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('Setting ref time to 1999-06-15_00') ) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('---------------------------------') ) + call mpas_set_time(test_refTime, YYYY=1999, MM=6, DD=15, H=0, M=0, S=0, S_n=0, S_d=0, ierr=ierr_local) + call mpas_adjust_alarm_to_reference_time(test_clock, 'foobar', test_refTime, ierr_local) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_print_alarm(test_clock, 'foobar', ierr_local) ) + if (mpas_is_alarm_ringing(test_clock, 'foobar', ierr=ierr_local)) then + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('-> Alarm is RINGING') ) + test_mesg = trim(test_mesg)//' SUCCESS' + else + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('-> Alarm is NOT ringing') ) + test_mesg = trim(test_mesg)//' FAILURE' + ierr = ierr + 1 + end if + call mpas_log_write(trim(test_mesg)) + call mpas_reset_clock_alarm(test_clock, 'foobar', ierr=ierr_local) + + write(test_mesg, '(a)') ' backward clock, ref_time > now, now is on new alarm time grid: ' + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('=================================') ) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('Setting ref time to 2010-02-01_00') ) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('---------------------------------') ) + call mpas_set_time(test_refTime, YYYY=2010, MM=2, DD=1, H=0, M=0, S=0, S_n=0, S_d=0, ierr=ierr_local) + call mpas_adjust_alarm_to_reference_time(test_clock, 'foobar', test_refTime, ierr_local) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_print_alarm(test_clock, 'foobar', ierr_local) ) + if (mpas_is_alarm_ringing(test_clock, 'foobar', ierr=ierr_local)) then + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('-> Alarm is RINGING') ) + test_mesg = trim(test_mesg)//' SUCCESS' + else + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('-> Alarm is NOT ringing') ) + test_mesg = trim(test_mesg)//' FAILURE' + ierr = ierr + 1 + end if + call mpas_log_write(trim(test_mesg)) + call mpas_reset_clock_alarm(test_clock, 'foobar', ierr=ierr_local) + + write(test_mesg, '(a)') ' backward clock, ref_time = now, now is on new alarm time grid: ' + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('=================================') ) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('Setting ref time to 2000-01-01_00') ) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('---------------------------------') ) + call mpas_set_time(test_refTime, YYYY=2000, MM=1, DD=1, H=0, M=0, S=0, S_n=0, S_d=0, ierr=ierr_local) + call mpas_adjust_alarm_to_reference_time(test_clock, 'foobar', test_refTime, ierr_local) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_print_alarm(test_clock, 'foobar', ierr_local) ) + if (mpas_is_alarm_ringing(test_clock, 'foobar', ierr=ierr_local)) then + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('-> Alarm is RINGING') ) + test_mesg = trim(test_mesg)//' SUCCESS' + else + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('-> Alarm is NOT ringing') ) + test_mesg = trim(test_mesg)//' FAILURE' + ierr = ierr + 1 + end if + call mpas_log_write(trim(test_mesg)) + call mpas_reset_clock_alarm(test_clock, 'foobar', ierr=ierr_local) + + write(test_mesg, '(a)') ' backward clock, ref_time < now, now is NOT on new alarm time grid: ' + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('=================================') ) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('Setting ref time to 1999-06-15_08') ) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('---------------------------------') ) + call mpas_set_time(test_refTime, YYYY=1999, MM=6, DD=15, H=8, M=0, S=0, S_n=0, S_d=0, ierr=ierr_local) + call mpas_adjust_alarm_to_reference_time(test_clock, 'foobar', test_refTime, ierr_local) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_print_alarm(test_clock, 'foobar', ierr_local) ) + if (mpas_is_alarm_ringing(test_clock, 'foobar', ierr=ierr_local)) then + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('-> Alarm is RINGING') ) + test_mesg = trim(test_mesg)//' SUCCESS' + else + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('-> Alarm is NOT ringing') ) + test_mesg = trim(test_mesg)//' FAILURE' + ierr = ierr + 1 + end if + call mpas_log_write(trim(test_mesg)) + call mpas_reset_clock_alarm(test_clock, 'foobar', ierr=ierr_local) + + write(test_mesg, '(a)') ' backward clock, ref_time > now, now is NOT on new alarm time grid: ' + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('=================================') ) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('Setting ref time to 2010-02-01_18') ) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('---------------------------------') ) + call mpas_set_time(test_refTime, YYYY=2010, MM=2, DD=1, H=18, M=0, S=0, S_n=0, S_d=0, ierr=ierr_local) + call mpas_adjust_alarm_to_reference_time(test_clock, 'foobar', test_refTime, ierr_local) + MPAS_ADJUST_ALARM_VERBOSE( call mpas_print_alarm(test_clock, 'foobar', ierr_local) ) + if (mpas_is_alarm_ringing(test_clock, 'foobar', ierr=ierr_local)) then + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('-> Alarm is RINGING') ) + test_mesg = trim(test_mesg)//' SUCCESS' + else + MPAS_ADJUST_ALARM_VERBOSE( call mpas_log_write('-> Alarm is NOT ringing') ) + test_mesg = trim(test_mesg)//' FAILURE' + ierr = ierr + 1 + end if + call mpas_log_write(trim(test_mesg)) + call mpas_reset_clock_alarm(test_clock, 'foobar', ierr=ierr_local) + + end subroutine mpas_adjust_alarm_tests + end module test_core_timekeeping_tests diff --git a/src/core_test/mpas_test_openacc.F b/src/core_test/mpas_test_openacc.F new file mode 100644 index 000000000..c3b9e6b42 --- /dev/null +++ b/src/core_test/mpas_test_openacc.F @@ -0,0 +1,312 @@ +! Copyright (c) 2024 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 https://mpas-dev.github.io/license.html . +! +module mpas_test_core_openacc + + use mpas_log, only : mpas_log_write + + private + + public :: mpas_test_openacc + + contains + + !----------------------------------------------------------------------- + ! function mpas_test_openacc + ! + !> \brief Main driver for tests of OpenACC functionality in MPAS + !> \author G. Dylan Dickerson + !> \date 14 May 2024 + !> \details + !> This routine invokes tests for expected OpenACC behavior and any + !> framework routines that are specific to OpenACC. + !> + !> Return value: The total number of test that failed on any MPI rank. + ! + !----------------------------------------------------------------------- + function mpas_test_openacc(domain) result(ierr_count) + + use mpas_derived_types, only : domain_type + use mpas_kind_types, only : StrKIND + use mpas_dmpar, only : mpas_dmpar_max_int + + implicit none + + ! Arguments + type (domain_type), intent(inout) :: domain + + ! Return value + integer :: ierr_count + + ! Local variables + integer :: ierr, ierr_global + ! Use test_log_str to track what is being tested next + character(len=StrKIND) :: test_log_str + + ierr_count = 0 + + call mpas_log_write('--- Begin OpenACC tests') + + test_log_str = 'Simple CPU-GPU reproducibility test' + ierr = openacc_test_rep_arrs(domain) + if (ierr == 0) then + call mpas_log_write(' '//trim(test_log_str)//' - PASSED') + else + ierr_count = ierr_count + 1 + call mpas_log_write(' '//trim(test_log_str)//' - FAILED') + end if + + ! Make sure all threads have the max number of tests failed in + call mpas_dmpar_max_int(domain % dminfo, ierr_count, ierr_global) + ierr_count = ierr_global + + end function mpas_test_openacc + + + !----------------------------------------------------------------------- + ! routine openacc_test_rep_arrs + ! + !> \brief OpenACC test of representative of array usage + !> \author G. Dylan Dickerson + !> \date 29 May 2024 + !> \details + !> Replicates patterns from the core_atmosphere dynamics and + !> compares the results on the CPU to those on the GPU. These + !> patterns include a main routine that fetches arrays and + !> dimensions that are passed to work routines and loops + !> in the work routine that calculate some helper values before the + !> result. + !> + !> Return value: 0 (success) if the CPU and GPU results match on + !> all ranks, 1 otherwise + !----------------------------------------------------------------------- + function openacc_test_rep_arrs(domain) result(ierr) + + use mpas_derived_types, only : domain_type, mpas_pool_type + use mpas_kind_types, only : RKIND + use mpas_pool_routines, only : mpas_pool_get_subpool,mpas_pool_get_dimension, & + mpas_pool_get_array + + implicit none + + ! Arguments + type (domain_type), intent(inout) :: domain + + ! Return value + integer :: ierr + + ! Local variables + real (kind=RKIND) :: diff + + type (mpas_pool_type), pointer :: mesh_pool + integer, pointer :: nCells,nCellsSolve + integer, pointer :: nEdges,nEdgesSolve + real (kind=RKIND), dimension(:), pointer :: areaCell + integer, dimension(:), pointer :: indexToCellID + integer, dimension(:), pointer :: nEdgesOnCell + integer, dimension(:,:), pointer :: cellsOnEdge + + type (mpas_pool_type), pointer :: openaccTest_pool + real (kind=RKIND), dimension(:), pointer :: array_cpu + real (kind=RKIND), dimension(:), pointer :: array_gpu + + ierr = 0 + diff = 0.0_RKIND + + ! + ! Fetch variables + ! + nullify(mesh_pool) + call mpas_pool_get_subpool(domain % blocklist % structs, 'mesh', mesh_pool) + + nullify(nCells) + call mpas_pool_get_dimension(mesh_pool, 'nCells', nCells) + + nullify(nEdges) + call mpas_pool_get_dimension(mesh_pool, 'nEdges', nEdges) + + nullify(nCellsSolve) + call mpas_pool_get_dimension(mesh_pool, 'nCellsSolve', nCellsSolve) + + nullify(nEdgesSolve) + call mpas_pool_get_dimension(mesh_pool, 'nEdgesSolve', nEdgesSolve) + + nullify(areaCell) + call mpas_pool_get_array(mesh_pool, 'areaCell', areaCell) + + nullify(indexToCellID) + call mpas_pool_get_array(mesh_pool, 'indexToCellID', indexToCellID) + + nullify(nEdgesOnCell) + call mpas_pool_get_array(mesh_pool, 'nEdgesOnCell', nEdgesOnCell) + + nullify(cellsOnEdge) + call mpas_pool_get_array(mesh_pool, 'cellsOnEdge', cellsOnEdge) + + nullify(openaccTest_pool) + call mpas_pool_get_subpool(domain % blocklist % structs, 'openaccTest', openaccTest_pool) + + nullify(array_cpu) + call mpas_pool_get_array(openaccTest_pool, 'edge_cpu', array_cpu) + + nullify(array_gpu) + call mpas_pool_get_array(openaccTest_pool, 'edge_gpu', array_gpu) + + call rep_arrs_work_cpu(nCells,nEdges,nCellsSolve,nEdgesSolve, & + areaCell,indexToCellID,nEdgesOnCell,cellsOnEdge, & + array_cpu) + + call rep_arrs_work_gpu(nCells,nEdges,nCellsSolve,nEdgesSolve, & + areaCell,indexToCellID,nEdgesOnCell,cellsOnEdge, & + array_gpu) + + diff = sum(abs(array_cpu(1:nEdges) - array_gpu(1:nEdges))) + + if (diff > 0.0_RKIND) then + ierr = ierr + 1 + end if + + end function openacc_test_rep_arrs + + + !----------------------------------------------------------------------- + ! routine rep_arrs_work_cpu + ! + !> \brief CPU work routine for OpenACC representative arrays test + !> \author G. Dylan Dickerson + !> \date 29 May 2024 + !> \details + !> Performs some array work on the CPU, based on patterns in the + !> MPAS-A dycore. + ! + !----------------------------------------------------------------------- + subroutine rep_arrs_work_cpu(nCells, nEdges, nCellsSolve, nEdgesSolve, & + areaCell, indexToCellID, nEdgesOnCell, cellsOnEdge, & + edge_arr_cpu) + + use mpas_kind_types, only : RKIND + + implicit none + + ! arguments + integer, intent(in) :: nCells, nEdges, nCellsSolve, nEdgesSolve + real (kind=RKIND), dimension(:), intent(in) :: areaCell + integer, dimension(:), intent(in) :: indexToCellID + integer, dimension(:), intent(in) :: nEdgesOnCell + integer, dimension(:,:), intent(in) :: cellsOnEdge + real (kind=RKIND), dimension(:), intent(inout) :: edge_arr_cpu + + ! locals + integer :: iCell, iEdge, cell1, cell2 + real (kind=RKIND), dimension(nCells) :: invArea, help_arr + + ! Compute any helpers and initialize arrs + do iCell=1,nCells + invArea(iCell) = 1.0_RKIND / areaCell(iCell) + help_arr(iCell) = 0.0_RKIND + end do + do iEdge=1,nEdges + edge_arr_cpu(iEdge) = 0.0_RKIND + end do + + ! Compute helper values (for all owned cells) + do iCell=1,nCellsSolve + help_arr(iCell) = (nEdgesOnCell(iCell)+indexToCellID(iCell)) * invArea(iCell) + end do + + ! Compute final value (for all owned edges) + do iEdge=1,nEdgesSolve + cell1 = cellsOnEdge(1,iEdge) + cell2 = cellsOnEdge(2,iEdge) + + edge_arr_cpu(iEdge) = 0.5_RKIND * (help_arr(cell1) + help_arr(cell2)) + end do + end subroutine rep_arrs_work_cpu + + + !----------------------------------------------------------------------- + ! routine rep_arrs_work_gpu + ! + !> \brief GPU work routine for OpenACC representative arrays test + !> \author G. Dylan Dickerson + !> \date 29 May 2024 + !> \details + !> Performs some array work on the GPU, based on patterns in the + !> MPAS-A dycore. + ! + !----------------------------------------------------------------------- + subroutine rep_arrs_work_gpu(nCells, nEdges, nCellsSolve, nEdgesSolve, & + areaCell, indexToCellID, nEdgesOnCell, cellsOnEdge, & + edge_arr_gpu) + + use mpas_kind_types, only : RKIND + + implicit none + + ! arguments + integer, intent(in) :: nCells, nEdges, nCellsSolve, nEdgesSolve + real (kind=RKIND), dimension(:), intent(in) :: areaCell + integer, dimension(:), intent(in) :: indexToCellID + integer, dimension(:), intent(in) :: nEdgesOnCell + integer, dimension(:,:), intent(in) :: cellsOnEdge + real (kind=RKIND), dimension(:), intent(inout) :: edge_arr_gpu + + ! locals + integer :: iCell, iEdge, cell1, cell2 + real (kind=RKIND), dimension(nCells) :: invArea + real (kind=RKIND), dimension(nCells) :: help_arr + + !$acc enter data copyin(nCells,nEdges, & + !$acc areaCell(:), indexToCellID(:), & + !$acc nEdgesOnCell(:),cellsOnEdge(:,:)) + + !$acc enter data create(edge_arr_gpu(:),iCell,iEdge,cell1,cell2, & + !$acc invArea(:),help_arr(:)) + + ! Compute any helpers and initialize arrs + !$acc parallel default(present) async + !$acc loop gang worker vector + do iCell=1,nCells + invArea(iCell) = 1.0_RKIND / areaCell(iCell) + help_arr(iCell) = 0.0_RKIND + end do + + !$acc loop gang worker vector + do iEdge=1,nEdges + edge_arr_gpu(iEdge) = 0.0_RKIND + end do + !$acc end parallel + + ! Compute helper values (for all owned cells) + !$acc parallel default(present) wait + !$acc loop gang worker vector + do iCell=1,nCellsSolve + help_arr(iCell) = (nEdgesOnCell(iCell)+indexToCellID(iCell)) * invArea(iCell) + end do + !$acc end parallel + + ! Compute final value (for all owned edges) + !$acc parallel default(present) wait + !$acc loop gang worker vector private(cell1, cell2) + do iEdge=1,nEdgesSolve + cell1 = cellsOnEdge(1,iEdge) + cell2 = cellsOnEdge(2,iEdge) + + edge_arr_gpu(iEdge) = 0.5_RKIND * (help_arr(cell1) + help_arr(cell2)) + end do + !$acc end parallel + + !$acc exit data delete(nCells,nEdges, & + !$acc areaCell(:), indexToCellID(:), & + !$acc nEdgesOnCell(:),cellsOnEdge(:,:), & + !$acc iCell,iEdge,cell1,cell2,invArea(:),help_arr(:)) + + !$acc exit data copyout(edge_arr_gpu(:)) + + end subroutine rep_arrs_work_gpu + + +end module mpas_test_core_openacc diff --git a/src/driver/mpas_subdriver.F b/src/driver/mpas_subdriver.F index ba94dcaf5..68adea9dc 100644 --- a/src/driver/mpas_subdriver.F +++ b/src/driver/mpas_subdriver.F @@ -512,6 +512,7 @@ subroutine add_stream_attributes(domain) call MPAS_stream_mgr_add_att(domain % streamManager, 'model_name', domain % core % modelName) call MPAS_stream_mgr_add_att(domain % streamManager, 'core_name', domain % core % coreName) + call MPAS_stream_mgr_add_att(domain % streamManager, 'version', domain % core % modelVersion) call MPAS_stream_mgr_add_att(domain % streamManager, 'source', domain % core % source) call MPAS_stream_mgr_add_att(domain % streamManager, 'Conventions', domain % core % Conventions) call MPAS_stream_mgr_add_att(domain % streamManager, 'git_version', domain % core % git_version) diff --git a/src/external/SMIOL/CMakeLists.txt b/src/external/SMIOL/CMakeLists.txt new file mode 100644 index 000000000..4a62f757c --- /dev/null +++ b/src/external/SMIOL/CMakeLists.txt @@ -0,0 +1,31 @@ + +find_package(MPI REQUIRED COMPONENTS C Fortran) +find_package(PnetCDF REQUIRED COMPONENTS Fortran C) + +# Specify the library source files +set(SMIOL_C_SOURCES smiol.c smiol_utils.c) +set(SMIOL_F_SOURCES smiolf.F90) + +# Create the C library +add_library(smiol ${SMIOL_C_SOURCES}) +add_library(${PROJECT_NAME}::external::smiol ALIAS smiol) +target_compile_definitions(smiol PRIVATE SMIOL_PNETCDF SINGLE_PRECISION) +target_include_directories(smiol PRIVATE ${MPI_INCLUDE_PATH}) +target_link_libraries( smiol PRIVATE MPI::MPI_C PnetCDF::PnetCDF_C ) + +# Create the Fortran library +add_library(smiolf ${SMIOL_F_SOURCES}) +enable_language(Fortran) +mpas_fortran_target(smiolf) +add_library(${PROJECT_NAME}::external::smiolf ALIAS smiolf) +target_compile_definitions(smiolf PRIVATE SMIOL_PNETCDF ) +# fortran lib requires the c lib +target_link_libraries(smiolf PUBLIC smiol) +target_include_directories(smiol PUBLIC $) + +install(TARGETS smiol EXPORT ${PROJECT_NAME}ExportsExternal + ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR} + LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR}) +install(TARGETS smiolf EXPORT ${PROJECT_NAME}ExportsExternal + ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR} + LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR}) diff --git a/src/external/SMIOL/smiol.c b/src/external/SMIOL/smiol.c index 1953e6536..8a34ed23b 100644 --- a/src/external/SMIOL/smiol.c +++ b/src/external/SMIOL/smiol.c @@ -228,6 +228,9 @@ int SMIOL_inquire(void) * blocking write interface, while a nonzero value enables the use of the * non-blocking, buffered interface for writing. * + * When a file is opened with a mode of SMIOL_FILE_CREATE, the fformat argument + * is used to set the file format. Otherwise fformat is ignored. + * * Upon successful completion, SMIOL_SUCCESS is returned, and the file handle * argument will point to a valid file handle and the current frame for the * file will be set to zero. Otherwise, the file handle is NULL and an error @@ -235,7 +238,7 @@ int SMIOL_inquire(void) * ********************************************************************************/ int SMIOL_open_file(struct SMIOL_context *context, const char *filename, - int mode, struct SMIOL_file **file, size_t bufsize) + int mode, struct SMIOL_file **file, size_t bufsize, int fformat) { int io_group; MPI_Comm io_file_comm; @@ -318,8 +321,24 @@ int SMIOL_open_file(struct SMIOL_context *context, const char *filename, if (mode & SMIOL_FILE_CREATE) { #ifdef SMIOL_PNETCDF if ((*file)->io_task) { + /* + * Convert fformat to a PNetCDF file creation mode + */ + int filecmode; + if (fformat == SMIOL_FORMAT_CDF2) { + filecmode = NC_64BIT_OFFSET; + } else if (fformat == SMIOL_FORMAT_CDF5) { + filecmode = NC_64BIT_DATA; + } else { + free((*file)); + (*file) = NULL; + MPI_Comm_free(&io_file_comm); + MPI_Comm_free(&io_group_comm); + return SMIOL_INVALID_FORMAT; + } + ierr = ncmpi_create(io_file_comm, filename, - (NC_64BIT_DATA | NC_CLOBBER), + (filecmode | NC_CLOBBER), MPI_INFO_NULL, &((*file)->ncidp)); } @@ -1983,6 +2002,8 @@ const char *SMIOL_error_string(int errno) return "argument is of the wrong type"; case SMIOL_INSUFFICIENT_ARG: return "argument is of insufficient size"; + case SMIOL_INVALID_FORMAT: + return "invalid format for file creation"; default: return "Unknown error"; } diff --git a/src/external/SMIOL/smiol.h b/src/external/SMIOL/smiol.h index 42589d979..54124de05 100644 --- a/src/external/SMIOL/smiol.h +++ b/src/external/SMIOL/smiol.h @@ -21,7 +21,7 @@ int SMIOL_inquire(void); * File methods */ int SMIOL_open_file(struct SMIOL_context *context, const char *filename, - int mode, struct SMIOL_file **file, size_t bufsize); + int mode, struct SMIOL_file **file, size_t bufsize, int fformat); int SMIOL_close_file(struct SMIOL_file **file); /* diff --git a/src/external/SMIOL/smiol_codes.inc b/src/external/SMIOL/smiol_codes.inc index 456bcc7be..c23e882fc 100644 --- a/src/external/SMIOL/smiol_codes.inc +++ b/src/external/SMIOL/smiol_codes.inc @@ -6,6 +6,7 @@ #define SMIOL_LIBRARY_ERROR (-5) #define SMIOL_WRONG_ARG_TYPE (-6) #define SMIOL_INSUFFICIENT_ARG (-7) +#define SMIOL_INVALID_FORMAT (-8) #define SMIOL_FILE_CREATE (1) #define SMIOL_FILE_READ (2) @@ -19,3 +20,6 @@ #define SMIOL_INT32 (2002) #define SMIOL_CHAR (2003) #define SMIOL_UNKNOWN_VAR_TYPE (2004) + +#define SMIOL_FORMAT_CDF2 (3000) +#define SMIOL_FORMAT_CDF5 (3001) diff --git a/src/external/SMIOL/smiolf.F90 b/src/external/SMIOL/smiolf.F90 index bf001c848..9a5a25327 100644 --- a/src/external/SMIOL/smiolf.F90 +++ b/src/external/SMIOL/smiolf.F90 @@ -366,12 +366,16 @@ end function SMIOLf_inquire !> the use of the non-blocking, buffered interface for writing. If the bufsize !> argument is not present, a default buffer size of 128 MiB is used. !> + !> When a file is opened with a mode of SMIOL_FILE_CREATE, the fformat optional + !> argument is used to set the file format. Otherwise, fformat is ignored. If + !> not present, the default file format is SMIOL_FORMAT_CDF5. + !> !> Upon successful completion, SMIOL_SUCCESS is returned, and the file handle argument !> will point to a valid file handle. Otherwise, the file handle is not associated !> and an error code other than SMIOL_SUCCESS is returned. ! !----------------------------------------------------------------------- - integer function SMIOLf_open_file(context, filename, mode, file, bufsize) result(ierr) + integer function SMIOLf_open_file(context, filename, mode, file, bufsize, fformat) result(ierr) use iso_c_binding, only : c_loc, c_ptr, c_null_ptr, c_char, c_size_t, c_associated, c_f_pointer @@ -382,6 +386,7 @@ integer function SMIOLf_open_file(context, filename, mode, file, bufsize) result integer, intent(in) :: mode type (SMIOLf_file), pointer :: file integer(kind=c_size_t), intent(in), optional :: bufsize + integer, intent(in), optional :: fformat ! Default buffer size to use if optional bufsize argument is not provided integer (kind=c_size_t), parameter :: default_bufsize = int(128*1024*1024, kind=c_size_t) @@ -390,16 +395,18 @@ integer function SMIOLf_open_file(context, filename, mode, file, bufsize) result type (c_ptr) :: c_file = c_null_ptr integer(kind=c_int) :: c_mode character(kind=c_char), dimension(:), pointer :: c_filename + integer(kind=c_int) :: c_fformat ! C interface definitions interface - function SMIOL_open_file(context, filename, mode, file, bufsize) result(ierr) bind(C, name='SMIOL_open_file') + function SMIOL_open_file(context, filename, mode, file, bufsize, fformat) result(ierr) bind(C, name='SMIOL_open_file') use iso_c_binding, only : c_char, c_ptr, c_int, c_size_t type (c_ptr), value :: context character(kind=c_char), dimension(*) :: filename integer(kind=c_int), value :: mode type (c_ptr) :: file integer(kind=c_size_t), value :: bufsize + integer(kind=c_int), value :: fformat integer(kind=c_int) :: ierr end function end interface @@ -416,12 +423,18 @@ function SMIOL_open_file(context, filename, mode, file, bufsize) result(ierr) bi c_mode = mode + if (present(fformat)) then + c_fformat = fformat + else + c_fformat = SMIOL_FORMAT_CDF5 + end if + if (present(bufsize)) then ierr = SMIOL_open_file(c_context, c_filename, c_mode, c_file, & - bufsize) + bufsize, c_fformat) else ierr = SMIOL_open_file(c_context, c_filename, c_mode, c_file, & - default_bufsize) + default_bufsize, c_fformat) end if deallocate(c_filename) diff --git a/src/external/esmf_time_f90/CMakeLists.txt b/src/external/esmf_time_f90/CMakeLists.txt new file mode 100644 index 000000000..6546880fb --- /dev/null +++ b/src/external/esmf_time_f90/CMakeLists.txt @@ -0,0 +1,34 @@ + +set(_esmf_time_src + ESMF_AlarmClockMod.F90 + ESMF_AlarmMod.F90 + ESMF_BaseMod.F90 + ESMF_BaseTimeMod.F90 + ESMF_CalendarMod.F90 + ESMF_ClockMod.F90 + ESMF.F90 + ESMF_FractionMod.F90 + ESMF_Macros.inc + ESMF_ShrTimeMod.F90 + ESMF_Stubs.F90 + ESMF_TimeIntervalMod.F90 + ESMF_TimeMgr.inc + ESMF_TimeMod.F90 + MeatMod.F90 + wrf_error_fatal.F90 + wrf_message.F90) + +add_library(esmf ${_esmf_time_src}) +mpas_fortran_target(esmf) +add_library(${PROJECT_NAME}::external::esmf ALIAS esmf) + +target_compile_definitions(esmf PRIVATE HIDE_MPI=1) + +target_include_directories(esmf PUBLIC $) + +target_link_libraries(esmf PUBLIC MPI::MPI_Fortran) + +install(TARGETS esmf EXPORT ${PROJECT_NAME}ExportsExternal + ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR} + LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR}) + diff --git a/src/external/ezxml/CMakeLists.txt b/src/external/ezxml/CMakeLists.txt new file mode 100644 index 000000000..34955dbd9 --- /dev/null +++ b/src/external/ezxml/CMakeLists.txt @@ -0,0 +1,8 @@ + +add_library(ezxml ezxml.c) +add_library(${PROJECT_NAME}::external::ezxml ALIAS ezxml) +target_include_directories(ezxml PUBLIC $) + +install(TARGETS ezxml EXPORT ${PROJECT_NAME}ExportsExternal + ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR} + LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR}) diff --git a/src/framework/CMakeLists.txt b/src/framework/CMakeLists.txt new file mode 100644 index 000000000..8273e8e40 --- /dev/null +++ b/src/framework/CMakeLists.txt @@ -0,0 +1,75 @@ + +set(MPAS_FRAMEWORK_SOURCES + mpas_block_creator.F + mpas_block_decomp.F + mpas_bootstrapping.F + mpas_c_interfacing.F + mpas_constants.F + mpas_decomp.F + mpas_domain_routines.F + mpas_field_routines.F + mpas_forcing.F + mpas_hash.F + mpas_io_units.F + mpas_kind_types.F + mpas_pool_routines.F + mpas_sort.F + mpas_stream_list.F + mpas_threading.F + mpas_timer.F + mpas_abort.F + mpas_attlist.F + mpas_derived_types.F + mpas_dmpar.F + mpas_framework.F + mpas_halo.F + mpas_io.F + mpas_io_streams.F + mpas_log.F + mpas_stream_inquiry.F + mpas_stream_manager.F + mpas_string_utils.F + mpas_timekeeping.F + pool_hash.c + random_id.c + regex_matching.c + xml_stream_parser.c + stream_inquiry.c) + +add_library(framework ${MPAS_FRAMEWORK_SOURCES}) +set_MPAS_DEBUG_flag(framework) +set(FRAMEWORK_COMPILE_DEFINITIONS + mpas=1 + MPAS_NATIVE_TIMERS) +if (MPAS_USE_PIO) + list(APPEND FRAMEWORK_COMPILE_DEFINITIONS USE_PIO2 MPAS_PIO_SUPPORT) + set(IO_LIBS + PIO::PIO_Fortran + PIO::PIO_C) +else() + list(APPEND FRAMEWORK_COMPILE_DEFINITIONS MPAS_SMIOL_SUPPORT) + set(IO_LIBS + ${PROJECT_NAME}::external::smiolf) +endif() +target_compile_definitions(framework PRIVATE ${FRAMEWORK_COMPILE_DEFINITIONS}) + +mpas_fortran_target(framework) +add_library(${PROJECT_NAME}::framework ALIAS framework) + +set_target_properties(framework PROPERTIES OUTPUT_NAME mpas_framework) + +set(FRAMEWORK_LINK_LIBRARIES + ${PROJECT_NAME}::external::esmf + ${PROJECT_NAME}::external::ezxml + ${IO_LIBS} + PnetCDF::PnetCDF_Fortran + MPI::MPI_Fortran) + +if (MPAS_PROFILE) + list(APPEND FRAMEWORK_LINK_LIBRARIES GPTL::GPTL) +endif () +target_link_libraries(framework PUBLIC ${FRAMEWORK_LINK_LIBRARIES}) + +install(TARGETS framework EXPORT ${PROJECT_NAME}Exports + ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR} + LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR}) diff --git a/src/framework/mpas_abort.F b/src/framework/mpas_abort.F index f2707944a..e00a3cfd6 100644 --- a/src/framework/mpas_abort.F +++ b/src/framework/mpas_abort.F @@ -33,7 +33,7 @@ subroutine mpas_dmpar_global_abort(mesg, deferredAbort)!{{{ #ifdef _MPI #ifndef NOMPIMOD #ifdef MPAS_USE_MPI_F08 - use mpi_f08 + use mpi_f08, only : MPI_COMM_WORLD, MPI_Comm_rank, MPI_Comm_size, MPI_Abort #else use mpi #endif diff --git a/src/framework/mpas_block_creator.F b/src/framework/mpas_block_creator.F index 42070c04b..812222f43 100644 --- a/src/framework/mpas_block_creator.F +++ b/src/framework/mpas_block_creator.F @@ -715,6 +715,7 @@ subroutine mpas_block_creator_build_cell_halos(nHalos, indexToCellID, nEdgesOnCe ! Deallocate array and field. deallocate(sendingHaloLayers) call mpas_deallocate_field(offSetField) + call mpas_deallocate_field(cellLimitField) end subroutine mpas_block_creator_build_cell_halos!}}} diff --git a/src/framework/mpas_bootstrapping.F b/src/framework/mpas_bootstrapping.F index b931bd6d9..4241255e2 100644 --- a/src/framework/mpas_bootstrapping.F +++ b/src/framework/mpas_bootstrapping.F @@ -815,7 +815,6 @@ subroutine mpas_io_setup_edge_block_fields(inputHandle, nReadEdges, readEdgeStar ! Global edge indices allocate(indexToEdgeID) allocate(indexToEdgeID % array(nReadEdges)) - allocate(indexToEdgeID % array(nReadEdges)) do i=1,nReadEdges readIndices(i) = i + readEdgeStart - 1 end do diff --git a/src/framework/mpas_constants.F b/src/framework/mpas_constants.F index c98cb8102..2c8168510 100644 --- a/src/framework/mpas_constants.F +++ b/src/framework/mpas_constants.F @@ -12,7 +12,7 @@ !> \brief MPAS Constant Module !> \author Michael Duda !> \date 03/27/13 -!> \details +!> \details !> This module provides various constants that can be used in different parts of MPAS. !> They may or may not be a physical quantity. ! @@ -20,19 +20,25 @@ module mpas_constants - use mpas_kind_types + use mpas_kind_types, only: RKIND + + implicit none + + public + private :: RKIND #ifdef MPAS_CAM_DYCORE - use physconst, only : pii => pi - use physconst, only : gravity => gravit - use physconst, only : omega - use physconst, only : a => rearth - use physconst, only : cp => cpair - use physconst, only : rgas => rair - use physconst, only : rv => rh2o - real (kind=RKIND) :: rvord = huge(1.0_RKIND) ! Derived in mpas_constants_compute_derived - real (kind=RKIND) :: cv = huge(1.0_RKIND) ! Derived in mpas_constants_compute_derived - real (kind=RKIND) :: cvpm = huge(1.0_RKIND) ! Derived in mpas_constants_compute_derived + ! Set at run-time by `mpas_constants_compute_derived`. + real (kind=RKIND), protected :: pii = huge(1.0_RKIND) + real (kind=RKIND), protected :: a = huge(1.0_RKIND) + real (kind=RKIND), protected :: omega = huge(1.0_RKIND) + real (kind=RKIND), protected :: gravity = huge(1.0_RKIND) + real (kind=RKIND), protected :: rgas = huge(1.0_RKIND) + real (kind=RKIND), protected :: rv = huge(1.0_RKIND) + real (kind=RKIND), protected :: cp = huge(1.0_RKIND) + real (kind=RKIND), protected :: rvord = huge(1.0_RKIND) + real (kind=RKIND), protected :: cv = huge(1.0_RKIND) + real (kind=RKIND), protected :: cvpm = huge(1.0_RKIND) #else real (kind=RKIND), parameter :: pii = 3.141592653589793_RKIND !< Constant: Pi real (kind=RKIND), parameter :: a = 6371229.0_RKIND !< Constant: Spherical Earth radius [m] @@ -49,6 +55,7 @@ module mpas_constants real (kind=RKIND), parameter :: p0 = 1.0e5_RKIND !< Constant: 100000 Pa real (kind=RKIND), parameter :: prandtl = 1.0_RKIND !< Constant: Prandtl number + contains @@ -59,7 +66,7 @@ module mpas_constants !> \brief Computes derived constants !> \author Michael Duda !> \date 8 May 2020 -!> \details +!> \details !> This routine provides a place where physical constants provided by !> the mpas_constants module may be computed at runtime. For example, !> if some constants depend on namelist options or other runtime @@ -74,9 +81,25 @@ module mpas_constants !----------------------------------------------------------------------- subroutine mpas_constants_compute_derived() - implicit none - #ifdef MPAS_CAM_DYCORE + use physconst, only: external_pii => pi + use physconst, only: external_a => rearth + use physconst, only: external_omega => omega + use physconst, only: external_gravity => gravit + use physconst, only: external_rgas => rair + use physconst, only: external_rv => rh2o + use physconst, only: external_cp => cpair + + ! Convert external constants to the native precision of MPAS (i.e., `RKIND`). + + pii = real(external_pii, RKIND) + a = real(external_a, RKIND) + omega = real(external_omega, RKIND) + gravity = real(external_gravity, RKIND) + rgas = real(external_rgas, RKIND) + rv = real(external_rv, RKIND) + cp = real(external_cp, RKIND) + ! ! In the case of CAM-MPAS, rgas may depend on a CAM namelist option, ! so physical constants that depend on rgas must be computed here after diff --git a/src/framework/mpas_dmpar.F b/src/framework/mpas_dmpar.F index 033c818f4..6d68c0c65 100644 --- a/src/framework/mpas_dmpar.F +++ b/src/framework/mpas_dmpar.F @@ -32,7 +32,16 @@ module mpas_dmpar #ifdef _MPI #ifndef NOMPIMOD #ifdef MPAS_USE_MPI_F08 - use mpi_f08 + use mpi_f08, only : MPI_Comm, MPI_Datatype + use mpi_f08, only : MPI_INTEGER, MPI_2INTEGER, MPI_REAL, MPI_2REAL, MPI_DOUBLE_PRECISION, & + MPI_2DOUBLE_PRECISION, MPI_CHARACTER, MPI_INTEGER8 + use mpi_f08, only : MPI_COMM_SELF, MPI_COMM_WORLD, MPI_INFO_NULL, MPI_THREAD_SINGLE, & + MPI_THREAD_SERIALIZED, MPI_THREAD_FUNNELED, MPI_THREAD_MULTIPLE, MPI_STATUS_IGNORE + use mpi_f08, only : MPI_Query_thread, MPI_Comm_dup + use mpi_f08, only : MPI_Init_thread , MPI_Init, MPI_Comm_rank, MPI_Comm_size, MPI_Finalize, & + MPI_Comm_free, MPI_Abort, MPI_Bcast, MPI_Allreduce, MPI_Scatterv, MPI_Recv, & + MPI_Send, MPI_Request, MPI_Irecv, MPI_Isend, MPI_Wait, MPI_Wtime, MPI_Test + use mpi_f08, only : MPI_SUM, MPI_MIN, MPI_MAX, MPI_MINLOC, MPI_MAXLOC #else use mpi #endif @@ -89,6 +98,7 @@ module mpas_dmpar public :: mpas_dmpar_bcast_ints public :: mpas_dmpar_bcast_real public :: mpas_dmpar_bcast_reals + public :: mpas_dmpar_bcast_real4s public :: mpas_dmpar_bcast_double public :: mpas_dmpar_bcast_doubles public :: mpas_dmpar_bcast_logical @@ -170,6 +180,14 @@ module mpas_dmpar module procedure mpas_dmpar_exch_halo_field5d_real end interface + interface mpas_dmpar_exch_halo_adj_field + module procedure mpas_dmpar_exch_halo_adj_field2d_real + end interface + + public :: mpas_dmpar_exch_halo_adj_field + + private :: mpas_dmpar_exch_halo_adj_field2d_real + public :: mpas_dmpar_exch_halo_field private :: mpas_dmpar_exch_halo_field1d_integer @@ -534,6 +552,46 @@ subroutine mpas_dmpar_bcast_reals(dminfo, n, rarray, proc)!{{{ end subroutine mpas_dmpar_bcast_reals!}}} +!----------------------------------------------------------------------- +! routine mpas_dmpar_bcast_real4s +! +!> \brief MPAS dmpar broadcast R4KIND routine. +!> \author Michael Duda, William Lipscomb +!> \date 8 July 2024 +!> \details +!> This routine broadcasts an array of R4KIND reals to all processors in +!> the communicator. An optional argument specifies the source node; else +!> broadcast from IO_NODE. +! +!----------------------------------------------------------------------- + subroutine mpas_dmpar_bcast_real4s(dminfo, n, rarray, proc)!{{{ + + implicit none + + type (dm_info), intent(in) :: dminfo !< Input: Domain information + integer, intent(in) :: n !< Input: Length of array + real (kind=R4KIND), dimension(n), intent(inout) :: rarray !< Input/Output: Array of reals to be broadcast + integer, intent(in), optional :: proc !< optional argument indicating which processor to broadcast from + +#ifdef _MPI + integer :: mpi_ierr, source + integer :: threadNum + + threadNum = mpas_threading_get_thread_num() + + if ( threadNum == 0 ) then + if (present(proc)) then + source = proc + else + source = IO_NODE + endif + + call MPI_Bcast(rarray, n, MPI_REAL, source, dminfo % comm, mpi_ierr) + end if +#endif + + end subroutine mpas_dmpar_bcast_real4s!}}} + !----------------------------------------------------------------------- ! routine mpas_dmpar_bcast_double ! @@ -5486,6 +5544,7 @@ subroutine mpas_dmpar_exch_halo_field2d_real(field, haloLayersIn)!{{{ end do else nHaloLayers = size(field % sendList % halos) + DMPAR_DEBUG_WRITE('exch_halo nHaloLayers:$i destList halos:$i' COMMA intArgs=(/nHaloLayers COMMA size(field%recvList%halos)/)) allocate(haloLayers(nHaloLayers)) do iHalo = 1, nHaloLayers haloLayers(iHalo) = iHalo @@ -6195,6 +6254,193 @@ subroutine mpas_dmpar_exch_halo_field5d_real(field, haloLayersIn)!{{{ end subroutine mpas_dmpar_exch_halo_field5d_real!}}} + !----------------------------------------------------------------------- + ! routine mpas_dmpar_exch_halo_adj_field2d_real + ! + !> \brief MPAS dmpar halo exchange adjoint 2D real field + !> \author BJ Jung + !> \date 09/2020 + !> \details + !> This routine handles the adjoint of halo exchange communication of an input field across all processors. + !> It accumulates the values of owned point with the values of halos. It is based on mpas_dmpar_exch_halo_field2d_real. + !> + !> Note the number of halo layers impacts the number of cells which will be updated by this routine: + !> The first halo layer will update the owned 'edge' cells, where 'edge' cells are adjacent to ghost cells. + !> The second halo layer will update owned cells which are adjacent to the 'edge' cells. + !> The third halo layer will update owned cells which are adjacent to the cells updated by the seconds halo layer, etc. + !----------------------------------------------------------------------- + subroutine mpas_dmpar_exch_halo_adj_field2d_real(field, haloLayersIn)!{{{ + + implicit none + + type (field2dReal), pointer, intent(inout) :: field !< Input: Field to communicate + integer, dimension(:), intent(in), optional :: haloLayersIn !< Input: List of halo layers to communicate. Defaults to all + type (dm_info), pointer :: dminfo + type (field2dReal), pointer :: fieldCursor, fieldCursor2 + type (mpas_exchange_list), pointer :: exchListPtr + type (mpas_communication_list), pointer :: sendList, recvList, commListPtr + integer :: mpi_ierr, threadNum + integer :: nHaloLayers, iHalo, i, j + integer :: bufferOffset, nAdded + integer, dimension(:), pointer :: haloLayers + + if ( .not. field % isActive ) then + DMPAR_DEBUG_WRITE(' -- Skipping halo exchange for deactivated field: ' // trim(field % fieldName)) + return + end if + + do i = 1, 2 + if(field % dimSizes(i) <= 0) then + return + end if + end do + + dminfo => field % block % domain % dminfo + threadNum = mpas_threading_get_thread_num() + + if ( threadNum == 0 ) then + if(present(haloLayersIn)) then + nHaloLayers = size(haloLayersIn) + allocate(haloLayers(nHaloLayers)) + do iHalo = 1, nHaloLayers + haloLayers(iHalo) = haloLayersIn(iHalo) + end do + else + nHaloLayers = size(field % sendList % halos) + DMPAR_DEBUG_WRITE('exch_halo_adjoint nHaloLayers:$i destList halos:$i' COMMA intArgs=(/nHaloLayers COMMA size(field%recvList%halos)/)) + allocate(haloLayers(nHaloLayers)) + do iHalo = 1, nHaloLayers + haloLayers(iHalo) = iHalo + end do + end if + +#ifdef _MPI + ! Setup Communication Lists + call mpas_dmpar_build_comm_lists(field % sendList, field % recvList, haloLayers, field % dimsizes, sendList, recvList) + + ! Allocate space in recv lists, and initiate mpi_irecv calls + commListPtr => sendList + do while(associated(commListPtr)) + allocate(commListPtr % rbuffer(commListPtr % nList)) + nullify(commListPtr % ibuffer) + call MPI_Irecv(commListPtr % rbuffer, commListPtr % nList, MPI_REALKIND, commListPtr % procID, commListPtr % procID, dminfo % comm, commListPtr % reqID, mpi_ierr) + + commListPtr => commListPtr % next + end do + + ! Allocate space in send lists, copy data into buffer, and initiate mpi_isend calls + commListPtr => recvList + do while(associated(commListPtr)) + allocate(commListPtr % rbuffer(commListPtr % nList)) + nullify(commListPtr % ibuffer) + bufferOffset = 0 + do iHalo = 1, nHaloLayers + nAdded = 0 + fieldCursor => field + do while(associated(fieldCursor)) + exchListPtr => fieldCursor % recvList % halos(haloLayers(iHalo)) % exchList + do while(associated(exchListPtr)) + if(exchListPtr % endPointID == commListPtr % procID) then + do i = 1, exchListPtr % nList + do j = 1, fieldCursor % dimSizes(1) + commListPtr % rbuffer((exchListPtr % srcList(i)-1) * fieldCursor % dimSizes(1) + j + bufferOffset) = fieldCursor % array(j, exchListPtr % destList(i)) + ! update halo cell + fieldCursor % array(j, exchListPtr % destList(i)) = 0.0_RKIND + nAdded = nAdded + 1 + end do + end do + end if + + exchListPtr => exchListPtr % next + end do + + fieldCursor => fieldCursor % next + end do + bufferOffset = bufferOffset + nAdded + end do + + call MPI_Isend(commListPtr % rbuffer, commListPtr % nList, MPI_REALKIND, commListPtr % procID, dminfo % my_proc_id, dminfo % comm, commListPtr % reqID, mpi_ierr) + commListPtr => commListPtr % next + end do +#endif + + ! Handle local copy. If MPI is off, then only local copies are performed. + fieldCursor => field + do while(associated(fieldCursor)) + do iHalo = 1, nHaloLayers + exchListPtr => fieldCursor % copyList % halos(haloLayers(iHalo)) % exchList + + do while(associated(exchListPtr)) + fieldCursor2 => field + do while(associated(fieldCursor2)) + if(exchListPtr % endPointID == fieldCursor2 % block % localBlockID) then + do i = 1, exchListPtr % nList + !fieldCursor2 % array(:, exchListPtr % destList(i)) = fieldCursor % array(:, exchListPtr % srcList(i)) + fieldCursor % array(:, exchListPtr % srcList(i)) = fieldCursor % array(:, exchListPtr % srcList(i)) + fieldCursor2 % array(:, exchListPtr % destList(i)) + fieldCursor2 % array(:, exchListPtr % destList(i)) = 0.0_RKIND + end do + end if + + fieldCursor2 => fieldCursor2 % next + end do + + exchListPtr => exchListPtr % next + end do + end do + + fieldCursor => fieldCursor % next + end do + +#ifdef _MPI + + ! Wait for mpi_irecv to finish, and unpack data from buffer + commListPtr => sendList + do while(associated(commListPtr)) + call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr) + bufferOffset = 0 + do iHalo = 1, nHaloLayers + nAdded = 0 + fieldCursor => field + do while(associated(fieldCursor)) + exchListPtr => fieldCursor % sendList % halos(haloLayers(iHalo)) % exchList + do while(associated(exchListPtr)) + if(exchListPtr % endPointID == commListPtr % procID) then + do i = 1, exchListPtr % nList + do j = 1, fieldCursor % dimSizes(1) + ! update cell in our block + fieldCursor % array(j, exchListPtr % srcList(i)) = fieldCursor % array(j, exchListPtr % srcList(i)) + commListPtr % rbuffer((exchListPtr % destList(i)-1) * fieldCursor % dimSizes(1) + j + bufferOffset) + commListPtr % rbuffer((exchListPtr % destList(i)-1) * fieldCursor % dimSizes(1) + j + bufferOffset) = 0.0_RKIND + end do + end do + nAdded = max(nAdded, maxval(exchListPtr % destList) * fieldCursor % dimSizes(1)) + end if + exchListPtr => exchListPtr % next + end do + + fieldCursor => fieldCursor % next + end do + bufferOffset = bufferOffset + nAdded + end do + commListPtr => commListPtr % next + end do + + ! wait for mpi_isend to finish. + commListPtr => recvList + do while(associated(commListPtr)) + call MPI_Wait(commListPtr % reqID, MPI_STATUS_IGNORE, mpi_ierr) + commListPtr => commListPtr % next + end do + + ! Destroy commLists. + call mpas_dmpar_destroy_communication_list(sendList) + call mpas_dmpar_destroy_communication_list(recvList) +#endif + + deallocate(haloLayers) + end if + + end subroutine mpas_dmpar_exch_halo_adj_field2d_real!}}} + !----------------------------------------------------------------------- ! routine mpas_dmpar_init_multihalo_exchange_list ! diff --git a/src/framework/mpas_framework.F b/src/framework/mpas_framework.F index 68445d186..798638365 100644 --- a/src/framework/mpas_framework.F +++ b/src/framework/mpas_framework.F @@ -27,6 +27,8 @@ module mpas_framework use mpas_io_units use mpas_block_decomp + private :: report_acc_devices + contains @@ -184,4 +186,135 @@ subroutine mpas_framework_finalize(dminfo, domain, io_system)!{{{ end subroutine mpas_framework_finalize!}}} + +!----------------------------------------------------------------------- +! routine mpas_framework_report_settings +! +!> \brief Report information about compile- and run-time settings to the log file +!> \author Michael Duda +!> \date 1 May 2024 +!> \details +!> This routine writes information about compile-time and run-time settings for +!> an MPAS core to the log file. +! +!----------------------------------------------------------------------- + subroutine mpas_framework_report_settings(domain) + +#ifdef MPAS_OPENMP + use mpas_threading, only : mpas_threading_get_num_threads +#endif + + implicit none + + type (domain_type), pointer :: domain + + + call mpas_log_write('') + call mpas_log_write('Output from ''git describe --dirty'': '//trim(domain % core % git_version)) + + call mpas_log_write('') + call mpas_log_write('Compile-time options:') + call mpas_log_write(' Build target: '//trim(domain % core % build_target)) + call mpas_log_write(' OpenMP support: ' // & +#ifdef MPAS_OPENMP + 'yes') +#else + 'no') +#endif + call mpas_log_write(' OpenACC support: ' // & +#ifdef MPAS_OPENACC + 'yes') +#else + 'no') +#endif + call mpas_log_write(' Default real precision: ' // & +#ifdef SINGLE_PRECISION + 'single') +#else + 'double') +#endif + call mpas_log_write(' Compiler flags: ' // & +#ifdef MPAS_DEBUG + 'debug') +#else + 'optimize') +#endif + call mpas_log_write(' I/O layer: ' // & +#ifdef MPAS_PIO_SUPPORT +#ifdef USE_PIO2 + 'PIO 2.x') +#else + 'PIO 1.x') +#endif +#else + 'SMIOL') +#endif + call mpas_log_write('') + + call mpas_log_write('Run-time settings:') + call mpas_log_write(' MPI task count: $i', intArgs=[domain % dminfo % nprocs]) +#ifdef MPAS_OPENMP + call mpas_log_write(' OpenMP max threads: $i', intArgs=[mpas_threading_get_max_threads()]) +#endif + call mpas_log_write('') + +#ifdef MPAS_OPENACC + call report_acc_devices() +#endif + + end subroutine mpas_framework_report_settings + + +#ifdef MPAS_OPENACC + !*********************************************************************** + ! + ! function report_acc_devices + ! + !> \brief Queries OpenACC devices and reports device info to log file + !> \author Michael G. Duda + !> \date 28 March 2024 + !> \details + !> This routine makes use of the OpenACC runtime library to obtain + !> information about how many and which kind of OpenACC devices are + !> available to the current MPI rank. + !> + !> NB: This routine is only compiled and only called if OPENACC=true. + ! + !----------------------------------------------------------------------- + subroutine report_acc_devices() + + use mpas_c_interfacing, only : mpas_sanitize_string + use openacc, only : acc_get_property_string, acc_get_property, acc_get_num_devices, acc_get_device_num, & + acc_get_device_type, acc_device_kind, acc_device_property, acc_property_vendor, & + acc_property_name, acc_property_driver + + implicit none + + integer(kind=acc_device_kind) :: device + character(len=StrKIND) :: device_vendor, device_name, driver_vers + integer :: ndevices, device_num + + + device = acc_get_device_type() + ndevices = acc_get_num_devices(device) + device_num = acc_get_device_num(device_num) + call acc_get_property_string(device_num, device, acc_property_vendor, device_vendor) + call acc_get_property_string(device_num, device, acc_property_name, device_name) + call acc_get_property_string(device_num, device, acc_property_driver, driver_vers) + + call mpas_sanitize_string(device_vendor) + call mpas_sanitize_string(device_name) + call mpas_sanitize_string(driver_vers) + + call mpas_log_write('OpenACC configuration:') + call mpas_log_write(' Number of visible devices: $i', intArgs=[ndevices]) + call mpas_log_write(' Device # for this MPI task: $i', intArgs=[device_num]) + call mpas_log_write(' Device vendor: '//trim(device_vendor)) + call mpas_log_write(' Device name: '//trim(device_name)) + call mpas_log_write(' Device driver version: '//trim(driver_vers)) + call mpas_log_write('') + + end subroutine report_acc_devices +#endif + end module mpas_framework diff --git a/src/framework/mpas_halo.F b/src/framework/mpas_halo.F index 4b14a925b..4ab8817c2 100644 --- a/src/framework/mpas_halo.F +++ b/src/framework/mpas_halo.F @@ -631,6 +631,7 @@ subroutine mpas_halo_exch_group_full_halo_exch(domain, groupName, iErr) maxNSendList = group % fields(i) % maxNSendList select case (group % fields(i) % nDims) + ! ! Packing code for 1-d real-valued fields ! @@ -762,6 +763,7 @@ subroutine mpas_halo_exch_group_full_halo_exch(domain, groupName, iErr) dim2 = compactHaloInfo(3) select case (group % fields(i) % nDims) + ! ! Unpacking code for 1-d real-valued fields ! diff --git a/src/framework/mpas_io.F b/src/framework/mpas_io.F index a9ddee472..09514a366 100644 --- a/src/framework/mpas_io.F +++ b/src/framework/mpas_io.F @@ -1533,6 +1533,28 @@ subroutine MPAS_io_set_var_indices(handle, fieldname, indices, ierr) end if end do #endif +#ifdef MPAS_SMIOL_SUPPORT + ! + ! For the SMIOL library, only the size of the outermost (decomposed) dimension + ! must match, and the sizes of any inner dimensions do not need to be checked. + ! Since the dimensionality of fields may vary, previously created decopositions + ! always store the size of the decomposed dimension at decomphandle % dims(1) + ! rather than at decomphandle % dims(ndims) + ! + if (.not. field_cursor % fieldhandle % has_unlimited_dim) then + if (decomp_cursor % decomphandle % dims(1) /= & + field_cursor % fieldhandle % dims(field_cursor % fieldhandle % ndims) % dimsize) then + decomp_cursor => decomp_cursor % next + cycle DECOMP_LOOP + end if + else + if (decomp_cursor % decomphandle % dims(1) /= & + field_cursor % fieldhandle % dims(field_cursor % fieldhandle % ndims - 1) % dimsize) then + decomp_cursor => decomp_cursor % next + cycle DECOMP_LOOP + end if + end if +#endif if (size(decomp_cursor % decomphandle % indices) /= size(indices)) then !call mpas_log_write('We do not have the same number of indices in this decomposition...') @@ -1710,6 +1732,11 @@ subroutine MPAS_io_set_var_indices(handle, fieldname, indices, ierr) #endif #ifdef MPAS_SMIOL_SUPPORT + ! Save the size of the outermost (decomposed) dimension for the field for use in + ! subsequent calls to MPAS_io_set_var_indices when checking whether this + ! decomposition can be reused for other fields + new_decomp % decomphandle % dims(1) = field_cursor % fieldhandle % dims(ndims) % dimsize + allocate(smiol_indices(size(indices))) smiol_indices(:) = int(indices(:), kind=SMIOL_offset_kind) - 1_SMIOL_offset_kind ! SMIOL indices are 0-based smiol_n_compute_elements = size(indices,kind=SMIOL_offset_kind) diff --git a/src/framework/mpas_log.F b/src/framework/mpas_log.F index 8462545fb..8e51b8ca1 100644 --- a/src/framework/mpas_log.F +++ b/src/framework/mpas_log.F @@ -470,15 +470,15 @@ end subroutine mpas_log_open !> regardless of if all tasks have open log files. !> flushNow: flag indicating the message should be flushed immediately. !> Note: error and critical error messages are always flushed immediately. -!> intArgs, realArgs, logicArgs: arrays of variable values to be inserted into the -!> message to replace the following characters: $i, $r, $l +!> intArgs, int8Args, realArgs, logicArgs: arrays of variable values to be inserted into the +!> message to replace the following characters: $i, $j, $r, $l !> See routine log_expand_string below for details. !> ! !----------------------------------------------------------------------- recursive subroutine mpas_log_write(message, messageType, masterOnly, flushNow, & - intArgs, realArgs, logicArgs, err) + intArgs, int8Args, realArgs, logicArgs, err) use mpas_threading @@ -492,6 +492,7 @@ recursive subroutine mpas_log_write(message, messageType, masterOnly, flushNow, logical, intent(in), optional :: masterOnly !< Input: flag to only print message on master task logical, intent(in), optional :: flushNow !< Input: flag to force a flush of the message buffer integer, dimension(:), intent(in), optional :: intArgs !< Input: integer variable values to insert into message + integer(kind=I8KIND), dimension(:), intent(in), optional :: int8Args !< Input: integer variable values to insert into message real(kind=RKIND), dimension(:), intent(in), optional :: realArgs !< Input: real variable values to insert into message !< Input: exponential notation variable values to insert into message logical, dimension(:), intent(in), optional :: logicArgs !< Input: logical variable values to insert into message @@ -540,7 +541,7 @@ recursive subroutine mpas_log_write(message, messageType, masterOnly, flushNow, ! Construct message by expanding variable values as needed and inserting message type prefix - call log_expand_string(message, messageExpanded, intArgs=intArgs, logicArgs=logicArgs, realArgs=realArgs) + call log_expand_string(message, messageExpanded, intArgs=intArgs, int8Args=int8Args, logicArgs=logicArgs, realArgs=realArgs) ! Determine message prefix select case (messageTypeHere) @@ -809,7 +810,7 @@ subroutine log_abort() #ifdef _MPI #ifndef NOMPIMOD #ifdef MPAS_USE_MPI_F08 - use mpi_f08 + use mpi_f08, only : MPI_COMM_WORLD, MPI_Abort #else use mpi #endif @@ -870,6 +871,7 @@ end subroutine log_abort !> The variables to be expanded are represented with a '$' symbol followed !> by one of these indicators: !> $i -> integer, formatted to be length of integer + !> $j -> integer(kind=I8KIND), formatted to be length of integer !> $l -> logical, fomatted as 'T' or 'F' !> $r -> real, formatted as 9 digits of precision for SP mode, 17 for DP mode !> Floats are formatted using 'G' format which is smart about @@ -880,13 +882,13 @@ end subroutine log_abort !> run out before the $ expansion indicators are all replaced, the remaining !> expansions will be filled with a fill value ('**'). The fill value is also !> used if the expansion indicator is of an unknown type, where the valid types - !> are $i, $l, $r. + !> are $i, $j, $l, $r. !> If the user prefers more specific formatting, they have to do it external !> to this routine in a local string variable. Similarly, character variables !> can be handled by the string concatenation command (//). !> This routine is based off of mpas_expand_string. !----------------------------------------------------------------------- - subroutine log_expand_string(inString, outString, intArgs, logicArgs, realArgs) + subroutine log_expand_string(inString, outString, intArgs, int8Args, logicArgs, realArgs) implicit none @@ -896,6 +898,7 @@ subroutine log_expand_string(inString, outString, intArgs, logicArgs, realArgs) character (len=*), intent(in) :: inString !< Input: message to be expanded integer, dimension(:), intent(in), optional :: intArgs + integer(kind=I8KIND), dimension(:), intent(in), optional :: int8Args !< Input, Optional: array of integer variable values to be used in expansion logical, dimension(:), intent(in), optional :: logicArgs !< Input, Optional: array of logical variable values to be used in expansion @@ -915,8 +918,8 @@ subroutine log_expand_string(inString, outString, intArgs, logicArgs, realArgs) ! local variables !----------------------------------------------------------------- integer :: i, curLen - integer :: nInts, nLogicals, nReals, nExps !< the length of the variable arrays passed in - integer :: iInt, iLogical, iReal !< Counter for the current index into each variable array + integer :: nInts, nInt8s, nLogicals, nReals, nExps !< the length of the variable arrays passed in + integer :: iInt, iInt8, iLogical, iReal !< Counter for the current index into each variable array character (len=ShortStrKIND) :: realFormat !< Format string to create to use for writing real variables to log file integer :: realPrecision !< precision of a real variable @@ -926,6 +929,7 @@ subroutine log_expand_string(inString, outString, intArgs, logicArgs, realArgs) ! Initialize the current index for each variable array to 1 iInt = 1 + iInt8 = 1 iLogical = 1 iReal = 1 @@ -936,6 +940,12 @@ subroutine log_expand_string(inString, outString, intArgs, logicArgs, realArgs) nInts = 0 endif + if (present(int8Args)) then + nInt8s = size(int8Args) + else + nInt8s = 0 + endif + if (present(logicArgs)) then nLogicals = size(logicArgs) else @@ -973,6 +983,15 @@ subroutine log_expand_string(inString, outString, intArgs, logicArgs, realArgs) else varPart = errVarPart endif + case ('j') + ! make the format large enough to include a large integer (up to 17 digits for 8-byte int) + ! it will be trimmed below + if (iInt8 <= nInt8s) then + write(varPart,'(i17)') int8Args(iInt8) + iInt8 = iInt8 + 1 + else + varPart = errVarPart + endif case ('l') if (iLogical <= nLogicals) then if (logicArgs(iLogical)) then diff --git a/src/framework/mpas_timekeeping.F b/src/framework/mpas_timekeeping.F index 93fdb8633..659d9bb4f 100644 --- a/src/framework/mpas_timekeeping.F +++ b/src/framework/mpas_timekeeping.F @@ -1001,13 +1001,17 @@ subroutine mpas_adjust_alarm_to_reference_time(clock, alarmID, referenceTime, ie ! Local variables type (MPAS_Alarm_type), pointer :: alarmPtr type (MPAS_TimeInterval_type) :: searchInterval, searchRemainder + type (MPAS_TimeInterval_type) :: zeroInterval integer (kind=I8KIND) :: nDivs integer :: threadNum integer :: ierr_tmp + ierr = 0 ierr_tmp = 0 + call mpas_set_timeInterval(zeroInterval, S=0) + threadNum = mpas_threading_get_thread_num() if ( threadNum == 0 ) then @@ -1024,22 +1028,26 @@ subroutine mpas_adjust_alarm_to_reference_time(clock, alarmID, referenceTime, ie if (now > referenceTime) then searchInterval = now - referenceTime call mpas_interval_division(referenceTime, searchInterval, alarmPtr % ringTimeInterval, nDivs, searchRemainder) - alarmPtr % prevRingTime = now - searchRemainder else searchInterval = referenceTime - now call mpas_interval_division(referenceTime, searchInterval, alarmPtr % ringTimeInterval, nDivs, searchRemainder) - alarmPtr % prevRingTime = now - (alarmPtr % ringTimeInterval - searchRemainder) + if (searchRemainder /= zeroInterval) then + searchRemainder = alarmPtr % ringTimeInterval - searchRemainder + end if endif - else ! MPAS_REVERSE + alarmPtr % prevRingTime = now - alarmPtr % ringTimeInterval - searchRemainder + else ! MPAS_BACKWARD if (now < referenceTime) then - searchInterval = now - referenceTime + searchInterval = referenceTime - now call mpas_interval_division(referenceTime, searchInterval, alarmPtr % ringTimeInterval, nDivs, searchRemainder) - alarmPtr % prevRingTime = now - searchRemainder else - searchInterval = referenceTime - now + searchInterval = now - referenceTime call mpas_interval_division(referenceTime, searchInterval, alarmPtr % ringTimeInterval, nDivs, searchRemainder) - alarmPtr % prevRingTime = now - (alarmPtr % ringTimeInterval - searchRemainder) + if (searchRemainder /= zeroInterval) then + searchRemainder = alarmPtr % ringTimeInterval - searchRemainder + end if endif + alarmPtr % prevRingTime = now + alarmPtr % ringTimeInterval + searchRemainder end if ! forward direction !call mpas_print_alarm(clock, alarmID, ierr_tmp) end if ! isRecurring diff --git a/src/operators/CMakeLists.txt b/src/operators/CMakeLists.txt new file mode 100644 index 000000000..5c04339b8 --- /dev/null +++ b/src/operators/CMakeLists.txt @@ -0,0 +1,24 @@ +list(APPEND _mpas_operators_src + mpas_geometry_utils.F + mpas_matrix_operations.F + mpas_rbf_interpolation.F + mpas_spline_interpolation.F + mpas_tensor_operations.F + mpas_tracer_advection_helpers.F + mpas_tracer_advection_mono.F + mpas_tracer_advection_std.F + mpas_vector_operations.F + mpas_vector_reconstruction.F) + +add_library(operators ${_mpas_operators_src}) + +mpas_fortran_target(operators) + +add_library(${PROJECT_NAME}::operators ALIAS operators) + +set_target_properties(operators PROPERTIES OUTPUT_NAME mpas_operators) +target_link_libraries(operators PUBLIC ${PROJECT_NAME}::framework) + +install(TARGETS operators EXPORT ${PROJECT_NAME}Exports + ARCHIVE DESTINATION ${CMAKE_INSTALL_LIBDIR} + LIBRARY DESTINATION ${CMAKE_INSTALL_LIBDIR}) diff --git a/src/operators/mpas_vector_reconstruction.F b/src/operators/mpas_vector_reconstruction.F index 789ba50c1..605da9cd6 100644 --- a/src/operators/mpas_vector_reconstruction.F +++ b/src/operators/mpas_vector_reconstruction.F @@ -24,6 +24,16 @@ module mpas_vector_reconstruction use mpas_rbf_interpolation use mpas_vector_operations +#ifdef MPAS_OPENACC + ! For use in regions ported with OpenACC to track in-function transfers + use mpas_timer, only : mpas_timer_start, mpas_timer_stop +#define MPAS_ACC_TIMER_START(X) call mpas_timer_start(X) +#define MPAS_ACC_TIMER_STOP(X) call mpas_timer_stop(X) +#else +#define MPAS_ACC_TIMER_START(X) +#define MPAS_ACC_TIMER_STOP(X) +#endif + implicit none public :: mpas_init_reconstruct, mpas_reconstruct @@ -207,10 +217,11 @@ subroutine mpas_reconstruct_2d(meshPool, u, uReconstructX, uReconstructY, uRecon ! temporary arrays needed in the compute procedure logical :: includeHalosLocal - integer, pointer :: nCells + integer, pointer :: nCells_ptr, nVertLevels_ptr + integer :: nCells, nVertLevels integer, dimension(:,:), pointer :: edgesOnCell integer, dimension(:), pointer :: nEdgesOnCell - integer :: iCell,iEdge, i + integer :: iCell,iEdge, i, k real(kind=RKIND), dimension(:), pointer :: latCell, lonCell real (kind=RKIND), dimension(:,:,:), pointer :: coeffs_reconstruct @@ -233,64 +244,108 @@ subroutine mpas_reconstruct_2d(meshPool, u, uReconstructX, uReconstructY, uRecon call mpas_pool_get_array(meshPool, 'edgesOnCell', edgesOnCell) if ( includeHalosLocal ) then - call mpas_pool_get_dimension(meshPool, 'nCells', nCells) + call mpas_pool_get_dimension(meshPool, 'nCells', nCells_ptr) else - call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCells) + call mpas_pool_get_dimension(meshPool, 'nCellsSolve', nCells_ptr) end if + call mpas_pool_get_dimension(meshPool, 'nVertLevels', nVertLevels_ptr) + ! Dereference scalar (single-value) pointers to ensure OpenACC copies the value pointed to implicitly + nCells = nCells_ptr + nVertLevels = nVertLevels_ptr call mpas_pool_get_array(meshPool, 'latCell', latCell) call mpas_pool_get_array(meshPool, 'lonCell', lonCell) call mpas_pool_get_config(meshPool, 'on_a_sphere', on_a_sphere) + MPAS_ACC_TIMER_START('mpas_reconstruct_2d [ACC_data_xfer]') + ! Only use sections needed, nCells may be all cells or only non-halo cells + !$acc enter data copyin(coeffs_reconstruct(:,:,1:nCells),nEdgesOnCell(1:nCells), & + !$acc edgesOnCell(:,1:nCells),latCell(1:nCells),lonCell(1:nCells)) + !$acc enter data copyin(u(:,:)) + !$acc enter data create(uReconstructX(:,1:nCells),uReconstructY(:,1:nCells), & + !$acc uReconstructZ(:,1:nCells),uReconstructZonal(:,1:nCells), & + !$acc uReconstructMeridional(:,1:nCells)) + MPAS_ACC_TIMER_STOP('mpas_reconstruct_2d [ACC_data_xfer]') + ! loop over cell centers !$omp do schedule(runtime) + !$acc parallel default(present) + !$acc loop gang do iCell = 1, nCells ! initialize the reconstructed vectors - uReconstructX(:,iCell) = 0.0 - uReconstructY(:,iCell) = 0.0 - uReconstructZ(:,iCell) = 0.0 + !$acc loop vector + do k = 1, nVertLevels + uReconstructX(k,iCell) = 0.0 + uReconstructY(k,iCell) = 0.0 + uReconstructZ(k,iCell) = 0.0 + end do ! a more efficient reconstruction where rbf_values*matrix_reconstruct ! has been precomputed in coeffs_reconstruct - do i=1,nEdgesOnCell(iCell) + !$acc loop seq + do i = 1, nEdgesOnCell(iCell) iEdge = edgesOnCell(i,iCell) - uReconstructX(:,iCell) = uReconstructX(:,iCell) & - + coeffs_reconstruct(1,i,iCell) * u(:,iEdge) - uReconstructY(:,iCell) = uReconstructY(:,iCell) & - + coeffs_reconstruct(2,i,iCell) * u(:,iEdge) - uReconstructZ(:,iCell) = uReconstructZ(:,iCell) & - + coeffs_reconstruct(3,i,iCell) * u(:,iEdge) + !$acc loop vector + do k = 1, nVertLevels + uReconstructX(k,iCell) = uReconstructX(k,iCell) & + + coeffs_reconstruct(1,i,iCell) * u(k,iEdge) + uReconstructY(k,iCell) = uReconstructY(k,iCell) & + + coeffs_reconstruct(2,i,iCell) * u(k,iEdge) + uReconstructZ(k,iCell) = uReconstructZ(k,iCell) & + + coeffs_reconstruct(3,i,iCell) * u(k,iEdge) + end do enddo enddo ! iCell + !$acc end parallel !$omp end do call mpas_threading_barrier() if (on_a_sphere) then !$omp do schedule(runtime) + !$acc parallel default(present) + !$acc loop gang do iCell = 1, nCells clat = cos(latCell(iCell)) slat = sin(latCell(iCell)) clon = cos(lonCell(iCell)) slon = sin(lonCell(iCell)) - uReconstructZonal(:,iCell) = -uReconstructX(:,iCell)*slon + & - uReconstructY(:,iCell)*clon - uReconstructMeridional(:,iCell) = -(uReconstructX(:,iCell)*clon & - + uReconstructY(:,iCell)*slon)*slat & - + uReconstructZ(:,iCell)*clat + !$acc loop vector + do k = 1, nVertLevels + uReconstructZonal(k,iCell) = -uReconstructX(k,iCell)*slon + & + uReconstructY(k,iCell)*clon + uReconstructMeridional(k,iCell) = -(uReconstructX(k,iCell)*clon & + + uReconstructY(k,iCell)*slon)*slat & + + uReconstructZ(k,iCell)*clat + end do end do + !$acc end parallel !$omp end do else !$omp do schedule(runtime) + !$acc parallel default(present) + !$acc loop gang vector collapse(2) do iCell = 1, nCells - uReconstructZonal (:,iCell) = uReconstructX(:,iCell) - uReconstructMeridional(:,iCell) = uReconstructY(:,iCell) + do k = 1, nVertLevels + uReconstructZonal (k,iCell) = uReconstructX(k,iCell) + uReconstructMeridional(k,iCell) = uReconstructY(k,iCell) + end do end do + !$acc end parallel !$omp end do end if + MPAS_ACC_TIMER_START('mpas_reconstruct_2d [ACC_data_xfer]') + !$acc exit data delete(coeffs_reconstruct(:,:,1:nCells),nEdgesOnCell(1:nCells), & + !$acc edgesOnCell(:,1:nCells),latCell(1:nCells),lonCell(1:nCells)) + !$acc exit data delete(u(:,:)) + !$acc exit data copyout(uReconstructX(:,1:nCells),uReconstructY(:,1:nCells), & + !$acc uReconstructZ(:,1:nCells), uReconstructZonal(:,1:nCells), & + !$acc uReconstructMeridional(:,1:nCells)) + MPAS_ACC_TIMER_STOP('mpas_reconstruct_2d [ACC_data_xfer]') + end subroutine mpas_reconstruct_2d!}}} diff --git a/src/tools/CMakeLists.txt b/src/tools/CMakeLists.txt new file mode 100644 index 000000000..513ae48cf --- /dev/null +++ b/src/tools/CMakeLists.txt @@ -0,0 +1,30 @@ + +if (DEFINED ENV{MPAS_TOOL_DIR}) + message(STATUS "*** Using MPAS tools from $ENV{MPAS_TOOL_DIR} ***") + add_custom_target(namelist_gen) + add_custom_command( + TARGET namelist_gen PRE_BUILD + COMMAND ${CMAKE_COMMAND} -E copy $ENV{MPAS_TOOL_DIR}/input_gen/namelist_gen ${CMAKE_CURRENT_BINARY_DIR}/namelist_gen) + add_custom_target(streams_gen) + add_custom_command( + TARGET streams_gen PRE_BUILD + COMMAND ${CMAKE_COMMAND} -E copy $ENV{MPAS_TOOL_DIR}/input_gen/streams_gen ${CMAKE_CURRENT_BINARY_DIR}/streams_gen) + add_custom_target(parse) + add_custom_command( + TARGET parse PRE_BUILD + COMMAND ${CMAKE_COMMAND} -E copy $ENV{MPAS_TOOL_DIR}/input_gen/parse ${CMAKE_CURRENT_BINARY_DIR}/parse) +else() + message(STATUS "*** Building MPAS tools from source ***") + # Make build tools, need to be compiled with serial compiler. + set(CMAKE_C_COMPILER ${SCC}) + + add_executable(streams_gen input_gen/streams_gen.c input_gen/test_functions.c ../external/ezxml/ezxml.c) + add_executable(namelist_gen input_gen/namelist_gen.c input_gen/test_functions.c ../external/ezxml/ezxml.c) + add_executable(parse registry/parse.c registry/dictionary.c registry/gen_inc.c registry/fortprintf.c registry/utility.c ../external/ezxml/ezxml.c) + + foreach(EXEITEM streams_gen namelist_gen parse) + target_compile_definitions(${EXEITEM} PRIVATE ${CPPDEFS}) + target_compile_options(${EXEITEM} PRIVATE "-Uvector") + target_include_directories(${EXEITEM} PRIVATE ${INCLUDES}) + endforeach() +endif() diff --git a/src/tools/input_gen/CMakeLists.txt b/src/tools/input_gen/CMakeLists.txt new file mode 100644 index 000000000..2b8c77047 --- /dev/null +++ b/src/tools/input_gen/CMakeLists.txt @@ -0,0 +1,6 @@ + +add_executable(mpas_namelist_gen namelist_gen.c test_functions.c) +target_link_libraries(mpas_namelist_gen PUBLIC ${PROJECT_NAME}::external::ezxml) + +add_executable(mpas_streams_gen streams_gen.c test_functions.c) +target_link_libraries(mpas_streams_gen PUBLIC ${PROJECT_NAME}::external::ezxml) diff --git a/src/tools/registry/CMakeLists.txt b/src/tools/registry/CMakeLists.txt new file mode 100644 index 000000000..7d18e3f3b --- /dev/null +++ b/src/tools/registry/CMakeLists.txt @@ -0,0 +1,17 @@ + +#Parsing library core-independent code +add_library(parselib dictionary.c fortprintf.c utility.c) +target_link_libraries(parselib PUBLIC ${PROJECT_NAME}::external::ezxml) +target_link_libraries(parselib PUBLIC ${PROJECT_NAME}::external::esmf) + +# Generate parser for each core +# +# Note: One parser is required per-core because the gen_inc.c depends on +# a pre-processor define MPAS_NAMELIST_SUFFIX which is core specific +foreach(_core IN LISTS MPAS_CORES) + add_executable(mpas_parse_${_core} parse.c gen_inc.c) + target_link_libraries(mpas_parse_${_core} PUBLIC parselib) + target_compile_definitions(mpas_parse_${_core} PRIVATE MPAS_NAMELIST_SUFFIX=${_core} + MPAS_GIT_VERSION=${MPAS_GIT_VERSION} + MPAS_EXE_NAME=${_core}_model) +endforeach() diff --git a/src/tools/registry/gen_inc.c b/src/tools/registry/gen_inc.c index 582327309..5ec8b06d1 100644 --- a/src/tools/registry/gen_inc.c +++ b/src/tools/registry/gen_inc.c @@ -9,14 +9,26 @@ #include #include #include +#include #include "ezxml.h" #include "registry_types.h" #include "gen_inc.h" #include "fortprintf.h" #include "utility.h" -#define STR(s) #s -#define MACRO_TO_STR(s) STR(s) +#ifdef MPAS_CAM_DYCORE +#include +#endif + +void process_core_macro(const char *macro, const char *val, va_list ap); +void process_domain_macro(const char *macro, const char *val, va_list ap); +char * nmlopt_from_str(regex_t *preg, const char *str, regoff_t *next); +const char * nmlopt_type(ezxml_t registry, const char *nmlopt); +int package_logic_routine(FILE *fd, regex_t *preg, const char *corename, + const char *packagename, const char *packagewhen, + ezxml_t registry); +void gen_pkg_debug_info(FILE *fd, regex_t *preg, ezxml_t registry, + const char *packagename, const char *packagewhen); #define NUM_MODIFIED_ATTRS 2 #define NUM_IGNORED_ATTRS 9 @@ -44,12 +56,7 @@ static const char *ATTRS_TO_MODIFY[NUM_MODIFIED_ATTRS][2] = { }; -void write_model_variables(ezxml_t registry){/*{{{*/ - const char * suffix = MACRO_TO_STR(MPAS_NAMELIST_SUFFIX); - const char * exe_name = MACRO_TO_STR(MPAS_EXE_NAME); - const char * git_ver = MACRO_TO_STR(MPAS_GIT_VERSION); - const char * build_target = MACRO_TO_STR(MPAS_BUILD_TARGET); - +void write_model_variables(ezxml_t registry, int macro_count, const char **macros){/*{{{*/ const char *modelname, *corename, *version; FILE *fd; @@ -62,22 +69,45 @@ void write_model_variables(ezxml_t registry){/*{{{*/ fortprintf(fd, " core %% modelName = '%s'\n", modelname); fortprintf(fd, " core %% coreName = '%s'\n", corename); fortprintf(fd, " core %% modelVersion = '%s'\n", version); - fortprintf(fd, " core %% executableName = '%s'\n", exe_name); - fortprintf(fd, " core %% git_version = '%s'\n", git_ver); - fortprintf(fd, " core %% build_target = '%s'\n", build_target); + + parse_macros(process_core_macro, macro_count, macros, fd); fclose(fd); fd = fopen("domain_variables.inc", "w+"); - fortprintf(fd, " domain %% namelist_filename = 'namelist.%s'\n", suffix); - fortprintf(fd, " domain %% streams_filename = 'streams.%s'\n", suffix); + parse_macros(process_domain_macro, macro_count, macros, fd); fclose(fd); }/*}}}*/ +void process_core_macro(const char *macro, const char *val, va_list ap) +{ + FILE *fd = va_arg(ap, FILE *); + + if (strcmp(macro, "MPAS_EXE_NAME") == 0) { + fortprintf(fd, " core %% executableName = '%s'\n", val); + } else if (strcmp(macro, "MPAS_GIT_VERSION") == 0) { + fortprintf(fd, " core %% git_version = '%s'\n", val); + } else if (strcmp(macro, "MPAS_BUILD_TARGET") == 0) { + fortprintf(fd, " core %% build_target = '%s'\n", val); + } +} + + +void process_domain_macro(const char *macro, const char *val, va_list ap) +{ + FILE *fd = va_arg(ap, FILE *); + + if (strcmp(macro, "MPAS_NAMELIST_SUFFIX") == 0) { + fortprintf(fd, " domain %% namelist_filename = 'namelist.%s'\n", val); + fortprintf(fd, " domain %% streams_filename = 'streams.%s'\n", val); + } +} + + int write_field_pointer_arrays(FILE* fd){/*{{{*/ fortprintf(fd, "\n"); fortprintf(fd, " type (field0DReal), pointer :: r0Ptr\n"); @@ -678,8 +708,12 @@ int parse_namelist_records_from_registry(ezxml_t registry)/*{{{*/ ezxml_t nmlrecs_xml, nmlopt_xml; const char *const_core; - const char *nmlrecname, *nmlrecindef, *nmlrecinsub; - const char *nmloptname, *nmlopttype, *nmloptval, *nmloptunits, *nmloptdesc, *nmloptposvals, *nmloptindef; + const char *original_nmlrecname, *nmlrecindef, *nmlrecinsub; + const char *original_nmloptname, *nmlopttype, *nmloptval, *nmloptunits, *nmloptdesc, *nmloptposvals, *nmloptindef; + + // Fortran variable names have a length limit of 63 characters. + 1 for the terminating null character. + char nmlrecname[64]; + char nmloptname[64]; char pool_name[1024]; char core_string[1024]; @@ -725,7 +759,9 @@ int parse_namelist_records_from_registry(ezxml_t registry)/*{{{*/ // Parse Namelist Records for (nmlrecs_xml = ezxml_child(registry, "nml_record"); nmlrecs_xml; nmlrecs_xml = nmlrecs_xml->next){ - nmlrecname = ezxml_attr(nmlrecs_xml, "name"); + original_nmlrecname = ezxml_attr(nmlrecs_xml, "name"); + mangle_name(nmlrecname, sizeof(nmlrecname), original_nmlrecname); + nmlrecindef = ezxml_attr(nmlrecs_xml, "in_defaults"); nmlrecinsub = ezxml_attr(nmlrecs_xml, "in_subpool"); @@ -759,7 +795,9 @@ int parse_namelist_records_from_registry(ezxml_t registry)/*{{{*/ // Define variable definitions prior to reading the namelist in. for (nmlopt_xml = ezxml_child(nmlrecs_xml, "nml_option"); nmlopt_xml; nmlopt_xml = nmlopt_xml->next){ - nmloptname = ezxml_attr(nmlopt_xml, "name"); + original_nmloptname = ezxml_attr(nmlopt_xml, "name"); + mangle_name(nmloptname, sizeof(nmloptname), original_nmloptname); + nmlopttype = ezxml_attr(nmlopt_xml, "type"); nmloptval = ezxml_attr(nmlopt_xml, "default_value"); nmloptunits = ezxml_attr(nmlopt_xml, "units"); @@ -791,7 +829,9 @@ int parse_namelist_records_from_registry(ezxml_t registry)/*{{{*/ // Define the namelist block, to read the namelist record in. fortprintf(fd, " namelist /%s/ &\n", nmlrecname); for (nmlopt_xml = ezxml_child(nmlrecs_xml, "nml_option"); nmlopt_xml; nmlopt_xml = nmlopt_xml->next){ - nmloptname = ezxml_attr(nmlopt_xml, "name"); + original_nmloptname = ezxml_attr(nmlopt_xml, "name"); + mangle_name(nmloptname, sizeof(nmloptname), original_nmloptname); + if(nmlopt_xml->next){ fortprintf(fd, " %s, &\n", nmloptname); } else { @@ -822,7 +862,9 @@ int parse_namelist_records_from_registry(ezxml_t registry)/*{{{*/ // Define broadcast calls for namelist values. fortprintf(fd, " if (ierr <= 0) then\n"); for (nmlopt_xml = ezxml_child(nmlrecs_xml, "nml_option"); nmlopt_xml; nmlopt_xml = nmlopt_xml->next){ - nmloptname = ezxml_attr(nmlopt_xml, "name"); + original_nmloptname = ezxml_attr(nmlopt_xml, "name"); + mangle_name(nmloptname, sizeof(nmloptname), original_nmloptname); + nmlopttype = ezxml_attr(nmlopt_xml, "type"); if(strncmp(nmlopttype, "real", 1024) == 0){ @@ -840,7 +882,9 @@ int parse_namelist_records_from_registry(ezxml_t registry)/*{{{*/ fortprintf(fd, " call mpas_log_write(' The following values will be used for variables in this record:')\n"); fortprintf(fd, " call mpas_log_write(' ')\n"); for (nmlopt_xml = ezxml_child(nmlrecs_xml, "nml_option"); nmlopt_xml; nmlopt_xml = nmlopt_xml->next){ - nmloptname = ezxml_attr(nmlopt_xml, "name"); + original_nmloptname = ezxml_attr(nmlopt_xml, "name"); + mangle_name(nmloptname, sizeof(nmloptname), original_nmloptname); + nmlopttype = ezxml_attr(nmlopt_xml, "type"); if (strncmp(nmlopttype, "character", 1024) == 0) { @@ -867,10 +911,12 @@ int parse_namelist_records_from_registry(ezxml_t registry)/*{{{*/ fortprintf(fd, "\n"); for (nmlopt_xml = ezxml_child(nmlrecs_xml, "nml_option"); nmlopt_xml; nmlopt_xml = nmlopt_xml->next){ - nmloptname = ezxml_attr(nmlopt_xml, "name"); + original_nmloptname = ezxml_attr(nmlopt_xml, "name"); + mangle_name(nmloptname, sizeof(nmloptname), original_nmloptname); - fortprintf(fd, " call mpas_pool_add_config(%s, '%s', %s)\n", pool_name, nmloptname, nmloptname); - fortprintf(fcg, " call mpas_pool_get_config(configPool, '%s', %s)\n", nmloptname, nmloptname); + // Always keep namelist options to their original names in MPAS pools for compatibility reasons. + fortprintf(fd, " call mpas_pool_add_config(%s, '%s', %s)\n", pool_name, original_nmloptname, nmloptname); + fortprintf(fcg, " call mpas_pool_get_config(configPool, '%s', %s)\n", original_nmloptname, nmloptname); } fortprintf(fd, "\n"); fortprintf(fcg, "\n"); @@ -2516,3 +2562,404 @@ int parse_structs_from_registry(ezxml_t registry)/*{{{*/ }/*}}}*/ +/** + * mangle_name + * + * Perform name mangling for MPAS namelist groups and options, as appropriate, depending on the containing + * host model. + * + * When MPAS is used as a dynamical core in a host model (e.g., CAM/CAM-SIMA), it needs to share + * the namelist file with other model components. As a result, MPAS namelist groups and options may not + * be easily recognizable at first sight. With the `MPAS_CAM_DYCORE` macro being defined, this function + * adds a unique identifier to each MPAS namelist group and option name by performing the following + * transformations: + * + * 1. Leading "config_" is removed recursively from the name. Case-insensitive. + * 2. Leading "mpas_" is removed recursively from the name. Case-insensitive. + * 3. Prepend "mpas_" to the name. + * + * By doing so, it is now easier to distinguish MPAS namelist groups and options from host model ones. + * The possibility of name collisions with host model ones is also resolved once and for all. + * + * For stand-alone MPAS, where the `MPAS_CAM_DYCORE` macro is not defined, this function just returns + * the name as is. + */ +void mangle_name(char *new_name, const size_t new_name_size, const char *old_name) +{ + if (!new_name || !old_name || new_name_size == 0) return; + +#ifdef MPAS_CAM_DYCORE + const char *const new_prefix = "mpas_"; + const char *const old_prefix = "config_"; + + // Remove all leading whitespaces by moving pointer forward. + while (*old_name != '\0' && isspace((unsigned char) *old_name)) old_name++; + + // Remove all leading "config_" by moving pointer forward. + while (strncasecmp(old_name, old_prefix, strlen(old_prefix)) == 0) old_name += strlen(old_prefix); + + // Remove all leading "mpas_" by moving pointer forward. + while (strncasecmp(old_name, new_prefix, strlen(new_prefix)) == 0) old_name += strlen(new_prefix); + + *new_name = '\0'; + snprintf(new_name, new_name_size, "%s%s", new_prefix, old_name); + + // Remove all trailing whitespaces by zeroing (nulling) out. + new_name += strlen(new_name) - 1; + while (*new_name != '\0' && isspace((unsigned char) *new_name)) *new_name-- = '\0'; +#else + snprintf(new_name, new_name_size, "%s", old_name); +#endif +} + + +/****************************************************************************** + * + * generate_package_logic + * + * Generates code for the Fortran routine 'CORE_setup_packages_when' in the file + * 'setup_packages.inc', where CORE is the core abbreviation from the registry + * core_abbrev attribute. + * + * Inputs: + * registry - an XML tree containing the complete Registry file + * + * Return value: An integer status code. A value of 0 indicates success, and a + * non-zero value indicates that an error was encountered when generating + * logic for the package. + * + ******************************************************************************/ +int generate_package_logic(ezxml_t registry)/*{{{*/ +{ + ezxml_t packages_xml, package_xml; + FILE *fd; + regex_t preg; + char *match = NULL; + regoff_t next = 0; + const char *corename; + + corename = ezxml_attr(registry, "core_abbrev"); + + printf("---- GENERATING PACKAGE LOGIC ----\n"); + + if (regcomp(&preg, "config[0-9a-zA-Z_]*", REG_EXTENDED)) { + printf("Error compiling regex.\n"); + return 1; + } + + fd = fopen("setup_packages.inc", "w+"); + + fortprintf(fd, "#ifdef MPAS_DEBUG\n"); + fortprintf(fd, "#define COMMA ,\n"); + fortprintf(fd, "#define PACKAGE_LOGIC_PRINT(M) call mpas_log_write(M)\n"); + fortprintf(fd, "#else\n"); + fortprintf(fd, "#define PACKAGE_LOGIC_PRINT(M) ! M\n"); + fortprintf(fd, "#endif\n\n"); + + fortprintf(fd, " !\n"); + fortprintf(fd, " ! WARNING: This function is automatically generated at compile time.\n"); + fortprintf(fd, " ! Any modifications to this code will be lost when MPAS is recompiled.\n"); + fortprintf(fd, " !\n"); + fortprintf(fd, " function %s_setup_packages_when(configPool, packagePool) result(ierr)\n", corename); + fortprintf(fd, "\n"); + fortprintf(fd, " use mpas_derived_types, only : mpas_pool_type\n"); + fortprintf(fd, " use mpas_log, only : mpas_log_write\n"); + fortprintf(fd, "\n"); + fortprintf(fd, " implicit none\n"); + fortprintf(fd, "\n"); + fortprintf(fd, " integer :: ierr\n"); + fortprintf(fd, "\n"); + fortprintf(fd, " type (mpas_pool_type), intent(in) :: configPool\n"); + fortprintf(fd, " type (mpas_pool_type), intent(inout) :: packagePool\n"); + fortprintf(fd, "\n"); + fortprintf(fd, "\n"); + fortprintf(fd, " ierr = 0\n"); + fortprintf(fd, "\n"); + fortprintf(fd, " call mpas_log_write('')\n"); + fortprintf(fd, " call mpas_log_write('Configuring registry-specified packages...')\n"); + fortprintf(fd, "\n"); + + for (packages_xml = ezxml_child(registry, "packages"); packages_xml; packages_xml = packages_xml->next) { + for (package_xml = ezxml_child(packages_xml, "package"); package_xml; package_xml = package_xml->next) { + const char *packagename, *packagewhen; + + packagename = ezxml_attr(package_xml, "name"); + packagewhen = ezxml_attr(package_xml, "active_when"); + + if (packagewhen != NULL) { + fortprintf(fd, " call %s_setup_%s_package(configPool, packagePool)\n", corename, packagename); + } + } + } + + fortprintf(fd, "\n"); + fortprintf(fd, " call mpas_log_write('----- done configuring registry-specified packages -----')\n"); + fortprintf(fd, " call mpas_log_write('')\n"); + fortprintf(fd, "\n"); + fortprintf(fd, " end function %s_setup_packages_when\n", corename); + fortprintf(fd, "\n"); + + for (packages_xml = ezxml_child(registry, "packages"); packages_xml; packages_xml = packages_xml->next) { + for (package_xml = ezxml_child(packages_xml, "package"); package_xml; package_xml = package_xml->next) { + const char *packagename, *packagewhen; + + packagename = ezxml_attr(package_xml, "name"); + packagewhen = ezxml_attr(package_xml, "active_when"); + + if (packagewhen != NULL) { + if (package_logic_routine(fd, &preg, corename, packagename, packagewhen, registry) != 0) { + fprintf(stderr, "Error: Problem generating logic routine for package %s, active when (%s)\n", packagename, packagewhen); + regfree(&preg); + fclose(fd); + return 1; + } + } + } + } + + regfree(&preg); + + fclose(fd); + + return 0; +}/*}}}*/ + + +/****************************************************************************** + * + * package_logic_routine + * + * Generates code for the Fortran routine 'setup_X_package' that defines the active + * status of the package X, whose name is given by packagename, based on the logic + * described in the packagewhen string. + * + * Inputs: + * fd - an open file descriptor, to which the generated code will be written + * preg - a compiled regular-expression that matches namelist options + * corename - a string with the name of the core for which package logic is + * being generated. The corename is used in the name of the routine + * being generated. + * packagename - the name of the package for which code is being generated + * packagewhen - the string containing the logical condition under which the + * package is active + * registry - an XML tree containing the complete Registry file + * + * Return value: An integer status code. A value of 0 indicates success, and a + * non-zero value indicates that an error was encountered when generating + * logic for the package. + * + ******************************************************************************/ +int package_logic_routine(FILE *fd, regex_t *preg, const char *corename, + const char *packagename, const char *packagewhen, + ezxml_t registry)/*{{{*/ +{ + ezxml_t packages_xml, package_xml; + char *match; + regoff_t next; + + + fortprintf(fd, "\n"); + fortprintf(fd, " !\n"); + fortprintf(fd, " ! WARNING: This subroutine is automatically generated at compile time.\n"); + fortprintf(fd, " ! Any modifications to this code will be lost when MPAS is recompiled.\n"); + fortprintf(fd, " !\n"); + fortprintf(fd, " subroutine %s_setup_%s_package(configPool, packagePool)\n", corename, packagename); + fortprintf(fd, "\n"); + fortprintf(fd, " use mpas_kind_types, only : RKIND, StrKIND\n"); + fortprintf(fd, " use mpas_derived_types, only : mpas_pool_type\n"); + fortprintf(fd, " use mpas_log, only : mpas_log_write\n"); + fortprintf(fd, "\n"); + fortprintf(fd, " implicit none\n"); + fortprintf(fd, "\n"); + fortprintf(fd, " type (mpas_pool_type), intent(in) :: configPool\n"); + fortprintf(fd, " type (mpas_pool_type), intent(inout) :: packagePool\n"); + fortprintf(fd, "\n"); + fortprintf(fd, " logical, pointer :: %sActive\n", packagename); + fortprintf(fd, "\n"); + + next = 0; + while ((match = nmlopt_from_str(preg, packagewhen, &next)) != NULL) { + const char *nmltype; + + nmltype = nmlopt_type(registry, match); + + if (nmltype != NULL) { + if (strcmp(nmltype, "integer") == 0) { + fortprintf(fd, " integer, pointer :: %s\n", match); + } else if (strcmp(nmltype, "real") == 0) { + fortprintf(fd, " real(kind=RKIND), pointer :: %s\n", match); + } else if (strcmp(nmltype, "logical") == 0) { + fortprintf(fd, " logical, pointer :: %s\n", match); + } else if (strcmp(nmltype, "character") == 0) { + fortprintf(fd, " character(len=StrKIND), pointer :: %s\n", match); + } else { + fortprintf(fd, " INTENTIONAL COMPILE ERROR - UNKNOWN TYPE %s FOR %s\n", nmltype, match); + fprintf(stderr, "Error: Unknown type %s for %s\n", nmltype, match); + free(match); + return 1; + } + } else { + fortprintf(fd, " INTENTIONAL COMPILE ERROR - %s NOT FOUND IN REGISTRY\n", match); + fprintf(stderr, "Error: %s not found in registry\n", match); + free(match); + return 1; + } + + free(match); + } + fortprintf(fd, "\n"); + + next = 0; + while ((match = nmlopt_from_str(preg, packagewhen, &next)) != NULL) { + + fortprintf(fd, " nullify(%s)\n", match, match); + fortprintf(fd, " call mpas_pool_get_config(configPool, '%s', %s)\n", match, match); + + free(match); + } + fortprintf(fd, "\n"); + fortprintf(fd, " nullify(%sActive)\n", packagename); + fortprintf(fd, " call mpas_pool_get_package(packagePool, '%sActive', %sActive)\n", packagename, packagename); + fortprintf(fd, "\n"); + + gen_pkg_debug_info(fd, preg, registry, packagename, packagewhen); + + fortprintf(fd, " %sActive = ( %s )\n", packagename, packagewhen); + fortprintf(fd, " call mpas_log_write(' %s : $l', logicArgs=[%sActive])\n", packagename, packagename); + fortprintf(fd, "\n"); + fortprintf(fd, " end subroutine %s_setup_%s_package\n", corename, packagename); + fortprintf(fd, "\n"); + + return 0; +}/*}}}*/ + + +/****************************************************************************** + * + * nmlopt_from_str + * + * Parses and returns successive namelist options from the string str. The regex + * preg is used to match valid namelist options, and next stores the context. + * + * On the initial call, the next argument must be set to 0. + * + * Inputs: + * preg - a compiled regular-expression that matches namelist options + * next - used for internal state. On the first invocation, next must be set + * to 0. + * + * Outputs: + * next - an offset used to retain the state; the next value should be passed + * unmodified to subsequent calls to this function. + * + * Return value: A string containing the next namelist option matching preg that + * was found in the input string, str. If no further namelist options were + * found, a NULL value is returned. + * + ******************************************************************************/ +char * nmlopt_from_str(regex_t *preg, const char *str, regoff_t *next)/*{{{*/ +{ + const size_t nmatch = 2; + regmatch_t pmatch[nmatch]; + char *match = NULL; + + if (regexec(preg, str+*next, nmatch, pmatch, 0) != REG_NOMATCH) { + if (pmatch[0].rm_so >= 0 && pmatch[0].rm_eo >= 0) { + size_t len = (size_t)(pmatch[0].rm_eo - pmatch[0].rm_so); + match = malloc(sizeof(char) * (len + 1)); + strncpy(match, str+*next+pmatch[0].rm_so, len); + match[len] = '\0'; + *next += pmatch[0].rm_eo; + } + } + + return match; +}/*}}}*/ + + +/****************************************************************************** + * + * nmlopt_type + * + * Given a namelist option, nmlopt, defined in registry, returns the string from + * the registry defining the type of the option (e.g., "integer" or "logical"). + * + * Inputs: + * registry - an XML tree containing the complete Registry file + * nmlopt - a string containing the namelist option whose type is to be found + * + * Return value: A string identifying the type of the namelist option, or, if + * the namelist option was not found in the Registry, a NULL value.. + * + ******************************************************************************/ +const char * nmlopt_type(ezxml_t registry, const char *nmlopt)/*{{{*/ +{ + ezxml_t nmlrecs_xml, nmlopt_xml; + + const char *nmloptname, *nmlopttype; + + for (nmlrecs_xml = ezxml_child(registry, "nml_record"); nmlrecs_xml; nmlrecs_xml = nmlrecs_xml->next){ + for (nmlopt_xml = ezxml_child(nmlrecs_xml, "nml_option"); nmlopt_xml; nmlopt_xml = nmlopt_xml->next){ + nmloptname = ezxml_attr(nmlopt_xml, "name"); + nmlopttype = ezxml_attr(nmlopt_xml, "type"); + + if (strcmp(nmlopt, nmloptname) == 0) { + return nmlopttype; + } + } + } + + return NULL; +}/*}}}*/ + + +/****************************************************************************** + * + * gen_pkg_debug_info + * + * Adds debugging statements to generated package logic code. The debugging + * statements consist of PACKAGE_LOGIC_PRINT macros, which are expected to + * expand either to comments or to calls to mpas_log_write at compile-time. + * + * Inputs: + * fd - an open file descriptor, to which the debugging statements will be + * written + * preg - a compiled regular-expression that matches namelist options + * registry - an XML tree containing the complete Registry file + * packagename - the name of the package for which code is being generated + * packagewhen - the string containing the logical condition under which the + * package is active + * + ******************************************************************************/ +void gen_pkg_debug_info(FILE *fd, regex_t *preg, ezxml_t registry, + const char *packagename, const char *packagewhen)/*{{{*/ +{ + char *match; + regoff_t next = 0; + + fortprintf(fd, " PACKAGE_LOGIC_PRINT('')\n"); + fortprintf(fd, " PACKAGE_LOGIC_PRINT(\" %s is active when (%s)\")\n", packagename, packagewhen); + fortprintf(fd, " PACKAGE_LOGIC_PRINT(' namelist settings:')\n"); + fortprintf(fd, " PACKAGE_LOGIC_PRINT(' ------------------')\n"); + + while ((match = nmlopt_from_str(preg, packagewhen, &next)) != NULL) { + const char *nmltype; + + nmltype = nmlopt_type(registry, match); + + if (nmltype != NULL) { + if (strcmp(nmltype, "integer") == 0) { + fortprintf(fd, " PACKAGE_LOGIC_PRINT(' %s = $i' COMMA intArgs=[%s])\n", match, match); + } else if (strcmp(nmltype, "real") == 0) { + fortprintf(fd, " PACKAGE_LOGIC_PRINT(' %s = $r' COMMA realArgs=[%s])\n", match, match); + } else if (strcmp(nmltype, "logical") == 0) { + fortprintf(fd, " PACKAGE_LOGIC_PRINT(' %s = $l' COMMA logicArgs=[%s])\n", match, match); + } else if (strcmp(nmltype, "character") == 0) { + fortprintf(fd, " PACKAGE_LOGIC_PRINT(' %s = '//trim(%s))\n", match, match); + } + } + + free(match); + } + fortprintf(fd, "\n"); +}/*}}}*/ diff --git a/src/tools/registry/gen_inc.h b/src/tools/registry/gen_inc.h index 3833456d6..96574ce40 100644 --- a/src/tools/registry/gen_inc.h +++ b/src/tools/registry/gen_inc.h @@ -11,7 +11,7 @@ void add_attribute_if_not_ignored(FILE *fd, char *index, char *att_name, char *pointer_name_arr, char *temp_str); int find_string_in_array(char *input_string, const char *array[], size_t rows); -void write_model_variables(ezxml_t registry); +void write_model_variables(ezxml_t registry, int macro_count, const char **macros); int write_field_pointer_arrays(FILE* fd); int set_pointer_name(int type, int ndims, char *pointer_name, int time_levs); int add_package_to_list(const char * package, const char * package_list); @@ -38,3 +38,5 @@ 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); +void mangle_name(char *new_name, const size_t new_name_size, const char *old_name); +int generate_package_logic(ezxml_t registry); diff --git a/src/tools/registry/parse.c b/src/tools/registry/parse.c index 858ff0f77..6f8a7c4ee 100644 --- a/src/tools/registry/parse.c +++ b/src/tools/registry/parse.c @@ -33,11 +33,14 @@ int main(int argc, char ** argv)/*{{{*/ struct package * pkgs; int err; - if (argc != 2) { - fprintf(stderr,"Reading registry file from standard input\n"); - regfile = stdin; + if (argc < 2) { + fprintf(stderr,"\nUsage: %s [macro definitions]\n\n", argv[0]); + fprintf(stderr," where [macro definitions] may be any number of macro\n"); + fprintf(stderr," definitions of the form -D[=]\n\n"); + return 1; } - else if (!(regfile = fopen(argv[1], "r"))) { + + if (!(regfile = fopen(argv[1], "r"))) { fprintf(stderr,"\nError: Could not open file %s for reading.\n\n", argv[1]); return 1; } @@ -58,7 +61,11 @@ int main(int argc, char ** argv)/*{{{*/ return 1; } - write_model_variables(registry); + if (argc > 2) { + write_model_variables(registry, (argc-2), (const char**)&argv[2]); + } else { + write_model_variables(registry, 0, NULL); + } if (parse_reg_xml(registry)) { fprintf(stderr, "Parsing failed.....\n"); @@ -744,18 +751,45 @@ int parse_reg_xml(ezxml_t registry)/*{{{*/ // Parse Packages err = parse_packages_from_registry(registry); + if (err) { + fprintf(stderr, "Error in parse_packages_from_registry\n"); + return err; + } // Parse namelist records err = parse_namelist_records_from_registry(registry); + if (err) { + fprintf(stderr, "Error in parse_namelist_records_from_registry\n"); + return err; + } // Parse dimensions err = parse_dimensions_from_registry(registry); + if (err) { + fprintf(stderr, "Error in parse_dimensions_from_registry\n"); + return err; + } // Parse variable structures err = parse_structs_from_registry(registry); + if (err) { + fprintf(stderr, "Error in parse_structs_from_registry\n"); + return err; + } // Generate code to read and write fields err = generate_immutable_streams(registry); + if (err) { + fprintf(stderr, "Error in generate_immutable_streams\n"); + return err; + } + + // Generate logic to set packages with the 'active_when' attribute + err = generate_package_logic(registry); + if (err) { + fprintf(stderr, "Error in generate_package_logic\n"); + return err; + } return 0; }/*}}}*/ diff --git a/src/tools/registry/utility.c b/src/tools/registry/utility.c index 444889d44..c726fdb2d 100644 --- a/src/tools/registry/utility.c +++ b/src/tools/registry/utility.c @@ -9,6 +9,7 @@ #include #include #include +#include #include "ezxml.h" #include "registry_types.h" @@ -263,3 +264,83 @@ int check_persistence(const char * persistence){/*{{{*/ return PERSISTENT; } }/*}}}*/ + + +/****************************************************************************** + * + * parse_macros + * + * Given an array of strings that are assumed to be in the form of C + * pre-processor macro definitions, e.g., + * + * { "-DMPAS_NAMELIST_SUFFIX=test", + * "-DSINGLE_PRECISION", + * "-DHISTORY=Not available" } + * + * which could come from the command-line arguments + * + * -DMPAS_NAMELIST_SUFFIX=test -DSINGLE_PRECISION -DHISTORY="Not available" + * + * this routine parses the macro name and macro definition from each string, + * and invokes a callback routine with the macro name and definition. The macro + * name is the name of the macro itself, without the "-D" definition prefix. + * + * Any arguments after the macros argument to this function are passed as a + * va_list to the callback. + * + * For the above array of macro definition strings, the callback would be + * invoked three times with the following arguments: + * + * "MPAS_NAMELIST_SUFFIX", "test" + * "SINGLE_PRECISION", "" + * "HISTORY", "Not available" + * + * The callback function may be NULL. + * + * Upon successful completion, a value of 0 is returned. If errors were + * encountered in parsing macro definition strings, a non-zero value is + * returned. + * + ******************************************************************************/ +int parse_macros(void(*callback)(const char *macro, const char *val, va_list ap), + int count, const char **macros, ...) +{ + int i; + + for (i = 0; i < count; i++) { + char *tmp; + char *saveptr; + const char *macro; + const char *val; + const char *empty = ""; + + tmp = strdup(macros[i]); + + macro = strtok_r(tmp, "=", &saveptr); + val = strtok_r(NULL, "=", &saveptr); + + if (macro == NULL) { + return 1; + } + + if (val == NULL) { + val = empty; + } + + if (strstr(macro, "-D") == macro) { + macro = ¯o[2]; + } + + if (callback != NULL) { + va_list ap; + + va_start(ap, macros); + callback(macro, val, ap); + va_end(ap); + } + + free(tmp); + } + + return 0; +} diff --git a/src/tools/registry/utility.h b/src/tools/registry/utility.h index 37c9d0de2..90a2e83ca 100644 --- a/src/tools/registry/utility.h +++ b/src/tools/registry/utility.h @@ -15,3 +15,5 @@ char * check_packages(ezxml_t registry, char * packages); char * check_dimensions(ezxml_t registry, char * dims); char * check_streams(ezxml_t registry, char * streams); int check_persistence(const char * persistence); +int parse_macros(void(*callback)(const char *macro, const char *val, va_list ap), + int count, const char **macros, ...); diff --git a/test/compass/landice/initMIP-AIS/bmb/Test_evolve_temp_calving_uniformBasinK_new_Use1300RestartDirectly/streams.landice b/test/compass/landice/initMIP-AIS/bmb/Test_evolve_temp_calving_uniformBasinK_new_Use1300RestartDirectly/streams.landice deleted file mode 100755 index 1c3ea9a3b..000000000 --- a/test/compass/landice/initMIP-AIS/bmb/Test_evolve_temp_calving_uniformBasinK_new_Use1300RestartDirectly/streams.landice +++ /dev/null @@ -1,114 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/test/compass/landice/initMIP-AIS/bmb/Test_evolve_temp_restore_calving/streams.landice b/test/compass/landice/initMIP-AIS/bmb/Test_evolve_temp_restore_calving/streams.landice deleted file mode 100755 index ea3260f13..000000000 --- a/test/compass/landice/initMIP-AIS/bmb/Test_evolve_temp_restore_calving/streams.landice +++ /dev/null @@ -1,109 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/test/compass/landice/initMIP-AIS/ctrl/Test_evolve_temp_calving_uniformBasinK_new_Use1300RestartDirectly/streams.landice b/test/compass/landice/initMIP-AIS/ctrl/Test_evolve_temp_calving_uniformBasinK_new_Use1300RestartDirectly/streams.landice deleted file mode 100755 index 67dd725da..000000000 --- a/test/compass/landice/initMIP-AIS/ctrl/Test_evolve_temp_calving_uniformBasinK_new_Use1300RestartDirectly/streams.landice +++ /dev/null @@ -1,114 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/test/compass/landice/initMIP-AIS/ctrl/Test_evolve_temp_restore_calving/streams.landice b/test/compass/landice/initMIP-AIS/ctrl/Test_evolve_temp_restore_calving/streams.landice deleted file mode 100755 index ea3260f13..000000000 --- a/test/compass/landice/initMIP-AIS/ctrl/Test_evolve_temp_restore_calving/streams.landice +++ /dev/null @@ -1,109 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/test/seaice/configurations/standard_bgc/streams.seaice b/test/seaice/configurations/standard_bgc/streams.seaice deleted file mode 100644 index 3b26190b4..000000000 --- a/test/seaice/configurations/standard_bgc/streams.seaice +++ /dev/null @@ -1,391 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/test/seaice/configurations/standard_physics/streams.seaice b/test/seaice/configurations/standard_physics/streams.seaice deleted file mode 100644 index f8fd625ef..000000000 --- a/test/seaice/configurations/standard_physics/streams.seaice +++ /dev/null @@ -1,317 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/test/seaice/configurations/standard_physics_single_cell/streams.seaice b/test/seaice/configurations/standard_physics_single_cell/streams.seaice deleted file mode 100644 index 5eae7d202..000000000 --- a/test/seaice/configurations/standard_physics_single_cell/streams.seaice +++ /dev/null @@ -1,317 +0,0 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/test/atmosphere/setup_atm_run_dir b/testing_and_setup/atmosphere/setup_atm_run_dir similarity index 100% rename from test/atmosphere/setup_atm_run_dir rename to testing_and_setup/atmosphere/setup_atm_run_dir diff --git a/testing_and_setup/atmosphere/setup_run_dir.py b/testing_and_setup/atmosphere/setup_run_dir.py new file mode 100755 index 000000000..441f4b8f8 --- /dev/null +++ b/testing_and_setup/atmosphere/setup_run_dir.py @@ -0,0 +1,236 @@ +#!/usr/bin/env python3 + +import argparse +import filecmp +import os +import shutil +import sys + +BLUE = '\033[34m' +GREEN = '\033[32m' +RED = '\033[31m' + + +def color_text(color, t): + if os.isatty(1): + return color + t + '\033[0m' + else: + return t + + +def print_color(color, t): + print(color_text(color, t)) + + +def are_same_files(a, b): + return filecmp.cmp(a, b, shallow=True) + + +def copy_file(src, dst, overwrite): + if os.path.exists(dst): + if are_same_files(src, dst): + print_color(BLUE, os.path.basename(dst) + ' already exists. No need to copy it.') + return + elif not overwrite: + print_color(RED, dst + ' already exists, but it differs') + print_color(RED, ' from ' + src + ' .') + print_color(RED, ' ' + os.path.basename(dst) + ' will not be copied.') + print_color(RED,' Use the -o/--overwrite option to copy this file anyway.') + return + + try: + shutil.copyfile(src, dst) + print_color(GREEN, 'Copying ' + os.path.basename(dst)) + except: + print_color(RED,'Error: Could not copy ' + src + ' to ' + dst) + + +def link_file(src, dst, overwrite): + if os.path.exists(dst): + if are_same_files(src, dst): + print_color(BLUE, os.path.basename(dst) + ' already exists. No need to link it.') + return + elif not overwrite: + print_color(RED, dst + ' already exists, but it differs') + print_color(RED, ' from ' + src + ' .') + print_color(RED, ' ' + os.path.basename(dst) + ' will not be linked.') + print_color(RED, ' Use the -o/--overwrite option to link this file anyway.') + return + else: + os.remove(dst) + + try: + os.symlink(src, dst) + print_color(GREEN, 'Linking ' + os.path.basename(dst)) + except: + print_color(RED, 'Error: Could not link ' + src +' to '+ dst) + + +def missing_files(mpas_root, required_files): + file_list = [] + for f in required_files: + if not os.path.isfile(os.path.join(mpas_root, f)): + file_list.append(f) + + if len(file_list) == 0: + return None + else: + return file_list + + +if __name__ == '__main__': + parser = argparse.ArgumentParser() + parser.add_argument('run_dir', + help='the run directory to set up') + parser.add_argument('-o', '--overwrite', + action='store_true', + help='overwrite any existing files and symbolic links') + core_group = parser.add_mutually_exclusive_group() + core_group.add_argument('-i', '--init-only', + action='store_true', + help='only set up files for the init_atmosphere core') + core_group.add_argument('-a', '--atm-only', + action='store_true', + help='only set up files for the atmosphere core') + args = parser.parse_args() + + mpas_root = os.path.abspath(os.path.join(os.path.dirname(sys.argv[0]), '..', '..')) + run_dir = os.path.abspath(args.run_dir) + print('Root MPAS-Model directory: ' + mpas_root) + print('Run directory to set up: ' + run_dir) + if args.init_only: + print('Only setting up files for the init_atmosphere core...') + elif args.atm_only: + print('Only setting up files for the atmosphere core...') + else: + print('Setting up files for both the init_atmosphere and atmosphere cores...') + + print('---') + + # Lookup tables used by WRF physics schemes + physics_wrf = ['src/core_atmosphere/physics/physics_wrf/files/' + f + for f in [ + 'CAM_ABS_DATA.DBL', + 'CAM_AEROPT_DATA.DBL', + 'CCN_ACTIVATE_DATA', + 'GENPARM.TBL', + 'LANDUSE.TBL', + 'OZONE_DAT.TBL', + 'OZONE_LAT.TBL', + 'OZONE_PLEV.TBL', + 'RRTMG_LW_DATA', + 'RRTMG_LW_DATA.DBL', + 'RRTMG_SW_DATA', + 'RRTMG_SW_DATA.DBL', + 'SOILPARM.TBL', + 'VEGPARM.TBL', + ] + ] + + # Lookup tables used by Noah-MP + physics_noahmp = ['src/core_atmosphere/physics/physics_noahmp/parameters/' + f + for f in [ + 'NoahmpTable.TBL', + ] + ] + + # Optional lookup tables that are generated by the build_tables utility + opt_physics_wrf = ['src/core_atmosphere/physics/physics_wrf/files/' + f + for f in [ + 'MP_THOMPSON_freezeH2O_DATA.DBL', + 'MP_THOMPSON_QIautQS_DATA.DBL', + 'MP_THOMPSON_QRacrQG_DATA.DBL', + 'MP_THOMPSON_QRacrQS_DATA.DBL', + ] + ] + + init_files_to_link = ['init_atmosphere_model'] + init_files_to_copy = ['default_inputs/' + f + for f in [ + 'namelist.init_atmosphere', + 'streams.init_atmosphere', + ] + ] + + atm_files_to_link = ['atmosphere_model', 'build_tables'] + atm_files_to_link = atm_files_to_link + physics_wrf + physics_noahmp + atm_opt_files_to_link = opt_physics_wrf + atm_files_to_copy = ['default_inputs/' + f + for f in [ + 'namelist.atmosphere', + 'streams.atmosphere', + 'stream_list.atmosphere.output', + 'stream_list.atmosphere.diagnostics', + 'stream_list.atmosphere.surface', + 'stream_list.atmosphere.diag_ugwp', + ] + ] + + # Check if the init_atmosphere core has been compiled in the MPAS-Model directory + if not args.atm_only: + files = missing_files(mpas_root, init_files_to_link + init_files_to_copy) + if files: + print_color(RED, 'Error: The init_atmosphere core does not appear to have been successfully built') + print_color(RED, ' in ' + mpas_root + '. The following files were expected there,') + print_color(RED, ' but were not found:') + for f in files: + print_color(RED, ' ' + f) + sys.exit(1) + + # Check if the atmosphere core has been compiled in the MPAS-Model directory + if not args.init_only: + files = missing_files(mpas_root, atm_files_to_link + atm_files_to_copy) + if files: + print_color(RED, 'Error: The atmosphere core does not appear to have been successfully built') + print_color(RED, ' in ' + mpas_root + ' .') + print_color(RED, ' The following files were expected there but were not found:') + for f in files: + print_color(RED, ' ' + f) + sys.exit(1) + + try: + os.makedirs(run_dir) + print_color(GREEN, 'Creating directory ' + run_dir) + except FileExistsError: + print_color(BLUE, 'Directory ' + run_dir + ' already exist. No need to create it.') + except: + print_color(RED, 'Error: Could not create directory ' + run_dir) + sys.exit(1) + + if not os.access(run_dir, os.W_OK): + print_color(RED, 'Error: No write permission for directory ' + run_dir) + sys.exit(1) + + if not args.atm_only: + print('') + print_color(GREEN, 'Setting up init_atmosphere core files...') + print_color(GREEN, '----------------------------------------') + for f in init_files_to_copy: + copy_file(os.path.join(mpas_root, f), + os.path.join(run_dir, os.path.basename(f)), + args.overwrite) + + for f in init_files_to_link: + link_file(os.path.join(mpas_root, f), + os.path.join(run_dir, os.path.basename(f)), + args.overwrite) + + if not args.init_only: + print('') + print_color(GREEN, 'Setting up atmosphere core files...') + print_color(GREEN, '----------------------------------------') + for f in atm_files_to_copy: + copy_file(os.path.join(mpas_root, f), + os.path.join(run_dir, os.path.basename(f)), + args.overwrite) + + for f in atm_files_to_link: + link_file(os.path.join(mpas_root, f), + os.path.join(run_dir, os.path.basename(f)), + args.overwrite) + + for f in atm_opt_files_to_link: + if os.path.isfile(mpas_root + '/' + f): + link_file(os.path.join(mpas_root, f), + os.path.join(run_dir, os.path.basename(f)), + args.overwrite) diff --git a/test/compass/.gitignore b/testing_and_setup/compass/.gitignore similarity index 100% rename from test/compass/.gitignore rename to testing_and_setup/compass/.gitignore diff --git a/test/compass/README b/testing_and_setup/compass/README similarity index 100% rename from test/compass/README rename to testing_and_setup/compass/README diff --git a/test/compass/clean_testcase.py b/testing_and_setup/compass/clean_testcase.py similarity index 100% rename from test/compass/clean_testcase.py rename to testing_and_setup/compass/clean_testcase.py diff --git a/test/compass/doc/README.config b/testing_and_setup/compass/doc/README.config similarity index 100% rename from test/compass/doc/README.config rename to testing_and_setup/compass/doc/README.config diff --git a/test/compass/doc/README.driver_script b/testing_and_setup/compass/doc/README.driver_script similarity index 100% rename from test/compass/doc/README.driver_script rename to testing_and_setup/compass/doc/README.driver_script diff --git a/test/compass/doc/README.regression_suite b/testing_and_setup/compass/doc/README.regression_suite similarity index 100% rename from test/compass/doc/README.regression_suite rename to testing_and_setup/compass/doc/README.regression_suite diff --git a/test/compass/doc/README.run_config b/testing_and_setup/compass/doc/README.run_config similarity index 100% rename from test/compass/doc/README.run_config rename to testing_and_setup/compass/doc/README.run_config diff --git a/test/compass/doc/README.template b/testing_and_setup/compass/doc/README.template similarity index 100% rename from test/compass/doc/README.template rename to testing_and_setup/compass/doc/README.template diff --git a/test/compass/general.config.landice b/testing_and_setup/compass/general.config.landice similarity index 100% rename from test/compass/general.config.landice rename to testing_and_setup/compass/general.config.landice diff --git a/test/compass/general.config.ocean b/testing_and_setup/compass/general.config.ocean similarity index 100% rename from test/compass/general.config.ocean rename to testing_and_setup/compass/general.config.ocean diff --git a/test/compass/general.config.test b/testing_and_setup/compass/general.config.test similarity index 100% rename from test/compass/general.config.test rename to testing_and_setup/compass/general.config.test diff --git a/test/compass/landice/EISMINT1/50000m/EISMINT-1_50000m_template.xml b/testing_and_setup/compass/landice/EISMINT1/50000m/EISMINT-1_50000m_template.xml similarity index 100% rename from test/compass/landice/EISMINT1/50000m/EISMINT-1_50000m_template.xml rename to testing_and_setup/compass/landice/EISMINT1/50000m/EISMINT-1_50000m_template.xml diff --git a/test/compass/landice/EISMINT1/50000m/MovingMargin1/config_driver.xml b/testing_and_setup/compass/landice/EISMINT1/50000m/MovingMargin1/config_driver.xml similarity index 100% rename from test/compass/landice/EISMINT1/50000m/MovingMargin1/config_driver.xml rename to testing_and_setup/compass/landice/EISMINT1/50000m/MovingMargin1/config_driver.xml diff --git a/test/compass/landice/EISMINT1/50000m/MovingMargin1/config_run_model_step.xml b/testing_and_setup/compass/landice/EISMINT1/50000m/MovingMargin1/config_run_model_step.xml similarity index 100% rename from test/compass/landice/EISMINT1/50000m/MovingMargin1/config_run_model_step.xml rename to testing_and_setup/compass/landice/EISMINT1/50000m/MovingMargin1/config_run_model_step.xml diff --git a/test/compass/landice/EISMINT1/50000m/MovingMargin1/config_setup_mesh_step.xml b/testing_and_setup/compass/landice/EISMINT1/50000m/MovingMargin1/config_setup_mesh_step.xml similarity index 100% rename from test/compass/landice/EISMINT1/50000m/MovingMargin1/config_setup_mesh_step.xml rename to testing_and_setup/compass/landice/EISMINT1/50000m/MovingMargin1/config_setup_mesh_step.xml diff --git a/test/compass/landice/EISMINT1/50000m/periodic_hex.namelist.input b/testing_and_setup/compass/landice/EISMINT1/50000m/periodic_hex.namelist.input similarity index 100% rename from test/compass/landice/EISMINT1/50000m/periodic_hex.namelist.input rename to testing_and_setup/compass/landice/EISMINT1/50000m/periodic_hex.namelist.input diff --git a/test/compass/landice/EISMINT1/check_output_eismint-mm1.py b/testing_and_setup/compass/landice/EISMINT1/check_output_eismint-mm1.py similarity index 100% rename from test/compass/landice/EISMINT1/check_output_eismint-mm1.py rename to testing_and_setup/compass/landice/EISMINT1/check_output_eismint-mm1.py diff --git a/test/compass/landice/EISMINT1/setup_initial_conditions_EISMINT1-MovingMargin-1.py b/testing_and_setup/compass/landice/EISMINT1/setup_initial_conditions_EISMINT1-MovingMargin-1.py similarity index 100% rename from test/compass/landice/EISMINT1/setup_initial_conditions_EISMINT1-MovingMargin-1.py rename to testing_and_setup/compass/landice/EISMINT1/setup_initial_conditions_EISMINT1-MovingMargin-1.py diff --git a/test/compass/landice/EISMINT2/25000m/EISMINT2_25000m_template.xml b/testing_and_setup/compass/landice/EISMINT2/25000m/EISMINT2_25000m_template.xml similarity index 100% rename from test/compass/landice/EISMINT2/25000m/EISMINT2_25000m_template.xml rename to testing_and_setup/compass/landice/EISMINT2/25000m/EISMINT2_25000m_template.xml diff --git a/test/compass/landice/EISMINT2/25000m/decomposition_test/config_driver.xml b/testing_and_setup/compass/landice/EISMINT2/25000m/decomposition_test/config_driver.xml similarity index 100% rename from test/compass/landice/EISMINT2/25000m/decomposition_test/config_driver.xml rename to testing_and_setup/compass/landice/EISMINT2/25000m/decomposition_test/config_driver.xml diff --git a/test/compass/landice/EISMINT2/25000m/decomposition_test/config_experiment_F_1p.xml b/testing_and_setup/compass/landice/EISMINT2/25000m/decomposition_test/config_experiment_F_1p.xml similarity index 100% rename from test/compass/landice/EISMINT2/25000m/decomposition_test/config_experiment_F_1p.xml rename to testing_and_setup/compass/landice/EISMINT2/25000m/decomposition_test/config_experiment_F_1p.xml diff --git a/test/compass/landice/EISMINT2/25000m/decomposition_test/config_experiment_F_4p.xml b/testing_and_setup/compass/landice/EISMINT2/25000m/decomposition_test/config_experiment_F_4p.xml similarity index 100% rename from test/compass/landice/EISMINT2/25000m/decomposition_test/config_experiment_F_4p.xml rename to testing_and_setup/compass/landice/EISMINT2/25000m/decomposition_test/config_experiment_F_4p.xml diff --git a/test/compass/landice/EISMINT2/25000m/decomposition_test/config_setup_mesh_step.xml b/testing_and_setup/compass/landice/EISMINT2/25000m/decomposition_test/config_setup_mesh_step.xml similarity index 100% rename from test/compass/landice/EISMINT2/25000m/decomposition_test/config_setup_mesh_step.xml rename to testing_and_setup/compass/landice/EISMINT2/25000m/decomposition_test/config_setup_mesh_step.xml diff --git a/test/compass/landice/EISMINT2/25000m/decomposition_test/output_comparison.xml b/testing_and_setup/compass/landice/EISMINT2/25000m/decomposition_test/output_comparison.xml similarity index 100% rename from test/compass/landice/EISMINT2/25000m/decomposition_test/output_comparison.xml rename to testing_and_setup/compass/landice/EISMINT2/25000m/decomposition_test/output_comparison.xml diff --git a/test/compass/landice/EISMINT2/25000m/periodic_hex.namelist.input b/testing_and_setup/compass/landice/EISMINT2/25000m/periodic_hex.namelist.input similarity index 100% rename from test/compass/landice/EISMINT2/25000m/periodic_hex.namelist.input rename to testing_and_setup/compass/landice/EISMINT2/25000m/periodic_hex.namelist.input diff --git a/test/compass/landice/EISMINT2/25000m/standard_experiments/config_driver.xml b/testing_and_setup/compass/landice/EISMINT2/25000m/standard_experiments/config_driver.xml similarity index 100% rename from test/compass/landice/EISMINT2/25000m/standard_experiments/config_driver.xml rename to testing_and_setup/compass/landice/EISMINT2/25000m/standard_experiments/config_driver.xml diff --git a/test/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_A.xml b/testing_and_setup/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_A.xml similarity index 100% rename from test/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_A.xml rename to testing_and_setup/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_A.xml diff --git a/test/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_B.xml b/testing_and_setup/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_B.xml similarity index 100% rename from test/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_B.xml rename to testing_and_setup/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_B.xml diff --git a/test/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_C.xml b/testing_and_setup/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_C.xml similarity index 100% rename from test/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_C.xml rename to testing_and_setup/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_C.xml diff --git a/test/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_D.xml b/testing_and_setup/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_D.xml similarity index 100% rename from test/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_D.xml rename to testing_and_setup/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_D.xml diff --git a/test/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_E.xml b/testing_and_setup/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_E.xml similarity index 100% rename from test/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_E.xml rename to testing_and_setup/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_E.xml diff --git a/test/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_F.xml b/testing_and_setup/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_F.xml similarity index 100% rename from test/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_F.xml rename to testing_and_setup/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_F.xml diff --git a/test/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_G.xml b/testing_and_setup/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_G.xml similarity index 100% rename from test/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_G.xml rename to testing_and_setup/compass/landice/EISMINT2/25000m/standard_experiments/config_experiment_G.xml diff --git a/test/compass/landice/EISMINT2/25000m/standard_experiments/config_setup_mesh_step.xml b/testing_and_setup/compass/landice/EISMINT2/25000m/standard_experiments/config_setup_mesh_step.xml similarity index 100% rename from test/compass/landice/EISMINT2/25000m/standard_experiments/config_setup_mesh_step.xml rename to testing_and_setup/compass/landice/EISMINT2/25000m/standard_experiments/config_setup_mesh_step.xml diff --git a/test/compass/landice/EISMINT2/setup_initial_conditions_EISMINT2.py b/testing_and_setup/compass/landice/EISMINT2/setup_initial_conditions_EISMINT2.py similarity index 100% rename from test/compass/landice/EISMINT2/setup_initial_conditions_EISMINT2.py rename to testing_and_setup/compass/landice/EISMINT2/setup_initial_conditions_EISMINT2.py diff --git a/test/compass/landice/EISMINT2/visualize_output_EISMINT2.py b/testing_and_setup/compass/landice/EISMINT2/visualize_output_EISMINT2.py similarity index 100% rename from test/compass/landice/EISMINT2/visualize_output_EISMINT2.py rename to testing_and_setup/compass/landice/EISMINT2/visualize_output_EISMINT2.py diff --git a/test/compass/landice/MISMIP+/README.mismip+ b/testing_and_setup/compass/landice/MISMIP+/README.mismip+ similarity index 100% rename from test/compass/landice/MISMIP+/README.mismip+ rename to testing_and_setup/compass/landice/MISMIP+/README.mismip+ diff --git a/test/compass/landice/MISMIP+/albany_input.xml b/testing_and_setup/compass/landice/MISMIP+/albany_input.xml similarity index 100% rename from test/compass/landice/MISMIP+/albany_input.xml rename to testing_and_setup/compass/landice/MISMIP+/albany_input.xml diff --git a/test/compass/landice/MISMIP+/cull_cells_for_MISMIP.py b/testing_and_setup/compass/landice/MISMIP+/cull_cells_for_MISMIP.py similarity index 100% rename from test/compass/landice/MISMIP+/cull_cells_for_MISMIP.py rename to testing_and_setup/compass/landice/MISMIP+/cull_cells_for_MISMIP.py diff --git a/test/compass/landice/MISMIP+/mismip+PlotGL.py b/testing_and_setup/compass/landice/MISMIP+/mismip+PlotGL.py similarity index 100% rename from test/compass/landice/MISMIP+/mismip+PlotGL.py rename to testing_and_setup/compass/landice/MISMIP+/mismip+PlotGL.py diff --git a/test/compass/landice/MISMIP+/mismip+ResolutionAnalysis.py b/testing_and_setup/compass/landice/MISMIP+/mismip+ResolutionAnalysis.py similarity index 100% rename from test/compass/landice/MISMIP+/mismip+ResolutionAnalysis.py rename to testing_and_setup/compass/landice/MISMIP+/mismip+ResolutionAnalysis.py diff --git a/test/compass/landice/MISMIP+/mismip+WriteGL.py b/testing_and_setup/compass/landice/MISMIP+/mismip+WriteGL.py similarity index 100% rename from test/compass/landice/MISMIP+/mismip+WriteGL.py rename to testing_and_setup/compass/landice/MISMIP+/mismip+WriteGL.py diff --git a/test/compass/landice/MISMIP+/mismip+_template.xml b/testing_and_setup/compass/landice/MISMIP+/mismip+_template.xml similarity index 100% rename from test/compass/landice/MISMIP+/mismip+_template.xml rename to testing_and_setup/compass/landice/MISMIP+/mismip+_template.xml diff --git a/test/compass/landice/MISMIP+/setup_mismip+_initial_conditions.py b/testing_and_setup/compass/landice/MISMIP+/setup_mismip+_initial_conditions.py similarity index 100% rename from test/compass/landice/MISMIP+/setup_mismip+_initial_conditions.py rename to testing_and_setup/compass/landice/MISMIP+/setup_mismip+_initial_conditions.py diff --git a/test/compass/landice/MISMIP+/setup_mismip+_subdirectories.py b/testing_and_setup/compass/landice/MISMIP+/setup_mismip+_subdirectories.py similarity index 100% rename from test/compass/landice/MISMIP+/setup_mismip+_subdirectories.py rename to testing_and_setup/compass/landice/MISMIP+/setup_mismip+_subdirectories.py diff --git a/test/compass/landice/MISMIP+/standard_resolution/standard_test/README b/testing_and_setup/compass/landice/MISMIP+/standard_resolution/standard_test/README similarity index 100% rename from test/compass/landice/MISMIP+/standard_resolution/standard_test/README rename to testing_and_setup/compass/landice/MISMIP+/standard_resolution/standard_test/README diff --git a/test/compass/landice/MISMIP+/standard_resolution/standard_test/config_setup_experiments.xml b/testing_and_setup/compass/landice/MISMIP+/standard_resolution/standard_test/config_setup_experiments.xml similarity index 100% rename from test/compass/landice/MISMIP+/standard_resolution/standard_test/config_setup_experiments.xml rename to testing_and_setup/compass/landice/MISMIP+/standard_resolution/standard_test/config_setup_experiments.xml diff --git a/test/compass/landice/MISMIP+/standard_resolution/standard_test/namelist.input b/testing_and_setup/compass/landice/MISMIP+/standard_resolution/standard_test/namelist.input similarity index 100% rename from test/compass/landice/MISMIP+/standard_resolution/standard_test/namelist.input rename to testing_and_setup/compass/landice/MISMIP+/standard_resolution/standard_test/namelist.input diff --git a/test/compass/landice/MISMIP+/standard_resolution/standard_test/namelist.input.1000m b/testing_and_setup/compass/landice/MISMIP+/standard_resolution/standard_test/namelist.input.1000m similarity index 100% rename from test/compass/landice/MISMIP+/standard_resolution/standard_test/namelist.input.1000m rename to testing_and_setup/compass/landice/MISMIP+/standard_resolution/standard_test/namelist.input.1000m diff --git a/test/compass/landice/MISMIP+/standard_resolution/standard_test/namelist.input.2000m b/testing_and_setup/compass/landice/MISMIP+/standard_resolution/standard_test/namelist.input.2000m similarity index 100% rename from test/compass/landice/MISMIP+/standard_resolution/standard_test/namelist.input.2000m rename to testing_and_setup/compass/landice/MISMIP+/standard_resolution/standard_test/namelist.input.2000m diff --git a/test/compass/landice/MISMIP+/standard_resolution/standard_test/namelist.input.4000m b/testing_and_setup/compass/landice/MISMIP+/standard_resolution/standard_test/namelist.input.4000m similarity index 100% rename from test/compass/landice/MISMIP+/standard_resolution/standard_test/namelist.input.4000m rename to testing_and_setup/compass/landice/MISMIP+/standard_resolution/standard_test/namelist.input.4000m diff --git a/test/compass/landice/MISMIP+/standard_resolution/standard_test/namelist.input.500m b/testing_and_setup/compass/landice/MISMIP+/standard_resolution/standard_test/namelist.input.500m similarity index 100% rename from test/compass/landice/MISMIP+/standard_resolution/standard_test/namelist.input.500m rename to testing_and_setup/compass/landice/MISMIP+/standard_resolution/standard_test/namelist.input.500m diff --git a/test/compass/landice/MISMIP+/standard_resolution/standard_test/namelist.input.8000m b/testing_and_setup/compass/landice/MISMIP+/standard_resolution/standard_test/namelist.input.8000m similarity index 100% rename from test/compass/landice/MISMIP+/standard_resolution/standard_test/namelist.input.8000m rename to testing_and_setup/compass/landice/MISMIP+/standard_resolution/standard_test/namelist.input.8000m diff --git a/test/compass/landice/MISMIP3D/README b/testing_and_setup/compass/landice/MISMIP3D/README similarity index 100% rename from test/compass/landice/MISMIP3D/README rename to testing_and_setup/compass/landice/MISMIP3D/README diff --git a/test/compass/landice/MISMIP3D/README.P75S_R b/testing_and_setup/compass/landice/MISMIP3D/README.P75S_R similarity index 100% rename from test/compass/landice/MISMIP3D/README.P75S_R rename to testing_and_setup/compass/landice/MISMIP3D/README.P75S_R diff --git a/test/compass/landice/MISMIP3D/albany_input.xml b/testing_and_setup/compass/landice/MISMIP3D/albany_input.xml similarity index 100% rename from test/compass/landice/MISMIP3D/albany_input.xml rename to testing_and_setup/compass/landice/MISMIP3D/albany_input.xml diff --git a/test/compass/landice/MISMIP3D/cull_cells_for_MISMIP.py b/testing_and_setup/compass/landice/MISMIP3D/cull_cells_for_MISMIP.py similarity index 100% rename from test/compass/landice/MISMIP3D/cull_cells_for_MISMIP.py rename to testing_and_setup/compass/landice/MISMIP3D/cull_cells_for_MISMIP.py diff --git a/test/compass/landice/MISMIP3D/full_width/Stnd/config_10000m.xml b/testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/config_10000m.xml similarity index 100% rename from test/compass/landice/MISMIP3D/full_width/Stnd/config_10000m.xml rename to testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/config_10000m.xml diff --git a/test/compass/landice/MISMIP3D/full_width/Stnd/config_1000m.xml b/testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/config_1000m.xml similarity index 100% rename from test/compass/landice/MISMIP3D/full_width/Stnd/config_1000m.xml rename to testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/config_1000m.xml diff --git a/test/compass/landice/MISMIP3D/full_width/Stnd/config_2000m.xml b/testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/config_2000m.xml similarity index 100% rename from test/compass/landice/MISMIP3D/full_width/Stnd/config_2000m.xml rename to testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/config_2000m.xml diff --git a/test/compass/landice/MISMIP3D/full_width/Stnd/config_250m.xml b/testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/config_250m.xml similarity index 100% rename from test/compass/landice/MISMIP3D/full_width/Stnd/config_250m.xml rename to testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/config_250m.xml diff --git a/test/compass/landice/MISMIP3D/full_width/Stnd/config_5000m.xml b/testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/config_5000m.xml similarity index 100% rename from test/compass/landice/MISMIP3D/full_width/Stnd/config_5000m.xml rename to testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/config_5000m.xml diff --git a/test/compass/landice/MISMIP3D/full_width/Stnd/config_500m.xml b/testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/config_500m.xml similarity index 100% rename from test/compass/landice/MISMIP3D/full_width/Stnd/config_500m.xml rename to testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/config_500m.xml diff --git a/test/compass/landice/MISMIP3D/full_width/Stnd/config_P75.xml b/testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/config_P75.xml similarity index 100% rename from test/compass/landice/MISMIP3D/full_width/Stnd/config_P75.xml rename to testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/config_P75.xml diff --git a/test/compass/landice/MISMIP3D/full_width/Stnd/config_driver.xml b/testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/config_driver.xml similarity index 100% rename from test/compass/landice/MISMIP3D/full_width/Stnd/config_driver.xml rename to testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/config_driver.xml diff --git a/test/compass/landice/MISMIP3D/full_width/Stnd/namelist.input.10000m b/testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/namelist.input.10000m similarity index 100% rename from test/compass/landice/MISMIP3D/full_width/Stnd/namelist.input.10000m rename to testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/namelist.input.10000m diff --git a/test/compass/landice/MISMIP3D/full_width/Stnd/namelist.input.1000m b/testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/namelist.input.1000m similarity index 100% rename from test/compass/landice/MISMIP3D/full_width/Stnd/namelist.input.1000m rename to testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/namelist.input.1000m diff --git a/test/compass/landice/MISMIP3D/full_width/Stnd/namelist.input.2000m b/testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/namelist.input.2000m similarity index 100% rename from test/compass/landice/MISMIP3D/full_width/Stnd/namelist.input.2000m rename to testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/namelist.input.2000m diff --git a/test/compass/landice/MISMIP3D/full_width/Stnd/namelist.input.250m b/testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/namelist.input.250m similarity index 100% rename from test/compass/landice/MISMIP3D/full_width/Stnd/namelist.input.250m rename to testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/namelist.input.250m diff --git a/test/compass/landice/MISMIP3D/full_width/Stnd/namelist.input.5000m b/testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/namelist.input.5000m similarity index 100% rename from test/compass/landice/MISMIP3D/full_width/Stnd/namelist.input.5000m rename to testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/namelist.input.5000m diff --git a/test/compass/landice/MISMIP3D/full_width/Stnd/namelist.input.500m b/testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/namelist.input.500m similarity index 100% rename from test/compass/landice/MISMIP3D/full_width/Stnd/namelist.input.500m rename to testing_and_setup/compass/landice/MISMIP3D/full_width/Stnd/namelist.input.500m diff --git a/test/compass/landice/MISMIP3D/minimal_width/Stnd/config_10000m.xml b/testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/config_10000m.xml similarity index 100% rename from test/compass/landice/MISMIP3D/minimal_width/Stnd/config_10000m.xml rename to testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/config_10000m.xml diff --git a/test/compass/landice/MISMIP3D/minimal_width/Stnd/config_1000m.xml b/testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/config_1000m.xml similarity index 100% rename from test/compass/landice/MISMIP3D/minimal_width/Stnd/config_1000m.xml rename to testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/config_1000m.xml diff --git a/test/compass/landice/MISMIP3D/minimal_width/Stnd/config_2000m.xml b/testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/config_2000m.xml similarity index 100% rename from test/compass/landice/MISMIP3D/minimal_width/Stnd/config_2000m.xml rename to testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/config_2000m.xml diff --git a/test/compass/landice/MISMIP3D/minimal_width/Stnd/config_250m.xml b/testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/config_250m.xml similarity index 100% rename from test/compass/landice/MISMIP3D/minimal_width/Stnd/config_250m.xml rename to testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/config_250m.xml diff --git a/test/compass/landice/MISMIP3D/minimal_width/Stnd/config_5000m.xml b/testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/config_5000m.xml similarity index 100% rename from test/compass/landice/MISMIP3D/minimal_width/Stnd/config_5000m.xml rename to testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/config_5000m.xml diff --git a/test/compass/landice/MISMIP3D/minimal_width/Stnd/config_500m.xml b/testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/config_500m.xml similarity index 100% rename from test/compass/landice/MISMIP3D/minimal_width/Stnd/config_500m.xml rename to testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/config_500m.xml diff --git a/test/compass/landice/MISMIP3D/minimal_width/Stnd/config_driver.xml b/testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/config_driver.xml similarity index 100% rename from test/compass/landice/MISMIP3D/minimal_width/Stnd/config_driver.xml rename to testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/config_driver.xml diff --git a/test/compass/landice/MISMIP3D/minimal_width/Stnd/namelist.input.10000m b/testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/namelist.input.10000m similarity index 100% rename from test/compass/landice/MISMIP3D/minimal_width/Stnd/namelist.input.10000m rename to testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/namelist.input.10000m diff --git a/test/compass/landice/MISMIP3D/minimal_width/Stnd/namelist.input.1000m b/testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/namelist.input.1000m similarity index 100% rename from test/compass/landice/MISMIP3D/minimal_width/Stnd/namelist.input.1000m rename to testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/namelist.input.1000m diff --git a/test/compass/landice/MISMIP3D/minimal_width/Stnd/namelist.input.2000m b/testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/namelist.input.2000m similarity index 100% rename from test/compass/landice/MISMIP3D/minimal_width/Stnd/namelist.input.2000m rename to testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/namelist.input.2000m diff --git a/test/compass/landice/MISMIP3D/minimal_width/Stnd/namelist.input.250m b/testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/namelist.input.250m similarity index 100% rename from test/compass/landice/MISMIP3D/minimal_width/Stnd/namelist.input.250m rename to testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/namelist.input.250m diff --git a/test/compass/landice/MISMIP3D/minimal_width/Stnd/namelist.input.5000m b/testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/namelist.input.5000m similarity index 100% rename from test/compass/landice/MISMIP3D/minimal_width/Stnd/namelist.input.5000m rename to testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/namelist.input.5000m diff --git a/test/compass/landice/MISMIP3D/minimal_width/Stnd/namelist.input.500m b/testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/namelist.input.500m similarity index 100% rename from test/compass/landice/MISMIP3D/minimal_width/Stnd/namelist.input.500m rename to testing_and_setup/compass/landice/MISMIP3D/minimal_width/Stnd/namelist.input.500m diff --git a/test/compass/landice/MISMIP3D/mismip_template.xml b/testing_and_setup/compass/landice/MISMIP3D/mismip_template.xml similarity index 100% rename from test/compass/landice/MISMIP3D/mismip_template.xml rename to testing_and_setup/compass/landice/MISMIP3D/mismip_template.xml diff --git a/test/compass/landice/MISMIP3D/plot_GL_Stnd_MISMIP3D.py b/testing_and_setup/compass/landice/MISMIP3D/plot_GL_Stnd_MISMIP3D.py similarity index 100% rename from test/compass/landice/MISMIP3D/plot_GL_Stnd_MISMIP3D.py rename to testing_and_setup/compass/landice/MISMIP3D/plot_GL_Stnd_MISMIP3D.py diff --git a/test/compass/landice/MISMIP3D/plot_Perturbation_MISMIP3d.py b/testing_and_setup/compass/landice/MISMIP3D/plot_Perturbation_MISMIP3d.py similarity index 100% rename from test/compass/landice/MISMIP3D/plot_Perturbation_MISMIP3d.py rename to testing_and_setup/compass/landice/MISMIP3D/plot_Perturbation_MISMIP3d.py diff --git a/test/compass/landice/MISMIP3D/plot_speed_profiles.py b/testing_and_setup/compass/landice/MISMIP3D/plot_speed_profiles.py similarity index 100% rename from test/compass/landice/MISMIP3D/plot_speed_profiles.py rename to testing_and_setup/compass/landice/MISMIP3D/plot_speed_profiles.py diff --git a/test/compass/landice/MISMIP3D/setup_mismip3d_initial_conditions.py b/testing_and_setup/compass/landice/MISMIP3D/setup_mismip3d_initial_conditions.py similarity index 100% rename from test/compass/landice/MISMIP3D/setup_mismip3d_initial_conditions.py rename to testing_and_setup/compass/landice/MISMIP3D/setup_mismip3d_initial_conditions.py diff --git a/test/compass/landice/MISMIP3D/setup_mismip3d_perturb_domain.py b/testing_and_setup/compass/landice/MISMIP3D/setup_mismip3d_perturb_domain.py similarity index 100% rename from test/compass/landice/MISMIP3D/setup_mismip3d_perturb_domain.py rename to testing_and_setup/compass/landice/MISMIP3D/setup_mismip3d_perturb_domain.py diff --git a/test/compass/landice/Thwaites_variability/1km_varres_jigsaw/standard_configuration/README b/testing_and_setup/compass/landice/Thwaites_variability/1km_varres_jigsaw/standard_configuration/README similarity index 100% rename from test/compass/landice/Thwaites_variability/1km_varres_jigsaw/standard_configuration/README rename to testing_and_setup/compass/landice/Thwaites_variability/1km_varres_jigsaw/standard_configuration/README diff --git a/test/compass/landice/Thwaites_variability/1km_varres_jigsaw/standard_configuration/config_setup_experiments.xml b/testing_and_setup/compass/landice/Thwaites_variability/1km_varres_jigsaw/standard_configuration/config_setup_experiments.xml similarity index 100% rename from test/compass/landice/Thwaites_variability/1km_varres_jigsaw/standard_configuration/config_setup_experiments.xml rename to testing_and_setup/compass/landice/Thwaites_variability/1km_varres_jigsaw/standard_configuration/config_setup_experiments.xml diff --git a/test/compass/landice/Thwaites_variability/1km_varres_jigsaw/standard_configuration/jigsaw/generate_Thwaites_mesh.m b/testing_and_setup/compass/landice/Thwaites_variability/1km_varres_jigsaw/standard_configuration/jigsaw/generate_Thwaites_mesh.m similarity index 100% rename from test/compass/landice/Thwaites_variability/1km_varres_jigsaw/standard_configuration/jigsaw/generate_Thwaites_mesh.m rename to testing_and_setup/compass/landice/Thwaites_variability/1km_varres_jigsaw/standard_configuration/jigsaw/generate_Thwaites_mesh.m diff --git a/test/compass/landice/Thwaites_variability/4km_varres/standard_configuration/config_driver.xml b/testing_and_setup/compass/landice/Thwaites_variability/4km_varres/standard_configuration/config_driver.xml similarity index 100% rename from test/compass/landice/Thwaites_variability/4km_varres/standard_configuration/config_driver.xml rename to testing_and_setup/compass/landice/Thwaites_variability/4km_varres/standard_configuration/config_driver.xml diff --git a/test/compass/landice/Thwaites_variability/4km_varres/standard_configuration/config_setup_model_step.xml b/testing_and_setup/compass/landice/Thwaites_variability/4km_varres/standard_configuration/config_setup_model_step.xml similarity index 100% rename from test/compass/landice/Thwaites_variability/4km_varres/standard_configuration/config_setup_model_step.xml rename to testing_and_setup/compass/landice/Thwaites_variability/4km_varres/standard_configuration/config_setup_model_step.xml diff --git a/test/compass/landice/Thwaites_variability/README b/testing_and_setup/compass/landice/Thwaites_variability/README similarity index 100% rename from test/compass/landice/Thwaites_variability/README rename to testing_and_setup/compass/landice/Thwaites_variability/README diff --git a/test/compass/landice/Thwaites_variability/albany_input.xml b/testing_and_setup/compass/landice/Thwaites_variability/albany_input.xml similarity index 100% rename from test/compass/landice/Thwaites_variability/albany_input.xml rename to testing_and_setup/compass/landice/Thwaites_variability/albany_input.xml diff --git a/test/compass/landice/Thwaites_variability/compare_variability_runs.py b/testing_and_setup/compass/landice/Thwaites_variability/compare_variability_runs.py similarity index 100% rename from test/compass/landice/Thwaites_variability/compare_variability_runs.py rename to testing_and_setup/compass/landice/Thwaites_variability/compare_variability_runs.py diff --git a/test/compass/landice/Thwaites_variability/finalize_thwaites_initial_conditions.py b/testing_and_setup/compass/landice/Thwaites_variability/finalize_thwaites_initial_conditions.py similarity index 100% rename from test/compass/landice/Thwaites_variability/finalize_thwaites_initial_conditions.py rename to testing_and_setup/compass/landice/Thwaites_variability/finalize_thwaites_initial_conditions.py diff --git a/test/compass/landice/Thwaites_variability/setup_many_runs.sh b/testing_and_setup/compass/landice/Thwaites_variability/setup_many_runs.sh similarity index 100% rename from test/compass/landice/Thwaites_variability/setup_many_runs.sh rename to testing_and_setup/compass/landice/Thwaites_variability/setup_many_runs.sh diff --git a/test/compass/landice/Thwaites_variability/slurm.edison_bundle.run b/testing_and_setup/compass/landice/Thwaites_variability/slurm.edison_bundle.run similarity index 100% rename from test/compass/landice/Thwaites_variability/slurm.edison_bundle.run rename to testing_and_setup/compass/landice/Thwaites_variability/slurm.edison_bundle.run diff --git a/test/compass/landice/Thwaites_variability/slurm.wolf.run b/testing_and_setup/compass/landice/Thwaites_variability/slurm.wolf.run similarity index 100% rename from test/compass/landice/Thwaites_variability/slurm.wolf.run rename to testing_and_setup/compass/landice/Thwaites_variability/slurm.wolf.run diff --git a/test/compass/landice/Thwaites_variability/thwaites_minimal.geojson b/testing_and_setup/compass/landice/Thwaites_variability/thwaites_minimal.geojson similarity index 100% rename from test/compass/landice/Thwaites_variability/thwaites_minimal.geojson rename to testing_and_setup/compass/landice/Thwaites_variability/thwaites_minimal.geojson diff --git a/test/compass/landice/Thwaites_variability/thwaites_template.xml b/testing_and_setup/compass/landice/Thwaites_variability/thwaites_template.xml similarity index 100% rename from test/compass/landice/Thwaites_variability/thwaites_template.xml rename to testing_and_setup/compass/landice/Thwaites_variability/thwaites_template.xml diff --git a/test/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/config_setup_experiments.xml b/testing_and_setup/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/config_setup_experiments.xml similarity index 100% rename from test/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/config_setup_experiments.xml rename to testing_and_setup/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/config_setup_experiments.xml diff --git a/test/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/namelist.input b/testing_and_setup/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/namelist.input similarity index 100% rename from test/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/namelist.input rename to testing_and_setup/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/namelist.input diff --git a/test/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/namelist.input.0500m b/testing_and_setup/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/namelist.input.0500m similarity index 100% rename from test/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/namelist.input.0500m rename to testing_and_setup/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/namelist.input.0500m diff --git a/test/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/namelist.input.1000m b/testing_and_setup/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/namelist.input.1000m similarity index 100% rename from test/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/namelist.input.1000m rename to testing_and_setup/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/namelist.input.1000m diff --git a/test/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/namelist.input.2000m b/testing_and_setup/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/namelist.input.2000m similarity index 100% rename from test/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/namelist.input.2000m rename to testing_and_setup/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/namelist.input.2000m diff --git a/test/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/namelist.input.4000m b/testing_and_setup/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/namelist.input.4000m similarity index 100% rename from test/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/namelist.input.4000m rename to testing_and_setup/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/namelist.input.4000m diff --git a/test/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/namelist.input.8000m b/testing_and_setup/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/namelist.input.8000m similarity index 100% rename from test/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/namelist.input.8000m rename to testing_and_setup/compass/landice/Thwaites_variability/uniform_resolution/resolution_testing_configuration/namelist.input.8000m diff --git a/test/compass/landice/circular-shelf/1250m/circular-shelf_1250m_template.xml b/testing_and_setup/compass/landice/circular-shelf/1250m/circular-shelf_1250m_template.xml similarity index 100% rename from test/compass/landice/circular-shelf/1250m/circular-shelf_1250m_template.xml rename to testing_and_setup/compass/landice/circular-shelf/1250m/circular-shelf_1250m_template.xml diff --git a/test/compass/landice/circular-shelf/1250m/decomposition_test/config_1proc_run_model_step.xml b/testing_and_setup/compass/landice/circular-shelf/1250m/decomposition_test/config_1proc_run_model_step.xml similarity index 100% rename from test/compass/landice/circular-shelf/1250m/decomposition_test/config_1proc_run_model_step.xml rename to testing_and_setup/compass/landice/circular-shelf/1250m/decomposition_test/config_1proc_run_model_step.xml diff --git a/test/compass/landice/circular-shelf/1250m/decomposition_test/config_4proc_run_model_step.xml b/testing_and_setup/compass/landice/circular-shelf/1250m/decomposition_test/config_4proc_run_model_step.xml similarity index 100% rename from test/compass/landice/circular-shelf/1250m/decomposition_test/config_4proc_run_model_step.xml rename to testing_and_setup/compass/landice/circular-shelf/1250m/decomposition_test/config_4proc_run_model_step.xml diff --git a/test/compass/landice/circular-shelf/1250m/decomposition_test/config_driver.xml b/testing_and_setup/compass/landice/circular-shelf/1250m/decomposition_test/config_driver.xml similarity index 100% rename from test/compass/landice/circular-shelf/1250m/decomposition_test/config_driver.xml rename to testing_and_setup/compass/landice/circular-shelf/1250m/decomposition_test/config_driver.xml diff --git a/test/compass/landice/circular-shelf/1250m/decomposition_test/config_setup_mesh_step.xml b/testing_and_setup/compass/landice/circular-shelf/1250m/decomposition_test/config_setup_mesh_step.xml similarity index 100% rename from test/compass/landice/circular-shelf/1250m/decomposition_test/config_setup_mesh_step.xml rename to testing_and_setup/compass/landice/circular-shelf/1250m/decomposition_test/config_setup_mesh_step.xml diff --git a/test/compass/landice/circular-shelf/1250m/decomposition_test/output_comparison.xml b/testing_and_setup/compass/landice/circular-shelf/1250m/decomposition_test/output_comparison.xml similarity index 100% rename from test/compass/landice/circular-shelf/1250m/decomposition_test/output_comparison.xml rename to testing_and_setup/compass/landice/circular-shelf/1250m/decomposition_test/output_comparison.xml diff --git a/test/compass/landice/circular-shelf/1250m/periodic_hex.namelist.input b/testing_and_setup/compass/landice/circular-shelf/1250m/periodic_hex.namelist.input similarity index 100% rename from test/compass/landice/circular-shelf/1250m/periodic_hex.namelist.input rename to testing_and_setup/compass/landice/circular-shelf/1250m/periodic_hex.namelist.input diff --git a/test/compass/landice/circular-shelf/1250m/smoketest/config_driver.xml b/testing_and_setup/compass/landice/circular-shelf/1250m/smoketest/config_driver.xml similarity index 100% rename from test/compass/landice/circular-shelf/1250m/smoketest/config_driver.xml rename to testing_and_setup/compass/landice/circular-shelf/1250m/smoketest/config_driver.xml diff --git a/test/compass/landice/circular-shelf/1250m/smoketest/config_run_model_step.xml b/testing_and_setup/compass/landice/circular-shelf/1250m/smoketest/config_run_model_step.xml similarity index 100% rename from test/compass/landice/circular-shelf/1250m/smoketest/config_run_model_step.xml rename to testing_and_setup/compass/landice/circular-shelf/1250m/smoketest/config_run_model_step.xml diff --git a/test/compass/landice/circular-shelf/1250m/smoketest/config_setup_mesh_step.xml b/testing_and_setup/compass/landice/circular-shelf/1250m/smoketest/config_setup_mesh_step.xml similarity index 100% rename from test/compass/landice/circular-shelf/1250m/smoketest/config_setup_mesh_step.xml rename to testing_and_setup/compass/landice/circular-shelf/1250m/smoketest/config_setup_mesh_step.xml diff --git a/test/compass/landice/circular-shelf/albany_input.xml b/testing_and_setup/compass/landice/circular-shelf/albany_input.xml similarity index 100% rename from test/compass/landice/circular-shelf/albany_input.xml rename to testing_and_setup/compass/landice/circular-shelf/albany_input.xml diff --git a/test/compass/landice/circular-shelf/setup_circular_shelf_initial_conditions.py b/testing_and_setup/compass/landice/circular-shelf/setup_circular_shelf_initial_conditions.py similarity index 100% rename from test/compass/landice/circular-shelf/setup_circular_shelf_initial_conditions.py rename to testing_and_setup/compass/landice/circular-shelf/setup_circular_shelf_initial_conditions.py diff --git a/test/compass/landice/circular-shelf/visualize_circular_shelf.py b/testing_and_setup/compass/landice/circular-shelf/visualize_circular_shelf.py similarity index 100% rename from test/compass/landice/circular-shelf/visualize_circular_shelf.py rename to testing_and_setup/compass/landice/circular-shelf/visualize_circular_shelf.py diff --git a/test/compass/landice/confined-shelf/5000m/confined-shelf_5000m_template.xml b/testing_and_setup/compass/landice/confined-shelf/5000m/confined-shelf_5000m_template.xml similarity index 100% rename from test/compass/landice/confined-shelf/5000m/confined-shelf_5000m_template.xml rename to testing_and_setup/compass/landice/confined-shelf/5000m/confined-shelf_5000m_template.xml diff --git a/test/compass/landice/confined-shelf/5000m/decomposition_test/config_1proc_run_model_step.xml b/testing_and_setup/compass/landice/confined-shelf/5000m/decomposition_test/config_1proc_run_model_step.xml similarity index 100% rename from test/compass/landice/confined-shelf/5000m/decomposition_test/config_1proc_run_model_step.xml rename to testing_and_setup/compass/landice/confined-shelf/5000m/decomposition_test/config_1proc_run_model_step.xml diff --git a/test/compass/landice/confined-shelf/5000m/decomposition_test/config_4proc_run_model_step.xml b/testing_and_setup/compass/landice/confined-shelf/5000m/decomposition_test/config_4proc_run_model_step.xml similarity index 100% rename from test/compass/landice/confined-shelf/5000m/decomposition_test/config_4proc_run_model_step.xml rename to testing_and_setup/compass/landice/confined-shelf/5000m/decomposition_test/config_4proc_run_model_step.xml diff --git a/test/compass/landice/confined-shelf/5000m/decomposition_test/config_driver.xml b/testing_and_setup/compass/landice/confined-shelf/5000m/decomposition_test/config_driver.xml similarity index 100% rename from test/compass/landice/confined-shelf/5000m/decomposition_test/config_driver.xml rename to testing_and_setup/compass/landice/confined-shelf/5000m/decomposition_test/config_driver.xml diff --git a/test/compass/landice/confined-shelf/5000m/decomposition_test/config_setup_mesh_step.xml b/testing_and_setup/compass/landice/confined-shelf/5000m/decomposition_test/config_setup_mesh_step.xml similarity index 100% rename from test/compass/landice/confined-shelf/5000m/decomposition_test/config_setup_mesh_step.xml rename to testing_and_setup/compass/landice/confined-shelf/5000m/decomposition_test/config_setup_mesh_step.xml diff --git a/test/compass/landice/confined-shelf/5000m/decomposition_test/output_comparison.xml b/testing_and_setup/compass/landice/confined-shelf/5000m/decomposition_test/output_comparison.xml similarity index 100% rename from test/compass/landice/confined-shelf/5000m/decomposition_test/output_comparison.xml rename to testing_and_setup/compass/landice/confined-shelf/5000m/decomposition_test/output_comparison.xml diff --git a/test/compass/landice/confined-shelf/5000m/periodic_hex.namelist.input b/testing_and_setup/compass/landice/confined-shelf/5000m/periodic_hex.namelist.input similarity index 100% rename from test/compass/landice/confined-shelf/5000m/periodic_hex.namelist.input rename to testing_and_setup/compass/landice/confined-shelf/5000m/periodic_hex.namelist.input diff --git a/test/compass/landice/confined-shelf/5000m/smoketest/config_driver.xml b/testing_and_setup/compass/landice/confined-shelf/5000m/smoketest/config_driver.xml similarity index 100% rename from test/compass/landice/confined-shelf/5000m/smoketest/config_driver.xml rename to testing_and_setup/compass/landice/confined-shelf/5000m/smoketest/config_driver.xml diff --git a/test/compass/landice/confined-shelf/5000m/smoketest/config_run_model_step.xml b/testing_and_setup/compass/landice/confined-shelf/5000m/smoketest/config_run_model_step.xml similarity index 100% rename from test/compass/landice/confined-shelf/5000m/smoketest/config_run_model_step.xml rename to testing_and_setup/compass/landice/confined-shelf/5000m/smoketest/config_run_model_step.xml diff --git a/test/compass/landice/confined-shelf/5000m/smoketest/config_setup_mesh_step.xml b/testing_and_setup/compass/landice/confined-shelf/5000m/smoketest/config_setup_mesh_step.xml similarity index 100% rename from test/compass/landice/confined-shelf/5000m/smoketest/config_setup_mesh_step.xml rename to testing_and_setup/compass/landice/confined-shelf/5000m/smoketest/config_setup_mesh_step.xml diff --git a/test/compass/landice/confined-shelf/albany_input.xml b/testing_and_setup/compass/landice/confined-shelf/albany_input.xml similarity index 100% rename from test/compass/landice/confined-shelf/albany_input.xml rename to testing_and_setup/compass/landice/confined-shelf/albany_input.xml diff --git a/test/compass/landice/confined-shelf/setup_confined_shelf_initial_conditions.py b/testing_and_setup/compass/landice/confined-shelf/setup_confined_shelf_initial_conditions.py similarity index 100% rename from test/compass/landice/confined-shelf/setup_confined_shelf_initial_conditions.py rename to testing_and_setup/compass/landice/confined-shelf/setup_confined_shelf_initial_conditions.py diff --git a/test/compass/landice/confined-shelf/visualize_confined_shelf.py b/testing_and_setup/compass/landice/confined-shelf/visualize_confined_shelf.py similarity index 100% rename from test/compass/landice/confined-shelf/visualize_confined_shelf.py rename to testing_and_setup/compass/landice/confined-shelf/visualize_confined_shelf.py diff --git a/test/compass/landice/dome/2000m/decomposition_test/config_1proc_run_model_step.xml b/testing_and_setup/compass/landice/dome/2000m/decomposition_test/config_1proc_run_model_step.xml similarity index 100% rename from test/compass/landice/dome/2000m/decomposition_test/config_1proc_run_model_step.xml rename to testing_and_setup/compass/landice/dome/2000m/decomposition_test/config_1proc_run_model_step.xml diff --git a/test/compass/landice/dome/2000m/decomposition_test/config_4proc_run_model_step.xml b/testing_and_setup/compass/landice/dome/2000m/decomposition_test/config_4proc_run_model_step.xml similarity index 100% rename from test/compass/landice/dome/2000m/decomposition_test/config_4proc_run_model_step.xml rename to testing_and_setup/compass/landice/dome/2000m/decomposition_test/config_4proc_run_model_step.xml diff --git a/test/compass/landice/dome/2000m/decomposition_test/config_driver.xml b/testing_and_setup/compass/landice/dome/2000m/decomposition_test/config_driver.xml similarity index 100% rename from test/compass/landice/dome/2000m/decomposition_test/config_driver.xml rename to testing_and_setup/compass/landice/dome/2000m/decomposition_test/config_driver.xml diff --git a/test/compass/landice/dome/2000m/decomposition_test/config_setup_mesh_step.xml b/testing_and_setup/compass/landice/dome/2000m/decomposition_test/config_setup_mesh_step.xml similarity index 100% rename from test/compass/landice/dome/2000m/decomposition_test/config_setup_mesh_step.xml rename to testing_and_setup/compass/landice/dome/2000m/decomposition_test/config_setup_mesh_step.xml diff --git a/test/compass/landice/dome/2000m/decomposition_test/output_comparison.xml b/testing_and_setup/compass/landice/dome/2000m/decomposition_test/output_comparison.xml similarity index 100% rename from test/compass/landice/dome/2000m/decomposition_test/output_comparison.xml rename to testing_and_setup/compass/landice/dome/2000m/decomposition_test/output_comparison.xml diff --git a/test/compass/landice/dome/2000m/dome_2000m_template.xml b/testing_and_setup/compass/landice/dome/2000m/dome_2000m_template.xml similarity index 100% rename from test/compass/landice/dome/2000m/dome_2000m_template.xml rename to testing_and_setup/compass/landice/dome/2000m/dome_2000m_template.xml diff --git a/test/compass/landice/dome/2000m/halfar_analytic_test/config_driver.xml b/testing_and_setup/compass/landice/dome/2000m/halfar_analytic_test/config_driver.xml similarity index 100% rename from test/compass/landice/dome/2000m/halfar_analytic_test/config_driver.xml rename to testing_and_setup/compass/landice/dome/2000m/halfar_analytic_test/config_driver.xml diff --git a/test/compass/landice/dome/2000m/halfar_analytic_test/config_run_model_step.xml b/testing_and_setup/compass/landice/dome/2000m/halfar_analytic_test/config_run_model_step.xml similarity index 100% rename from test/compass/landice/dome/2000m/halfar_analytic_test/config_run_model_step.xml rename to testing_and_setup/compass/landice/dome/2000m/halfar_analytic_test/config_run_model_step.xml diff --git a/test/compass/landice/dome/2000m/halfar_analytic_test/config_setup_mesh_step.xml b/testing_and_setup/compass/landice/dome/2000m/halfar_analytic_test/config_setup_mesh_step.xml similarity index 100% rename from test/compass/landice/dome/2000m/halfar_analytic_test/config_setup_mesh_step.xml rename to testing_and_setup/compass/landice/dome/2000m/halfar_analytic_test/config_setup_mesh_step.xml diff --git a/test/compass/landice/dome/2000m/ho_decomposition_test/config_1proc_run_model_step.xml b/testing_and_setup/compass/landice/dome/2000m/ho_decomposition_test/config_1proc_run_model_step.xml similarity index 100% rename from test/compass/landice/dome/2000m/ho_decomposition_test/config_1proc_run_model_step.xml rename to testing_and_setup/compass/landice/dome/2000m/ho_decomposition_test/config_1proc_run_model_step.xml diff --git a/test/compass/landice/dome/2000m/ho_decomposition_test/config_4proc_run_model_step.xml b/testing_and_setup/compass/landice/dome/2000m/ho_decomposition_test/config_4proc_run_model_step.xml similarity index 100% rename from test/compass/landice/dome/2000m/ho_decomposition_test/config_4proc_run_model_step.xml rename to testing_and_setup/compass/landice/dome/2000m/ho_decomposition_test/config_4proc_run_model_step.xml diff --git a/test/compass/landice/dome/2000m/ho_decomposition_test/config_driver.xml b/testing_and_setup/compass/landice/dome/2000m/ho_decomposition_test/config_driver.xml similarity index 100% rename from test/compass/landice/dome/2000m/ho_decomposition_test/config_driver.xml rename to testing_and_setup/compass/landice/dome/2000m/ho_decomposition_test/config_driver.xml diff --git a/test/compass/landice/dome/2000m/ho_decomposition_test/config_setup_mesh_step.xml b/testing_and_setup/compass/landice/dome/2000m/ho_decomposition_test/config_setup_mesh_step.xml similarity index 100% rename from test/compass/landice/dome/2000m/ho_decomposition_test/config_setup_mesh_step.xml rename to testing_and_setup/compass/landice/dome/2000m/ho_decomposition_test/config_setup_mesh_step.xml diff --git a/test/compass/landice/dome/2000m/ho_decomposition_test/output_comparison.xml b/testing_and_setup/compass/landice/dome/2000m/ho_decomposition_test/output_comparison.xml similarity index 100% rename from test/compass/landice/dome/2000m/ho_decomposition_test/output_comparison.xml rename to testing_and_setup/compass/landice/dome/2000m/ho_decomposition_test/output_comparison.xml diff --git a/test/compass/landice/dome/2000m/ho_restart_test/config_driver.xml b/testing_and_setup/compass/landice/dome/2000m/ho_restart_test/config_driver.xml similarity index 100% rename from test/compass/landice/dome/2000m/ho_restart_test/config_driver.xml rename to testing_and_setup/compass/landice/dome/2000m/ho_restart_test/config_driver.xml diff --git a/test/compass/landice/dome/2000m/ho_restart_test/config_full_run_step.xml b/testing_and_setup/compass/landice/dome/2000m/ho_restart_test/config_full_run_step.xml similarity index 100% rename from test/compass/landice/dome/2000m/ho_restart_test/config_full_run_step.xml rename to testing_and_setup/compass/landice/dome/2000m/ho_restart_test/config_full_run_step.xml diff --git a/test/compass/landice/dome/2000m/ho_restart_test/config_restart_run_step.xml b/testing_and_setup/compass/landice/dome/2000m/ho_restart_test/config_restart_run_step.xml similarity index 100% rename from test/compass/landice/dome/2000m/ho_restart_test/config_restart_run_step.xml rename to testing_and_setup/compass/landice/dome/2000m/ho_restart_test/config_restart_run_step.xml diff --git a/test/compass/landice/dome/2000m/ho_restart_test/config_setup_mesh_step.xml b/testing_and_setup/compass/landice/dome/2000m/ho_restart_test/config_setup_mesh_step.xml similarity index 100% rename from test/compass/landice/dome/2000m/ho_restart_test/config_setup_mesh_step.xml rename to testing_and_setup/compass/landice/dome/2000m/ho_restart_test/config_setup_mesh_step.xml diff --git a/test/compass/landice/dome/2000m/ho_restart_test/output_comparison.xml b/testing_and_setup/compass/landice/dome/2000m/ho_restart_test/output_comparison.xml similarity index 100% rename from test/compass/landice/dome/2000m/ho_restart_test/output_comparison.xml rename to testing_and_setup/compass/landice/dome/2000m/ho_restart_test/output_comparison.xml diff --git a/test/compass/landice/dome/2000m/ho_vs_sia_test/config_driver.xml b/testing_and_setup/compass/landice/dome/2000m/ho_vs_sia_test/config_driver.xml similarity index 100% rename from test/compass/landice/dome/2000m/ho_vs_sia_test/config_driver.xml rename to testing_and_setup/compass/landice/dome/2000m/ho_vs_sia_test/config_driver.xml diff --git a/test/compass/landice/dome/2000m/ho_vs_sia_test/config_ho_run_model_step.xml b/testing_and_setup/compass/landice/dome/2000m/ho_vs_sia_test/config_ho_run_model_step.xml similarity index 100% rename from test/compass/landice/dome/2000m/ho_vs_sia_test/config_ho_run_model_step.xml rename to testing_and_setup/compass/landice/dome/2000m/ho_vs_sia_test/config_ho_run_model_step.xml diff --git a/test/compass/landice/dome/2000m/ho_vs_sia_test/config_setup_mesh_step.xml b/testing_and_setup/compass/landice/dome/2000m/ho_vs_sia_test/config_setup_mesh_step.xml similarity index 100% rename from test/compass/landice/dome/2000m/ho_vs_sia_test/config_setup_mesh_step.xml rename to testing_and_setup/compass/landice/dome/2000m/ho_vs_sia_test/config_setup_mesh_step.xml diff --git a/test/compass/landice/dome/2000m/ho_vs_sia_test/config_sia_run_model_step.xml b/testing_and_setup/compass/landice/dome/2000m/ho_vs_sia_test/config_sia_run_model_step.xml similarity index 100% rename from test/compass/landice/dome/2000m/ho_vs_sia_test/config_sia_run_model_step.xml rename to testing_and_setup/compass/landice/dome/2000m/ho_vs_sia_test/config_sia_run_model_step.xml diff --git a/test/compass/landice/dome/2000m/ho_vs_sia_test/output_comparison.xml b/testing_and_setup/compass/landice/dome/2000m/ho_vs_sia_test/output_comparison.xml similarity index 100% rename from test/compass/landice/dome/2000m/ho_vs_sia_test/output_comparison.xml rename to testing_and_setup/compass/landice/dome/2000m/ho_vs_sia_test/output_comparison.xml diff --git a/test/compass/landice/dome/2000m/periodic_hex.namelist.input b/testing_and_setup/compass/landice/dome/2000m/periodic_hex.namelist.input similarity index 100% rename from test/compass/landice/dome/2000m/periodic_hex.namelist.input rename to testing_and_setup/compass/landice/dome/2000m/periodic_hex.namelist.input diff --git a/test/compass/landice/dome/2000m/restart_test/config_driver.xml b/testing_and_setup/compass/landice/dome/2000m/restart_test/config_driver.xml similarity index 100% rename from test/compass/landice/dome/2000m/restart_test/config_driver.xml rename to testing_and_setup/compass/landice/dome/2000m/restart_test/config_driver.xml diff --git a/test/compass/landice/dome/2000m/restart_test/config_full_run_step.xml b/testing_and_setup/compass/landice/dome/2000m/restart_test/config_full_run_step.xml similarity index 100% rename from test/compass/landice/dome/2000m/restart_test/config_full_run_step.xml rename to testing_and_setup/compass/landice/dome/2000m/restart_test/config_full_run_step.xml diff --git a/test/compass/landice/dome/2000m/restart_test/config_restart_run_step.xml b/testing_and_setup/compass/landice/dome/2000m/restart_test/config_restart_run_step.xml similarity index 100% rename from test/compass/landice/dome/2000m/restart_test/config_restart_run_step.xml rename to testing_and_setup/compass/landice/dome/2000m/restart_test/config_restart_run_step.xml diff --git a/test/compass/landice/dome/2000m/restart_test/config_setup_mesh_step.xml b/testing_and_setup/compass/landice/dome/2000m/restart_test/config_setup_mesh_step.xml similarity index 100% rename from test/compass/landice/dome/2000m/restart_test/config_setup_mesh_step.xml rename to testing_and_setup/compass/landice/dome/2000m/restart_test/config_setup_mesh_step.xml diff --git a/test/compass/landice/dome/2000m/restart_test/output_comparison.xml b/testing_and_setup/compass/landice/dome/2000m/restart_test/output_comparison.xml similarity index 100% rename from test/compass/landice/dome/2000m/restart_test/output_comparison.xml rename to testing_and_setup/compass/landice/dome/2000m/restart_test/output_comparison.xml diff --git a/test/compass/landice/dome/2000m/smoketest/config_driver.xml b/testing_and_setup/compass/landice/dome/2000m/smoketest/config_driver.xml similarity index 100% rename from test/compass/landice/dome/2000m/smoketest/config_driver.xml rename to testing_and_setup/compass/landice/dome/2000m/smoketest/config_driver.xml diff --git a/test/compass/landice/dome/2000m/smoketest/config_run_model_step.xml b/testing_and_setup/compass/landice/dome/2000m/smoketest/config_run_model_step.xml similarity index 100% rename from test/compass/landice/dome/2000m/smoketest/config_run_model_step.xml rename to testing_and_setup/compass/landice/dome/2000m/smoketest/config_run_model_step.xml diff --git a/test/compass/landice/dome/2000m/smoketest/config_setup_mesh_step.xml b/testing_and_setup/compass/landice/dome/2000m/smoketest/config_setup_mesh_step.xml similarity index 100% rename from test/compass/landice/dome/2000m/smoketest/config_setup_mesh_step.xml rename to testing_and_setup/compass/landice/dome/2000m/smoketest/config_setup_mesh_step.xml diff --git a/test/compass/landice/dome/albany_input.xml b/testing_and_setup/compass/landice/dome/albany_input.xml similarity index 100% rename from test/compass/landice/dome/albany_input.xml rename to testing_and_setup/compass/landice/dome/albany_input.xml diff --git a/test/compass/landice/dome/check_halfar_solution.py b/testing_and_setup/compass/landice/dome/check_halfar_solution.py similarity index 100% rename from test/compass/landice/dome/check_halfar_solution.py rename to testing_and_setup/compass/landice/dome/check_halfar_solution.py diff --git a/test/compass/landice/dome/setup_dome_initial_conditions.py b/testing_and_setup/compass/landice/dome/setup_dome_initial_conditions.py similarity index 100% rename from test/compass/landice/dome/setup_dome_initial_conditions.py rename to testing_and_setup/compass/landice/dome/setup_dome_initial_conditions.py diff --git a/test/compass/landice/dome/variable_resolution/decomposition_test/config_1proc_run_model_step.xml b/testing_and_setup/compass/landice/dome/variable_resolution/decomposition_test/config_1proc_run_model_step.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/decomposition_test/config_1proc_run_model_step.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/decomposition_test/config_1proc_run_model_step.xml diff --git a/test/compass/landice/dome/variable_resolution/decomposition_test/config_4proc_run_model_step.xml b/testing_and_setup/compass/landice/dome/variable_resolution/decomposition_test/config_4proc_run_model_step.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/decomposition_test/config_4proc_run_model_step.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/decomposition_test/config_4proc_run_model_step.xml diff --git a/test/compass/landice/dome/variable_resolution/decomposition_test/config_driver.xml b/testing_and_setup/compass/landice/dome/variable_resolution/decomposition_test/config_driver.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/decomposition_test/config_driver.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/decomposition_test/config_driver.xml diff --git a/test/compass/landice/dome/variable_resolution/decomposition_test/config_setup_mesh_step.xml b/testing_and_setup/compass/landice/dome/variable_resolution/decomposition_test/config_setup_mesh_step.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/decomposition_test/config_setup_mesh_step.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/decomposition_test/config_setup_mesh_step.xml diff --git a/test/compass/landice/dome/variable_resolution/decomposition_test/output_comparison.xml b/testing_and_setup/compass/landice/dome/variable_resolution/decomposition_test/output_comparison.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/decomposition_test/output_comparison.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/decomposition_test/output_comparison.xml diff --git a/test/compass/landice/dome/variable_resolution/dome_varres_template.xml b/testing_and_setup/compass/landice/dome/variable_resolution/dome_varres_template.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/dome_varres_template.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/dome_varres_template.xml diff --git a/test/compass/landice/dome/variable_resolution/halfar_analytic_test/config_driver.xml b/testing_and_setup/compass/landice/dome/variable_resolution/halfar_analytic_test/config_driver.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/halfar_analytic_test/config_driver.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/halfar_analytic_test/config_driver.xml diff --git a/test/compass/landice/dome/variable_resolution/halfar_analytic_test/config_run_model_step.xml b/testing_and_setup/compass/landice/dome/variable_resolution/halfar_analytic_test/config_run_model_step.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/halfar_analytic_test/config_run_model_step.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/halfar_analytic_test/config_run_model_step.xml diff --git a/test/compass/landice/dome/variable_resolution/halfar_analytic_test/config_setup_mesh_step.xml b/testing_and_setup/compass/landice/dome/variable_resolution/halfar_analytic_test/config_setup_mesh_step.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/halfar_analytic_test/config_setup_mesh_step.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/halfar_analytic_test/config_setup_mesh_step.xml diff --git a/test/compass/landice/dome/variable_resolution/ho_decomposition_test/config_1proc_run_model_step.xml b/testing_and_setup/compass/landice/dome/variable_resolution/ho_decomposition_test/config_1proc_run_model_step.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/ho_decomposition_test/config_1proc_run_model_step.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/ho_decomposition_test/config_1proc_run_model_step.xml diff --git a/test/compass/landice/dome/variable_resolution/ho_decomposition_test/config_4proc_run_model_step.xml b/testing_and_setup/compass/landice/dome/variable_resolution/ho_decomposition_test/config_4proc_run_model_step.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/ho_decomposition_test/config_4proc_run_model_step.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/ho_decomposition_test/config_4proc_run_model_step.xml diff --git a/test/compass/landice/dome/variable_resolution/ho_decomposition_test/config_driver.xml b/testing_and_setup/compass/landice/dome/variable_resolution/ho_decomposition_test/config_driver.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/ho_decomposition_test/config_driver.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/ho_decomposition_test/config_driver.xml diff --git a/test/compass/landice/dome/variable_resolution/ho_decomposition_test/config_setup_mesh_step.xml b/testing_and_setup/compass/landice/dome/variable_resolution/ho_decomposition_test/config_setup_mesh_step.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/ho_decomposition_test/config_setup_mesh_step.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/ho_decomposition_test/config_setup_mesh_step.xml diff --git a/test/compass/landice/dome/variable_resolution/ho_decomposition_test/output_comparison.xml b/testing_and_setup/compass/landice/dome/variable_resolution/ho_decomposition_test/output_comparison.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/ho_decomposition_test/output_comparison.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/ho_decomposition_test/output_comparison.xml diff --git a/test/compass/landice/dome/variable_resolution/ho_restart_test/config_driver.xml b/testing_and_setup/compass/landice/dome/variable_resolution/ho_restart_test/config_driver.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/ho_restart_test/config_driver.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/ho_restart_test/config_driver.xml diff --git a/test/compass/landice/dome/variable_resolution/ho_restart_test/config_full_run_step.xml b/testing_and_setup/compass/landice/dome/variable_resolution/ho_restart_test/config_full_run_step.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/ho_restart_test/config_full_run_step.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/ho_restart_test/config_full_run_step.xml diff --git a/test/compass/landice/dome/variable_resolution/ho_restart_test/config_restart_run_step.xml b/testing_and_setup/compass/landice/dome/variable_resolution/ho_restart_test/config_restart_run_step.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/ho_restart_test/config_restart_run_step.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/ho_restart_test/config_restart_run_step.xml diff --git a/test/compass/landice/dome/variable_resolution/ho_restart_test/config_setup_mesh_step.xml b/testing_and_setup/compass/landice/dome/variable_resolution/ho_restart_test/config_setup_mesh_step.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/ho_restart_test/config_setup_mesh_step.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/ho_restart_test/config_setup_mesh_step.xml diff --git a/test/compass/landice/dome/variable_resolution/ho_restart_test/output_comparison.xml b/testing_and_setup/compass/landice/dome/variable_resolution/ho_restart_test/output_comparison.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/ho_restart_test/output_comparison.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/ho_restart_test/output_comparison.xml diff --git a/test/compass/landice/dome/variable_resolution/restart_test/config_driver.xml b/testing_and_setup/compass/landice/dome/variable_resolution/restart_test/config_driver.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/restart_test/config_driver.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/restart_test/config_driver.xml diff --git a/test/compass/landice/dome/variable_resolution/restart_test/config_full_run_step.xml b/testing_and_setup/compass/landice/dome/variable_resolution/restart_test/config_full_run_step.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/restart_test/config_full_run_step.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/restart_test/config_full_run_step.xml diff --git a/test/compass/landice/dome/variable_resolution/restart_test/config_restart_run_step.xml b/testing_and_setup/compass/landice/dome/variable_resolution/restart_test/config_restart_run_step.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/restart_test/config_restart_run_step.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/restart_test/config_restart_run_step.xml diff --git a/test/compass/landice/dome/variable_resolution/restart_test/config_setup_mesh_step.xml b/testing_and_setup/compass/landice/dome/variable_resolution/restart_test/config_setup_mesh_step.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/restart_test/config_setup_mesh_step.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/restart_test/config_setup_mesh_step.xml diff --git a/test/compass/landice/dome/variable_resolution/restart_test/output_comparison.xml b/testing_and_setup/compass/landice/dome/variable_resolution/restart_test/output_comparison.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/restart_test/output_comparison.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/restart_test/output_comparison.xml diff --git a/test/compass/landice/dome/variable_resolution/smoketest/config_driver.xml b/testing_and_setup/compass/landice/dome/variable_resolution/smoketest/config_driver.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/smoketest/config_driver.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/smoketest/config_driver.xml diff --git a/test/compass/landice/dome/variable_resolution/smoketest/config_run_model_step.xml b/testing_and_setup/compass/landice/dome/variable_resolution/smoketest/config_run_model_step.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/smoketest/config_run_model_step.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/smoketest/config_run_model_step.xml diff --git a/test/compass/landice/dome/variable_resolution/smoketest/config_setup_mesh_step.xml b/testing_and_setup/compass/landice/dome/variable_resolution/smoketest/config_setup_mesh_step.xml similarity index 100% rename from test/compass/landice/dome/variable_resolution/smoketest/config_setup_mesh_step.xml rename to testing_and_setup/compass/landice/dome/variable_resolution/smoketest/config_setup_mesh_step.xml diff --git a/test/compass/landice/dome/variable_resolution_jigsaw/generate_varres_dome_mesh.m b/testing_and_setup/compass/landice/dome/variable_resolution_jigsaw/generate_varres_dome_mesh.m similarity index 100% rename from test/compass/landice/dome/variable_resolution_jigsaw/generate_varres_dome_mesh.m rename to testing_and_setup/compass/landice/dome/variable_resolution_jigsaw/generate_varres_dome_mesh.m diff --git a/test/compass/landice/dome/visualize_dome.py b/testing_and_setup/compass/landice/dome/visualize_dome.py similarity index 100% rename from test/compass/landice/dome/visualize_dome.py rename to testing_and_setup/compass/landice/dome/visualize_dome.py diff --git a/test/compass/landice/greenland/20km/decomposition_test/config_1proc_run_model_step.xml b/testing_and_setup/compass/landice/greenland/20km/decomposition_test/config_1proc_run_model_step.xml similarity index 100% rename from test/compass/landice/greenland/20km/decomposition_test/config_1proc_run_model_step.xml rename to testing_and_setup/compass/landice/greenland/20km/decomposition_test/config_1proc_run_model_step.xml diff --git a/test/compass/landice/greenland/20km/decomposition_test/config_8proc_run_model_step.xml b/testing_and_setup/compass/landice/greenland/20km/decomposition_test/config_8proc_run_model_step.xml similarity index 100% rename from test/compass/landice/greenland/20km/decomposition_test/config_8proc_run_model_step.xml rename to testing_and_setup/compass/landice/greenland/20km/decomposition_test/config_8proc_run_model_step.xml diff --git a/test/compass/landice/greenland/20km/decomposition_test/config_driver.xml b/testing_and_setup/compass/landice/greenland/20km/decomposition_test/config_driver.xml similarity index 100% rename from test/compass/landice/greenland/20km/decomposition_test/config_driver.xml rename to testing_and_setup/compass/landice/greenland/20km/decomposition_test/config_driver.xml diff --git a/test/compass/landice/greenland/20km/decomposition_test/output_comparison.xml b/testing_and_setup/compass/landice/greenland/20km/decomposition_test/output_comparison.xml similarity index 100% rename from test/compass/landice/greenland/20km/decomposition_test/output_comparison.xml rename to testing_and_setup/compass/landice/greenland/20km/decomposition_test/output_comparison.xml diff --git a/test/compass/landice/greenland/20km/greenland_20km_template.xml b/testing_and_setup/compass/landice/greenland/20km/greenland_20km_template.xml similarity index 100% rename from test/compass/landice/greenland/20km/greenland_20km_template.xml rename to testing_and_setup/compass/landice/greenland/20km/greenland_20km_template.xml diff --git a/test/compass/landice/greenland/20km/restart_test/config_driver.xml b/testing_and_setup/compass/landice/greenland/20km/restart_test/config_driver.xml similarity index 100% rename from test/compass/landice/greenland/20km/restart_test/config_driver.xml rename to testing_and_setup/compass/landice/greenland/20km/restart_test/config_driver.xml diff --git a/test/compass/landice/greenland/20km/restart_test/config_full_run_step.xml b/testing_and_setup/compass/landice/greenland/20km/restart_test/config_full_run_step.xml similarity index 100% rename from test/compass/landice/greenland/20km/restart_test/config_full_run_step.xml rename to testing_and_setup/compass/landice/greenland/20km/restart_test/config_full_run_step.xml diff --git a/test/compass/landice/greenland/20km/restart_test/config_restart_run_step.xml b/testing_and_setup/compass/landice/greenland/20km/restart_test/config_restart_run_step.xml similarity index 100% rename from test/compass/landice/greenland/20km/restart_test/config_restart_run_step.xml rename to testing_and_setup/compass/landice/greenland/20km/restart_test/config_restart_run_step.xml diff --git a/test/compass/landice/greenland/20km/restart_test/output_comparison.xml b/testing_and_setup/compass/landice/greenland/20km/restart_test/output_comparison.xml similarity index 100% rename from test/compass/landice/greenland/20km/restart_test/output_comparison.xml rename to testing_and_setup/compass/landice/greenland/20km/restart_test/output_comparison.xml diff --git a/test/compass/landice/greenland/20km/smoke_test/config_driver.xml b/testing_and_setup/compass/landice/greenland/20km/smoke_test/config_driver.xml similarity index 100% rename from test/compass/landice/greenland/20km/smoke_test/config_driver.xml rename to testing_and_setup/compass/landice/greenland/20km/smoke_test/config_driver.xml diff --git a/test/compass/landice/greenland/20km/smoke_test/config_run_model_step.xml b/testing_and_setup/compass/landice/greenland/20km/smoke_test/config_run_model_step.xml similarity index 100% rename from test/compass/landice/greenland/20km/smoke_test/config_run_model_step.xml rename to testing_and_setup/compass/landice/greenland/20km/smoke_test/config_run_model_step.xml diff --git a/test/compass/landice/greenland/albany_input.xml b/testing_and_setup/compass/landice/greenland/albany_input.xml similarity index 100% rename from test/compass/landice/greenland/albany_input.xml rename to testing_and_setup/compass/landice/greenland/albany_input.xml diff --git a/test/compass/landice/hydro-radial/1000m/decomposition_test/config_1proc_run_model_step.xml b/testing_and_setup/compass/landice/hydro-radial/1000m/decomposition_test/config_1proc_run_model_step.xml similarity index 100% rename from test/compass/landice/hydro-radial/1000m/decomposition_test/config_1proc_run_model_step.xml rename to testing_and_setup/compass/landice/hydro-radial/1000m/decomposition_test/config_1proc_run_model_step.xml diff --git a/test/compass/landice/hydro-radial/1000m/decomposition_test/config_3proc_run_model_step.xml b/testing_and_setup/compass/landice/hydro-radial/1000m/decomposition_test/config_3proc_run_model_step.xml similarity index 100% rename from test/compass/landice/hydro-radial/1000m/decomposition_test/config_3proc_run_model_step.xml rename to testing_and_setup/compass/landice/hydro-radial/1000m/decomposition_test/config_3proc_run_model_step.xml diff --git a/test/compass/landice/hydro-radial/1000m/decomposition_test/config_driver.xml b/testing_and_setup/compass/landice/hydro-radial/1000m/decomposition_test/config_driver.xml similarity index 100% rename from test/compass/landice/hydro-radial/1000m/decomposition_test/config_driver.xml rename to testing_and_setup/compass/landice/hydro-radial/1000m/decomposition_test/config_driver.xml diff --git a/test/compass/landice/hydro-radial/1000m/decomposition_test/config_setup_mesh_step.xml b/testing_and_setup/compass/landice/hydro-radial/1000m/decomposition_test/config_setup_mesh_step.xml similarity index 100% rename from test/compass/landice/hydro-radial/1000m/decomposition_test/config_setup_mesh_step.xml rename to testing_and_setup/compass/landice/hydro-radial/1000m/decomposition_test/config_setup_mesh_step.xml diff --git a/test/compass/landice/hydro-radial/1000m/decomposition_test/output_comparison.xml b/testing_and_setup/compass/landice/hydro-radial/1000m/decomposition_test/output_comparison.xml similarity index 100% rename from test/compass/landice/hydro-radial/1000m/decomposition_test/output_comparison.xml rename to testing_and_setup/compass/landice/hydro-radial/1000m/decomposition_test/output_comparison.xml diff --git a/test/compass/landice/hydro-radial/1000m/periodic_hex.namelist.input b/testing_and_setup/compass/landice/hydro-radial/1000m/periodic_hex.namelist.input similarity index 100% rename from test/compass/landice/hydro-radial/1000m/periodic_hex.namelist.input rename to testing_and_setup/compass/landice/hydro-radial/1000m/periodic_hex.namelist.input diff --git a/test/compass/landice/hydro-radial/1000m/restart_test/config_driver.xml b/testing_and_setup/compass/landice/hydro-radial/1000m/restart_test/config_driver.xml similarity index 100% rename from test/compass/landice/hydro-radial/1000m/restart_test/config_driver.xml rename to testing_and_setup/compass/landice/hydro-radial/1000m/restart_test/config_driver.xml diff --git a/test/compass/landice/hydro-radial/1000m/restart_test/config_full_run_step.xml b/testing_and_setup/compass/landice/hydro-radial/1000m/restart_test/config_full_run_step.xml similarity index 100% rename from test/compass/landice/hydro-radial/1000m/restart_test/config_full_run_step.xml rename to testing_and_setup/compass/landice/hydro-radial/1000m/restart_test/config_full_run_step.xml diff --git a/test/compass/landice/hydro-radial/1000m/restart_test/config_restart_run_step.xml b/testing_and_setup/compass/landice/hydro-radial/1000m/restart_test/config_restart_run_step.xml similarity index 100% rename from test/compass/landice/hydro-radial/1000m/restart_test/config_restart_run_step.xml rename to testing_and_setup/compass/landice/hydro-radial/1000m/restart_test/config_restart_run_step.xml diff --git a/test/compass/landice/hydro-radial/1000m/restart_test/config_setup_mesh_step.xml b/testing_and_setup/compass/landice/hydro-radial/1000m/restart_test/config_setup_mesh_step.xml similarity index 100% rename from test/compass/landice/hydro-radial/1000m/restart_test/config_setup_mesh_step.xml rename to testing_and_setup/compass/landice/hydro-radial/1000m/restart_test/config_setup_mesh_step.xml diff --git a/test/compass/landice/hydro-radial/1000m/restart_test/output_comparison.xml b/testing_and_setup/compass/landice/hydro-radial/1000m/restart_test/output_comparison.xml similarity index 100% rename from test/compass/landice/hydro-radial/1000m/restart_test/output_comparison.xml rename to testing_and_setup/compass/landice/hydro-radial/1000m/restart_test/output_comparison.xml diff --git a/test/compass/landice/hydro-radial/1000m/spinup_test/config_driver.xml b/testing_and_setup/compass/landice/hydro-radial/1000m/spinup_test/config_driver.xml similarity index 100% rename from test/compass/landice/hydro-radial/1000m/spinup_test/config_driver.xml rename to testing_and_setup/compass/landice/hydro-radial/1000m/spinup_test/config_driver.xml diff --git a/test/compass/landice/hydro-radial/1000m/spinup_test/config_run_model_step.xml b/testing_and_setup/compass/landice/hydro-radial/1000m/spinup_test/config_run_model_step.xml similarity index 100% rename from test/compass/landice/hydro-radial/1000m/spinup_test/config_run_model_step.xml rename to testing_and_setup/compass/landice/hydro-radial/1000m/spinup_test/config_run_model_step.xml diff --git a/test/compass/landice/hydro-radial/1000m/spinup_test/config_setup_mesh_step.xml b/testing_and_setup/compass/landice/hydro-radial/1000m/spinup_test/config_setup_mesh_step.xml similarity index 100% rename from test/compass/landice/hydro-radial/1000m/spinup_test/config_setup_mesh_step.xml rename to testing_and_setup/compass/landice/hydro-radial/1000m/spinup_test/config_setup_mesh_step.xml diff --git a/test/compass/landice/hydro-radial/1000m/steady_state_drift_test/config_driver.xml b/testing_and_setup/compass/landice/hydro-radial/1000m/steady_state_drift_test/config_driver.xml similarity index 100% rename from test/compass/landice/hydro-radial/1000m/steady_state_drift_test/config_driver.xml rename to testing_and_setup/compass/landice/hydro-radial/1000m/steady_state_drift_test/config_driver.xml diff --git a/test/compass/landice/hydro-radial/1000m/steady_state_drift_test/config_run_model_step.xml b/testing_and_setup/compass/landice/hydro-radial/1000m/steady_state_drift_test/config_run_model_step.xml similarity index 100% rename from test/compass/landice/hydro-radial/1000m/steady_state_drift_test/config_run_model_step.xml rename to testing_and_setup/compass/landice/hydro-radial/1000m/steady_state_drift_test/config_run_model_step.xml diff --git a/test/compass/landice/hydro-radial/1000m/steady_state_drift_test/config_setup_mesh_step.xml b/testing_and_setup/compass/landice/hydro-radial/1000m/steady_state_drift_test/config_setup_mesh_step.xml similarity index 100% rename from test/compass/landice/hydro-radial/1000m/steady_state_drift_test/config_setup_mesh_step.xml rename to testing_and_setup/compass/landice/hydro-radial/1000m/steady_state_drift_test/config_setup_mesh_step.xml diff --git a/test/compass/landice/hydro-radial/README b/testing_and_setup/compass/landice/hydro-radial/README similarity index 100% rename from test/compass/landice/hydro-radial/README rename to testing_and_setup/compass/landice/hydro-radial/README diff --git a/test/compass/landice/hydro-radial/params.m b/testing_and_setup/compass/landice/hydro-radial/params.m similarity index 100% rename from test/compass/landice/hydro-radial/params.m rename to testing_and_setup/compass/landice/hydro-radial/params.m diff --git a/test/compass/landice/hydro-radial/plot_hydro-radial_profile.py b/testing_and_setup/compass/landice/hydro-radial/plot_hydro-radial_profile.py similarity index 100% rename from test/compass/landice/hydro-radial/plot_hydro-radial_profile.py rename to testing_and_setup/compass/landice/hydro-radial/plot_hydro-radial_profile.py diff --git a/test/compass/landice/hydro-radial/psteady.m b/testing_and_setup/compass/landice/hydro-radial/psteady.m similarity index 100% rename from test/compass/landice/hydro-radial/psteady.m rename to testing_and_setup/compass/landice/hydro-radial/psteady.m diff --git a/test/compass/landice/hydro-radial/radial_template.xml b/testing_and_setup/compass/landice/hydro-radial/radial_template.xml similarity index 100% rename from test/compass/landice/hydro-radial/radial_template.xml rename to testing_and_setup/compass/landice/hydro-radial/radial_template.xml diff --git a/test/compass/landice/hydro-radial/radialsteady.m b/testing_and_setup/compass/landice/hydro-radial/radialsteady.m similarity index 100% rename from test/compass/landice/hydro-radial/radialsteady.m rename to testing_and_setup/compass/landice/hydro-radial/radialsteady.m diff --git a/test/compass/landice/hydro-radial/setup_hydro-radial_initial_conditions.py b/testing_and_setup/compass/landice/hydro-radial/setup_hydro-radial_initial_conditions.py similarity index 100% rename from test/compass/landice/hydro-radial/setup_hydro-radial_initial_conditions.py rename to testing_and_setup/compass/landice/hydro-radial/setup_hydro-radial_initial_conditions.py diff --git a/test/compass/landice/hydro-radial/setup_mpas_radial_IC.m b/testing_and_setup/compass/landice/hydro-radial/setup_mpas_radial_IC.m similarity index 100% rename from test/compass/landice/hydro-radial/setup_mpas_radial_IC.m rename to testing_and_setup/compass/landice/hydro-radial/setup_mpas_radial_IC.m diff --git a/test/compass/landice/hydro-ramp/20000m/periodic_hex.namelist.input b/testing_and_setup/compass/landice/hydro-ramp/20000m/periodic_hex.namelist.input similarity index 100% rename from test/compass/landice/hydro-ramp/20000m/periodic_hex.namelist.input rename to testing_and_setup/compass/landice/hydro-ramp/20000m/periodic_hex.namelist.input diff --git a/test/compass/landice/hydro-ramp/20000m/ramp_20000m_template.xml b/testing_and_setup/compass/landice/hydro-ramp/20000m/ramp_20000m_template.xml similarity index 100% rename from test/compass/landice/hydro-ramp/20000m/ramp_20000m_template.xml rename to testing_and_setup/compass/landice/hydro-ramp/20000m/ramp_20000m_template.xml diff --git a/test/compass/landice/hydro-ramp/20000m/smoketest/config_driver.xml b/testing_and_setup/compass/landice/hydro-ramp/20000m/smoketest/config_driver.xml similarity index 100% rename from test/compass/landice/hydro-ramp/20000m/smoketest/config_driver.xml rename to testing_and_setup/compass/landice/hydro-ramp/20000m/smoketest/config_driver.xml diff --git a/test/compass/landice/hydro-ramp/20000m/smoketest/config_run_model_step.xml b/testing_and_setup/compass/landice/hydro-ramp/20000m/smoketest/config_run_model_step.xml similarity index 100% rename from test/compass/landice/hydro-ramp/20000m/smoketest/config_run_model_step.xml rename to testing_and_setup/compass/landice/hydro-ramp/20000m/smoketest/config_run_model_step.xml diff --git a/test/compass/landice/hydro-ramp/20000m/smoketest/config_setup_mesh_step.xml b/testing_and_setup/compass/landice/hydro-ramp/20000m/smoketest/config_setup_mesh_step.xml similarity index 100% rename from test/compass/landice/hydro-ramp/20000m/smoketest/config_setup_mesh_step.xml rename to testing_and_setup/compass/landice/hydro-ramp/20000m/smoketest/config_setup_mesh_step.xml diff --git a/test/compass/landice/hydro-ramp/plot_hydro-ramp_profile.py b/testing_and_setup/compass/landice/hydro-ramp/plot_hydro-ramp_profile.py similarity index 100% rename from test/compass/landice/hydro-ramp/plot_hydro-ramp_profile.py rename to testing_and_setup/compass/landice/hydro-ramp/plot_hydro-ramp_profile.py diff --git a/test/compass/landice/hydro-ramp/setup_hydro-ramp_initial_conditions.py b/testing_and_setup/compass/landice/hydro-ramp/setup_hydro-ramp_initial_conditions.py similarity index 100% rename from test/compass/landice/hydro-ramp/setup_hydro-ramp_initial_conditions.py rename to testing_and_setup/compass/landice/hydro-ramp/setup_hydro-ramp_initial_conditions.py diff --git a/test/compass/landice/hydro-shmip/convert_mpas_to_shmip.py b/testing_and_setup/compass/landice/hydro-shmip/convert_mpas_to_shmip.py similarity index 100% rename from test/compass/landice/hydro-shmip/convert_mpas_to_shmip.py rename to testing_and_setup/compass/landice/hydro-shmip/convert_mpas_to_shmip.py diff --git a/test/compass/landice/hydro-shmip/standard_resolution/README b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/README similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/README rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/README diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_driver.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_driver.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_driver.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_driver.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_experiment_A1.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_experiment_A1.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_experiment_A1.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_experiment_A1.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_experiment_A2.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_experiment_A2.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_experiment_A2.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_experiment_A2.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_experiment_A3.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_experiment_A3.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_experiment_A3.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_experiment_A3.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_experiment_A4.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_experiment_A4.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_experiment_A4.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_experiment_A4.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_experiment_A5.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_experiment_A5.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_experiment_A5.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_experiment_A5.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_experiment_A6.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_experiment_A6.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_experiment_A6.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_experiment_A6.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_setup_sqrt_mesh_step.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_setup_sqrt_mesh_step.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_setup_sqrt_mesh_step.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_A/config_setup_sqrt_mesh_step.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_A/setup_hydro-shmip_experimentA_initial_conditions.py b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_A/setup_hydro-shmip_experimentA_initial_conditions.py similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_A/setup_hydro-shmip_experimentA_initial_conditions.py rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_A/setup_hydro-shmip_experimentA_initial_conditions.py diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_B/config_driver.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_B/config_driver.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_B/config_driver.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_B/config_driver.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_B/config_experiment_B1.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_B/config_experiment_B1.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_B/config_experiment_B1.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_B/config_experiment_B1.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_B/config_experiment_B2.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_B/config_experiment_B2.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_B/config_experiment_B2.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_B/config_experiment_B2.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_B/config_experiment_B3.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_B/config_experiment_B3.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_B/config_experiment_B3.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_B/config_experiment_B3.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_B/config_experiment_B4.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_B/config_experiment_B4.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_B/config_experiment_B4.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_B/config_experiment_B4.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_B/config_experiment_B5.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_B/config_experiment_B5.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_B/config_experiment_B5.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_B/config_experiment_B5.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_B/setup_hydro-shmip_experimentB_initial_conditions.py b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_B/setup_hydro-shmip_experimentB_initial_conditions.py similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_B/setup_hydro-shmip_experimentB_initial_conditions.py rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_B/setup_hydro-shmip_experimentB_initial_conditions.py diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_C/config_driver.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_C/config_driver.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_C/config_driver.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_C/config_driver.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_C/config_experiment_C1.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_C/config_experiment_C1.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_C/config_experiment_C1.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_C/config_experiment_C1.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_C/config_experiment_C2.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_C/config_experiment_C2.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_C/config_experiment_C2.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_C/config_experiment_C2.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_C/config_experiment_C3.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_C/config_experiment_C3.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_C/config_experiment_C3.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_C/config_experiment_C3.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_C/config_experiment_C4.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_C/config_experiment_C4.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_C/config_experiment_C4.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_C/config_experiment_C4.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_C/setup_hydro-shmip_experimentC_initial_conditions.py b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_C/setup_hydro-shmip_experimentC_initial_conditions.py similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_C/setup_hydro-shmip_experimentC_initial_conditions.py rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_C/setup_hydro-shmip_experimentC_initial_conditions.py diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_D/config_driver.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_D/config_driver.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_D/config_driver.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_D/config_driver.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_D/config_experiment_D1.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_D/config_experiment_D1.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_D/config_experiment_D1.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_D/config_experiment_D1.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_D/config_experiment_D2.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_D/config_experiment_D2.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_D/config_experiment_D2.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_D/config_experiment_D2.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_D/config_experiment_D3.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_D/config_experiment_D3.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_D/config_experiment_D3.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_D/config_experiment_D3.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_D/config_experiment_D4.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_D/config_experiment_D4.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_D/config_experiment_D4.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_D/config_experiment_D4.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_D/config_experiment_D5.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_D/config_experiment_D5.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_D/config_experiment_D5.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_D/config_experiment_D5.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_D/setup_hydro-shmip_experimentD_initial_conditions.py b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_D/setup_hydro-shmip_experimentD_initial_conditions.py similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_D/setup_hydro-shmip_experimentD_initial_conditions.py rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_D/setup_hydro-shmip_experimentD_initial_conditions.py diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_E/config_driver.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_E/config_driver.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_E/config_driver.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_E/config_driver.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_E/config_experiment_E1.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_E/config_experiment_E1.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_E/config_experiment_E1.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_E/config_experiment_E1.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_E/config_setup_valley_mesh_step.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_E/config_setup_valley_mesh_step.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_E/config_setup_valley_mesh_step.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_E/config_setup_valley_mesh_step.xml diff --git a/test/compass/landice/hydro-shmip/standard_resolution/experiment_E/setup_hydro-shmip_experimentE_initial_conditions.py b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_E/setup_hydro-shmip_experimentE_initial_conditions.py similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/experiment_E/setup_hydro-shmip_experimentE_initial_conditions.py rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/experiment_E/setup_hydro-shmip_experimentE_initial_conditions.py diff --git a/test/compass/landice/hydro-shmip/standard_resolution/periodic_hex.namelist.input.sqrt b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/periodic_hex.namelist.input.sqrt similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/periodic_hex.namelist.input.sqrt rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/periodic_hex.namelist.input.sqrt diff --git a/test/compass/landice/hydro-shmip/standard_resolution/periodic_hex.namelist.input.sqrt.1km b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/periodic_hex.namelist.input.sqrt.1km similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/periodic_hex.namelist.input.sqrt.1km rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/periodic_hex.namelist.input.sqrt.1km diff --git a/test/compass/landice/hydro-shmip/standard_resolution/periodic_hex.namelist.input.sqrt.250m b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/periodic_hex.namelist.input.sqrt.250m similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/periodic_hex.namelist.input.sqrt.250m rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/periodic_hex.namelist.input.sqrt.250m diff --git a/test/compass/landice/hydro-shmip/standard_resolution/periodic_hex.namelist.input.sqrt.2km b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/periodic_hex.namelist.input.sqrt.2km similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/periodic_hex.namelist.input.sqrt.2km rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/periodic_hex.namelist.input.sqrt.2km diff --git a/test/compass/landice/hydro-shmip/standard_resolution/periodic_hex.namelist.input.sqrt.500m b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/periodic_hex.namelist.input.sqrt.500m similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/periodic_hex.namelist.input.sqrt.500m rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/periodic_hex.namelist.input.sqrt.500m diff --git a/test/compass/landice/hydro-shmip/standard_resolution/periodic_hex.namelist.input.valley b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/periodic_hex.namelist.input.valley similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/periodic_hex.namelist.input.valley rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/periodic_hex.namelist.input.valley diff --git a/test/compass/landice/hydro-shmip/standard_resolution/shmip_template.xml b/testing_and_setup/compass/landice/hydro-shmip/standard_resolution/shmip_template.xml similarity index 100% rename from test/compass/landice/hydro-shmip/standard_resolution/shmip_template.xml rename to testing_and_setup/compass/landice/hydro-shmip/standard_resolution/shmip_template.xml diff --git a/test/compass/landice/hydro-shmip/visualize_output_shmip.py b/testing_and_setup/compass/landice/hydro-shmip/visualize_output_shmip.py similarity index 100% rename from test/compass/landice/hydro-shmip/visualize_output_shmip.py rename to testing_and_setup/compass/landice/hydro-shmip/visualize_output_shmip.py diff --git a/test/compass/landice/hydro-shmip/visualize_output_shmip_C.py b/testing_and_setup/compass/landice/hydro-shmip/visualize_output_shmip_C.py similarity index 100% rename from test/compass/landice/hydro-shmip/visualize_output_shmip_C.py rename to testing_and_setup/compass/landice/hydro-shmip/visualize_output_shmip_C.py diff --git a/test/compass/landice/hydro-shmip/visualize_output_shmip_D.py b/testing_and_setup/compass/landice/hydro-shmip/visualize_output_shmip_D.py similarity index 100% rename from test/compass/landice/hydro-shmip/visualize_output_shmip_D.py rename to testing_and_setup/compass/landice/hydro-shmip/visualize_output_shmip_D.py diff --git a/test/compass/landice/initMIP-AIS/bmb/Test_evolve_temp_calving_uniformBasinK_new_Use1300RestartDirectly/namelist.landice b/testing_and_setup/compass/landice/initMIP-AIS/bmb/Test_evolve_temp_calving_uniformBasinK_new_Use1300RestartDirectly/namelist.landice similarity index 100% rename from test/compass/landice/initMIP-AIS/bmb/Test_evolve_temp_calving_uniformBasinK_new_Use1300RestartDirectly/namelist.landice rename to testing_and_setup/compass/landice/initMIP-AIS/bmb/Test_evolve_temp_calving_uniformBasinK_new_Use1300RestartDirectly/namelist.landice diff --git a/test/compass/landice/initMIP-AIS/bmb/Test_evolve_temp_restore_calving/namelist.landice b/testing_and_setup/compass/landice/initMIP-AIS/bmb/Test_evolve_temp_restore_calving/namelist.landice similarity index 100% rename from test/compass/landice/initMIP-AIS/bmb/Test_evolve_temp_restore_calving/namelist.landice rename to testing_and_setup/compass/landice/initMIP-AIS/bmb/Test_evolve_temp_restore_calving/namelist.landice diff --git a/test/compass/landice/initMIP-AIS/build_bmb_forcing.sh b/testing_and_setup/compass/landice/initMIP-AIS/build_bmb_forcing.sh similarity index 100% rename from test/compass/landice/initMIP-AIS/build_bmb_forcing.sh rename to testing_and_setup/compass/landice/initMIP-AIS/build_bmb_forcing.sh diff --git a/test/compass/landice/initMIP-AIS/build_smb_forcing.sh b/testing_and_setup/compass/landice/initMIP-AIS/build_smb_forcing.sh similarity index 100% rename from test/compass/landice/initMIP-AIS/build_smb_forcing.sh rename to testing_and_setup/compass/landice/initMIP-AIS/build_smb_forcing.sh diff --git a/test/compass/landice/initMIP-AIS/ctrl/Test_evolve_temp_calving_uniformBasinK_new_Use1300RestartDirectly/namelist.landice b/testing_and_setup/compass/landice/initMIP-AIS/ctrl/Test_evolve_temp_calving_uniformBasinK_new_Use1300RestartDirectly/namelist.landice similarity index 100% rename from test/compass/landice/initMIP-AIS/ctrl/Test_evolve_temp_calving_uniformBasinK_new_Use1300RestartDirectly/namelist.landice rename to testing_and_setup/compass/landice/initMIP-AIS/ctrl/Test_evolve_temp_calving_uniformBasinK_new_Use1300RestartDirectly/namelist.landice diff --git a/test/compass/landice/initMIP-AIS/ctrl/Test_evolve_temp_restore_calving/namelist.landice b/testing_and_setup/compass/landice/initMIP-AIS/ctrl/Test_evolve_temp_restore_calving/namelist.landice similarity index 100% rename from test/compass/landice/initMIP-AIS/ctrl/Test_evolve_temp_restore_calving/namelist.landice rename to testing_and_setup/compass/landice/initMIP-AIS/ctrl/Test_evolve_temp_restore_calving/namelist.landice diff --git a/test/compass/landice/initMIP-AIS/plot_globalStats.py b/testing_and_setup/compass/landice/initMIP-AIS/plot_globalStats.py similarity index 100% rename from test/compass/landice/initMIP-AIS/plot_globalStats.py rename to testing_and_setup/compass/landice/initMIP-AIS/plot_globalStats.py diff --git a/test/compass/landice/initMIP-AIS/plot_regionalStats.py b/testing_and_setup/compass/landice/initMIP-AIS/plot_regionalStats.py similarity index 100% rename from test/compass/landice/initMIP-AIS/plot_regionalStats.py rename to testing_and_setup/compass/landice/initMIP-AIS/plot_regionalStats.py diff --git a/test/compass/landice/initMIP-AIS/process_xtime.py b/testing_and_setup/compass/landice/initMIP-AIS/process_xtime.py similarity index 100% rename from test/compass/landice/initMIP-AIS/process_xtime.py rename to testing_and_setup/compass/landice/initMIP-AIS/process_xtime.py diff --git a/test/compass/landice/initMIP-AIS/spinup/calibrate_calving_parameter.py b/testing_and_setup/compass/landice/initMIP-AIS/spinup/calibrate_calving_parameter.py similarity index 100% rename from test/compass/landice/initMIP-AIS/spinup/calibrate_calving_parameter.py rename to testing_and_setup/compass/landice/initMIP-AIS/spinup/calibrate_calving_parameter.py diff --git a/test/compass/landice/initMIP-AIS/spinup/plot_stats_for_paper.py b/testing_and_setup/compass/landice/initMIP-AIS/spinup/plot_stats_for_paper.py similarity index 100% rename from test/compass/landice/initMIP-AIS/spinup/plot_stats_for_paper.py rename to testing_and_setup/compass/landice/initMIP-AIS/spinup/plot_stats_for_paper.py diff --git a/test/compass/landice/regression_suites/ho_integration_test_suite.xml b/testing_and_setup/compass/landice/regression_suites/ho_integration_test_suite.xml similarity index 100% rename from test/compass/landice/regression_suites/ho_integration_test_suite.xml rename to testing_and_setup/compass/landice/regression_suites/ho_integration_test_suite.xml diff --git a/test/compass/landice/regression_suites/standard_integration_test_suite.xml b/testing_and_setup/compass/landice/regression_suites/standard_integration_test_suite.xml similarity index 100% rename from test/compass/landice/regression_suites/standard_integration_test_suite.xml rename to testing_and_setup/compass/landice/regression_suites/standard_integration_test_suite.xml diff --git a/test/compass/list_testcases.py b/testing_and_setup/compass/list_testcases.py similarity index 100% rename from test/compass/list_testcases.py rename to testing_and_setup/compass/list_testcases.py diff --git a/test/compass/manage_regression_suite.py b/testing_and_setup/compass/manage_regression_suite.py similarity index 100% rename from test/compass/manage_regression_suite.py rename to testing_and_setup/compass/manage_regression_suite.py diff --git a/test/compass/ocean/baroclinic_channel/10km/baroclinic_channel_10km_template.xml b/testing_and_setup/compass/ocean/baroclinic_channel/10km/baroclinic_channel_10km_template.xml similarity index 100% rename from test/compass/ocean/baroclinic_channel/10km/baroclinic_channel_10km_template.xml rename to testing_and_setup/compass/ocean/baroclinic_channel/10km/baroclinic_channel_10km_template.xml diff --git a/test/compass/ocean/baroclinic_channel/10km/decomp_test/config_4proc_run.xml b/testing_and_setup/compass/ocean/baroclinic_channel/10km/decomp_test/config_4proc_run.xml similarity index 100% rename from test/compass/ocean/baroclinic_channel/10km/decomp_test/config_4proc_run.xml rename to testing_and_setup/compass/ocean/baroclinic_channel/10km/decomp_test/config_4proc_run.xml diff --git a/test/compass/ocean/baroclinic_channel/10km/decomp_test/config_8proc_run.xml b/testing_and_setup/compass/ocean/baroclinic_channel/10km/decomp_test/config_8proc_run.xml similarity index 100% rename from test/compass/ocean/baroclinic_channel/10km/decomp_test/config_8proc_run.xml rename to testing_and_setup/compass/ocean/baroclinic_channel/10km/decomp_test/config_8proc_run.xml diff --git a/test/compass/ocean/baroclinic_channel/10km/decomp_test/config_driver.xml b/testing_and_setup/compass/ocean/baroclinic_channel/10km/decomp_test/config_driver.xml similarity index 100% rename from test/compass/ocean/baroclinic_channel/10km/decomp_test/config_driver.xml rename to testing_and_setup/compass/ocean/baroclinic_channel/10km/decomp_test/config_driver.xml diff --git a/test/compass/ocean/baroclinic_channel/10km/decomp_test/config_init1.xml b/testing_and_setup/compass/ocean/baroclinic_channel/10km/decomp_test/config_init1.xml similarity index 100% rename from test/compass/ocean/baroclinic_channel/10km/decomp_test/config_init1.xml rename to testing_and_setup/compass/ocean/baroclinic_channel/10km/decomp_test/config_init1.xml diff --git a/test/compass/ocean/baroclinic_channel/10km/decomp_test/config_init2.xml b/testing_and_setup/compass/ocean/baroclinic_channel/10km/decomp_test/config_init2.xml similarity index 100% rename from test/compass/ocean/baroclinic_channel/10km/decomp_test/config_init2.xml rename to testing_and_setup/compass/ocean/baroclinic_channel/10km/decomp_test/config_init2.xml diff --git a/test/compass/ocean/baroclinic_channel/10km/default/config_driver.xml b/testing_and_setup/compass/ocean/baroclinic_channel/10km/default/config_driver.xml similarity index 100% rename from test/compass/ocean/baroclinic_channel/10km/default/config_driver.xml rename to testing_and_setup/compass/ocean/baroclinic_channel/10km/default/config_driver.xml diff --git a/test/compass/ocean/baroclinic_channel/10km/default/config_forward.xml b/testing_and_setup/compass/ocean/baroclinic_channel/10km/default/config_forward.xml similarity index 100% rename from test/compass/ocean/baroclinic_channel/10km/default/config_forward.xml rename to testing_and_setup/compass/ocean/baroclinic_channel/10km/default/config_forward.xml diff --git a/test/compass/ocean/baroclinic_channel/10km/default/config_init1.xml b/testing_and_setup/compass/ocean/baroclinic_channel/10km/default/config_init1.xml similarity index 100% rename from test/compass/ocean/baroclinic_channel/10km/default/config_init1.xml rename to testing_and_setup/compass/ocean/baroclinic_channel/10km/default/config_init1.xml diff --git a/test/compass/ocean/baroclinic_channel/10km/default/config_init2.xml b/testing_and_setup/compass/ocean/baroclinic_channel/10km/default/config_init2.xml similarity index 100% rename from test/compass/ocean/baroclinic_channel/10km/default/config_init2.xml rename to testing_and_setup/compass/ocean/baroclinic_channel/10km/default/config_init2.xml diff --git a/test/compass/ocean/baroclinic_channel/10km/restart_test/config_driver.xml b/testing_and_setup/compass/ocean/baroclinic_channel/10km/restart_test/config_driver.xml similarity index 100% rename from test/compass/ocean/baroclinic_channel/10km/restart_test/config_driver.xml rename to testing_and_setup/compass/ocean/baroclinic_channel/10km/restart_test/config_driver.xml diff --git a/test/compass/ocean/baroclinic_channel/10km/restart_test/config_full_run.xml b/testing_and_setup/compass/ocean/baroclinic_channel/10km/restart_test/config_full_run.xml similarity index 100% rename from test/compass/ocean/baroclinic_channel/10km/restart_test/config_full_run.xml rename to testing_and_setup/compass/ocean/baroclinic_channel/10km/restart_test/config_full_run.xml diff --git a/test/compass/ocean/baroclinic_channel/10km/restart_test/config_init1.xml b/testing_and_setup/compass/ocean/baroclinic_channel/10km/restart_test/config_init1.xml similarity index 100% rename from test/compass/ocean/baroclinic_channel/10km/restart_test/config_init1.xml rename to testing_and_setup/compass/ocean/baroclinic_channel/10km/restart_test/config_init1.xml diff --git a/test/compass/ocean/baroclinic_channel/10km/restart_test/config_init2.xml b/testing_and_setup/compass/ocean/baroclinic_channel/10km/restart_test/config_init2.xml similarity index 100% rename from test/compass/ocean/baroclinic_channel/10km/restart_test/config_init2.xml rename to testing_and_setup/compass/ocean/baroclinic_channel/10km/restart_test/config_init2.xml diff --git a/test/compass/ocean/baroclinic_channel/10km/restart_test/config_restart_run.xml b/testing_and_setup/compass/ocean/baroclinic_channel/10km/restart_test/config_restart_run.xml similarity index 100% rename from test/compass/ocean/baroclinic_channel/10km/restart_test/config_restart_run.xml rename to testing_and_setup/compass/ocean/baroclinic_channel/10km/restart_test/config_restart_run.xml diff --git a/test/compass/ocean/baroclinic_channel/10km/restart_test/restart_setup_template.xml b/testing_and_setup/compass/ocean/baroclinic_channel/10km/restart_test/restart_setup_template.xml similarity index 100% rename from test/compass/ocean/baroclinic_channel/10km/restart_test/restart_setup_template.xml rename to testing_and_setup/compass/ocean/baroclinic_channel/10km/restart_test/restart_setup_template.xml diff --git a/test/compass/ocean/baroclinic_channel/10km/threads_test/config_4proc_run.xml b/testing_and_setup/compass/ocean/baroclinic_channel/10km/threads_test/config_4proc_run.xml similarity index 100% rename from test/compass/ocean/baroclinic_channel/10km/threads_test/config_4proc_run.xml rename to testing_and_setup/compass/ocean/baroclinic_channel/10km/threads_test/config_4proc_run.xml diff --git a/test/compass/ocean/baroclinic_channel/10km/threads_test/config_8proc_run.xml b/testing_and_setup/compass/ocean/baroclinic_channel/10km/threads_test/config_8proc_run.xml similarity index 100% rename from test/compass/ocean/baroclinic_channel/10km/threads_test/config_8proc_run.xml rename to testing_and_setup/compass/ocean/baroclinic_channel/10km/threads_test/config_8proc_run.xml diff --git a/test/compass/ocean/baroclinic_channel/10km/threads_test/config_driver.xml b/testing_and_setup/compass/ocean/baroclinic_channel/10km/threads_test/config_driver.xml similarity index 100% rename from test/compass/ocean/baroclinic_channel/10km/threads_test/config_driver.xml rename to testing_and_setup/compass/ocean/baroclinic_channel/10km/threads_test/config_driver.xml diff --git a/test/compass/ocean/baroclinic_channel/10km/threads_test/config_init1.xml b/testing_and_setup/compass/ocean/baroclinic_channel/10km/threads_test/config_init1.xml similarity index 100% rename from test/compass/ocean/baroclinic_channel/10km/threads_test/config_init1.xml rename to testing_and_setup/compass/ocean/baroclinic_channel/10km/threads_test/config_init1.xml diff --git a/test/compass/ocean/baroclinic_channel/10km/threads_test/config_init2.xml b/testing_and_setup/compass/ocean/baroclinic_channel/10km/threads_test/config_init2.xml similarity index 100% rename from test/compass/ocean/baroclinic_channel/10km/threads_test/config_init2.xml rename to testing_and_setup/compass/ocean/baroclinic_channel/10km/threads_test/config_init2.xml diff --git a/test/compass/ocean/global_ocean/EC120to60/default/.gitignore b/testing_and_setup/compass/ocean/global_ocean/EC120to60/default/.gitignore similarity index 100% rename from test/compass/ocean/global_ocean/EC120to60/default/.gitignore rename to testing_and_setup/compass/ocean/global_ocean/EC120to60/default/.gitignore diff --git a/test/compass/ocean/global_ocean/EC120to60/default/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/EC120to60/default/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC120to60/default/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/EC120to60/default/config_driver.xml diff --git a/test/compass/ocean/global_ocean/EC120to60/default/config_forward.xml b/testing_and_setup/compass/ocean/global_ocean/EC120to60/default/config_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC120to60/default/config_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/EC120to60/default/config_forward.xml diff --git a/test/compass/ocean/global_ocean/EC120to60/default/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/EC120to60/default/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC120to60/default/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/EC120to60/default/config_init1.xml diff --git a/test/compass/ocean/global_ocean/EC120to60/default/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/EC120to60/default/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC120to60/default/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/EC120to60/default/config_init2.xml diff --git a/test/compass/ocean/global_ocean/EC120to60/spin_up/.gitignore b/testing_and_setup/compass/ocean/global_ocean/EC120to60/spin_up/.gitignore similarity index 100% rename from test/compass/ocean/global_ocean/EC120to60/spin_up/.gitignore rename to testing_and_setup/compass/ocean/global_ocean/EC120to60/spin_up/.gitignore diff --git a/test/compass/ocean/global_ocean/EC120to60/spin_up/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/EC120to60/spin_up/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC120to60/spin_up/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/EC120to60/spin_up/config_driver.xml diff --git a/test/compass/ocean/global_ocean/EC120to60/spin_up/config_forward.xml b/testing_and_setup/compass/ocean/global_ocean/EC120to60/spin_up/config_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC120to60/spin_up/config_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/EC120to60/spin_up/config_forward.xml diff --git a/test/compass/ocean/global_ocean/EC120to60/spin_up/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/EC120to60/spin_up/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC120to60/spin_up/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/EC120to60/spin_up/config_init1.xml diff --git a/test/compass/ocean/global_ocean/EC120to60/spin_up/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/EC120to60/spin_up/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC120to60/spin_up/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/EC120to60/spin_up/config_init2.xml diff --git a/test/compass/ocean/global_ocean/EC120to60/spin_up/config_spin_up1.xml b/testing_and_setup/compass/ocean/global_ocean/EC120to60/spin_up/config_spin_up1.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC120to60/spin_up/config_spin_up1.xml rename to testing_and_setup/compass/ocean/global_ocean/EC120to60/spin_up/config_spin_up1.xml diff --git a/test/compass/ocean/global_ocean/EC120to60/template_forward.xml b/testing_and_setup/compass/ocean/global_ocean/EC120to60/template_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC120to60/template_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/EC120to60/template_forward.xml diff --git a/test/compass/ocean/global_ocean/EC60to30/default/.gitignore b/testing_and_setup/compass/ocean/global_ocean/EC60to30/default/.gitignore similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/default/.gitignore rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/default/.gitignore diff --git a/test/compass/ocean/global_ocean/EC60to30/default/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/EC60to30/default/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/default/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/default/config_driver.xml diff --git a/test/compass/ocean/global_ocean/EC60to30/default/config_forward.xml b/testing_and_setup/compass/ocean/global_ocean/EC60to30/default/config_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/default/config_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/default/config_forward.xml diff --git a/test/compass/ocean/global_ocean/EC60to30/default/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/EC60to30/default/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/default/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/default/config_init1.xml diff --git a/test/compass/ocean/global_ocean/EC60to30/default/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/EC60to30/default/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/default/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/default/config_init2.xml diff --git a/test/compass/ocean/global_ocean/EC60to30/five_cell/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/EC60to30/five_cell/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/five_cell/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/five_cell/config_driver.xml diff --git a/test/compass/ocean/global_ocean/EC60to30/five_cell/config_forward.xml b/testing_and_setup/compass/ocean/global_ocean/EC60to30/five_cell/config_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/five_cell/config_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/five_cell/config_forward.xml diff --git a/test/compass/ocean/global_ocean/EC60to30/five_cell/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/EC60to30/five_cell/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/five_cell/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/five_cell/config_init1.xml diff --git a/test/compass/ocean/global_ocean/EC60to30/five_cell/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/EC60to30/five_cell/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/five_cell/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/five_cell/config_init2.xml diff --git a/test/compass/ocean/global_ocean/EC60to30/five_cell/land_coverage_5_cell.geojson b/testing_and_setup/compass/ocean/global_ocean/EC60to30/five_cell/land_coverage_5_cell.geojson similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/five_cell/land_coverage_5_cell.geojson rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/five_cell/land_coverage_5_cell.geojson diff --git a/test/compass/ocean/global_ocean/EC60to30/single_cell/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/EC60to30/single_cell/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/single_cell/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/single_cell/config_driver.xml diff --git a/test/compass/ocean/global_ocean/EC60to30/single_cell/config_forward.xml b/testing_and_setup/compass/ocean/global_ocean/EC60to30/single_cell/config_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/single_cell/config_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/single_cell/config_forward.xml diff --git a/test/compass/ocean/global_ocean/EC60to30/single_cell/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/EC60to30/single_cell/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/single_cell/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/single_cell/config_init1.xml diff --git a/test/compass/ocean/global_ocean/EC60to30/single_cell/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/EC60to30/single_cell/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/single_cell/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/single_cell/config_init2.xml diff --git a/test/compass/ocean/global_ocean/EC60to30/single_cell/land_coverage_1_cell.geojson b/testing_and_setup/compass/ocean/global_ocean/EC60to30/single_cell/land_coverage_1_cell.geojson similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/single_cell/land_coverage_1_cell.geojson rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/single_cell/land_coverage_1_cell.geojson diff --git a/test/compass/ocean/global_ocean/EC60to30/spin_up/.gitignore b/testing_and_setup/compass/ocean/global_ocean/EC60to30/spin_up/.gitignore similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/spin_up/.gitignore rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/spin_up/.gitignore diff --git a/test/compass/ocean/global_ocean/EC60to30/spin_up/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/EC60to30/spin_up/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/spin_up/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/spin_up/config_driver.xml diff --git a/test/compass/ocean/global_ocean/EC60to30/spin_up/config_forward.xml b/testing_and_setup/compass/ocean/global_ocean/EC60to30/spin_up/config_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/spin_up/config_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/spin_up/config_forward.xml diff --git a/test/compass/ocean/global_ocean/EC60to30/spin_up/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/EC60to30/spin_up/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/spin_up/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/spin_up/config_init1.xml diff --git a/test/compass/ocean/global_ocean/EC60to30/spin_up/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/EC60to30/spin_up/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/spin_up/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/spin_up/config_init2.xml diff --git a/test/compass/ocean/global_ocean/EC60to30/spin_up/config_spin_up1.xml b/testing_and_setup/compass/ocean/global_ocean/EC60to30/spin_up/config_spin_up1.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/spin_up/config_spin_up1.xml rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/spin_up/config_spin_up1.xml diff --git a/test/compass/ocean/global_ocean/EC60to30/template_forward.xml b/testing_and_setup/compass/ocean/global_ocean/EC60to30/template_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/template_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/template_forward.xml diff --git a/test/compass/ocean/global_ocean/EC60to30/with_land_ice/.gitignore b/testing_and_setup/compass/ocean/global_ocean/EC60to30/with_land_ice/.gitignore similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/with_land_ice/.gitignore rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/with_land_ice/.gitignore diff --git a/test/compass/ocean/global_ocean/EC60to30/with_land_ice/config_adjust_ssh.xml b/testing_and_setup/compass/ocean/global_ocean/EC60to30/with_land_ice/config_adjust_ssh.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/with_land_ice/config_adjust_ssh.xml rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/with_land_ice/config_adjust_ssh.xml diff --git a/test/compass/ocean/global_ocean/EC60to30/with_land_ice/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/EC60to30/with_land_ice/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/with_land_ice/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/with_land_ice/config_driver.xml diff --git a/test/compass/ocean/global_ocean/EC60to30/with_land_ice/config_forward.xml b/testing_and_setup/compass/ocean/global_ocean/EC60to30/with_land_ice/config_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/with_land_ice/config_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/with_land_ice/config_forward.xml diff --git a/test/compass/ocean/global_ocean/EC60to30/with_land_ice/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/EC60to30/with_land_ice/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/with_land_ice/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/with_land_ice/config_init1.xml diff --git a/test/compass/ocean/global_ocean/EC60to30/with_land_ice/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/EC60to30/with_land_ice/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/with_land_ice/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/with_land_ice/config_init2.xml diff --git a/test/compass/ocean/global_ocean/EC60to30/with_land_ice/config_init2_smoothed.xml b/testing_and_setup/compass/ocean/global_ocean/EC60to30/with_land_ice/config_init2_smoothed.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/with_land_ice/config_init2_smoothed.xml rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/with_land_ice/config_init2_smoothed.xml diff --git a/test/compass/ocean/global_ocean/EC60to30/with_land_ice/config_spin_up1.xml b/testing_and_setup/compass/ocean/global_ocean/EC60to30/with_land_ice/config_spin_up1.xml similarity index 100% rename from test/compass/ocean/global_ocean/EC60to30/with_land_ice/config_spin_up1.xml rename to testing_and_setup/compass/ocean/global_ocean/EC60to30/with_land_ice/config_spin_up1.xml diff --git a/test/compass/ocean/global_ocean/QU120/default/.gitignore b/testing_and_setup/compass/ocean/global_ocean/QU120/default/.gitignore similarity index 100% rename from test/compass/ocean/global_ocean/QU120/default/.gitignore rename to testing_and_setup/compass/ocean/global_ocean/QU120/default/.gitignore diff --git a/test/compass/ocean/global_ocean/QU120/default/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/QU120/default/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU120/default/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/QU120/default/config_driver.xml diff --git a/test/compass/ocean/global_ocean/QU120/default/config_forward.xml b/testing_and_setup/compass/ocean/global_ocean/QU120/default/config_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU120/default/config_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/QU120/default/config_forward.xml diff --git a/test/compass/ocean/global_ocean/QU120/default/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/QU120/default/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU120/default/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/QU120/default/config_init1.xml diff --git a/test/compass/ocean/global_ocean/QU120/default/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/QU120/default/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU120/default/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/QU120/default/config_init2.xml diff --git a/test/compass/ocean/global_ocean/QU120/ecosys_60_layer/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/QU120/ecosys_60_layer/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU120/ecosys_60_layer/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/QU120/ecosys_60_layer/config_driver.xml diff --git a/test/compass/ocean/global_ocean/QU120/ecosys_60_layer/config_forward.xml b/testing_and_setup/compass/ocean/global_ocean/QU120/ecosys_60_layer/config_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU120/ecosys_60_layer/config_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/QU120/ecosys_60_layer/config_forward.xml diff --git a/test/compass/ocean/global_ocean/QU120/ecosys_60_layer/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/QU120/ecosys_60_layer/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU120/ecosys_60_layer/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/QU120/ecosys_60_layer/config_init1.xml diff --git a/test/compass/ocean/global_ocean/QU120/ecosys_60_layer/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/QU120/ecosys_60_layer/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU120/ecosys_60_layer/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/QU120/ecosys_60_layer/config_init2.xml diff --git a/test/compass/ocean/global_ocean/QU120/template_forward.xml b/testing_and_setup/compass/ocean/global_ocean/QU120/template_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU120/template_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/QU120/template_forward.xml diff --git a/test/compass/ocean/global_ocean/QU120/with_land_ice/.gitignore b/testing_and_setup/compass/ocean/global_ocean/QU120/with_land_ice/.gitignore similarity index 100% rename from test/compass/ocean/global_ocean/QU120/with_land_ice/.gitignore rename to testing_and_setup/compass/ocean/global_ocean/QU120/with_land_ice/.gitignore diff --git a/test/compass/ocean/global_ocean/QU120/with_land_ice/config_adjust_ssh.xml b/testing_and_setup/compass/ocean/global_ocean/QU120/with_land_ice/config_adjust_ssh.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU120/with_land_ice/config_adjust_ssh.xml rename to testing_and_setup/compass/ocean/global_ocean/QU120/with_land_ice/config_adjust_ssh.xml diff --git a/test/compass/ocean/global_ocean/QU120/with_land_ice/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/QU120/with_land_ice/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU120/with_land_ice/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/QU120/with_land_ice/config_driver.xml diff --git a/test/compass/ocean/global_ocean/QU120/with_land_ice/config_forward.xml b/testing_and_setup/compass/ocean/global_ocean/QU120/with_land_ice/config_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU120/with_land_ice/config_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/QU120/with_land_ice/config_forward.xml diff --git a/test/compass/ocean/global_ocean/QU120/with_land_ice/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/QU120/with_land_ice/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU120/with_land_ice/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/QU120/with_land_ice/config_init1.xml diff --git a/test/compass/ocean/global_ocean/QU120/with_land_ice/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/QU120/with_land_ice/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU120/with_land_ice/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/QU120/with_land_ice/config_init2.xml diff --git a/test/compass/ocean/global_ocean/QU240/analysis_test/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/analysis_test/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/analysis_test/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/analysis_test/config_driver.xml diff --git a/test/compass/ocean/global_ocean/QU240/analysis_test/config_forward.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/analysis_test/config_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/analysis_test/config_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/analysis_test/config_forward.xml diff --git a/test/compass/ocean/global_ocean/QU240/analysis_test/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/analysis_test/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/analysis_test/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/analysis_test/config_init1.xml diff --git a/test/compass/ocean/global_ocean/QU240/analysis_test/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/analysis_test/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/analysis_test/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/analysis_test/config_init2.xml diff --git a/test/compass/ocean/global_ocean/QU240/default/.gitignore b/testing_and_setup/compass/ocean/global_ocean/QU240/default/.gitignore similarity index 100% rename from test/compass/ocean/global_ocean/QU240/default/.gitignore rename to testing_and_setup/compass/ocean/global_ocean/QU240/default/.gitignore diff --git a/test/compass/ocean/global_ocean/QU240/default/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/default/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/default/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/default/config_driver.xml diff --git a/test/compass/ocean/global_ocean/QU240/default/config_forward.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/default/config_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/default/config_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/default/config_forward.xml diff --git a/test/compass/ocean/global_ocean/QU240/default/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/default/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/default/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/default/config_init1.xml diff --git a/test/compass/ocean/global_ocean/QU240/default/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/default/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/default/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/default/config_init2.xml diff --git a/test/compass/ocean/global_ocean/QU240/performance_test/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/performance_test/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/performance_test/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/performance_test/config_driver.xml diff --git a/test/compass/ocean/global_ocean/QU240/performance_test/config_forward.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/performance_test/config_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/performance_test/config_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/performance_test/config_forward.xml diff --git a/test/compass/ocean/global_ocean/QU240/performance_test/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/performance_test/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/performance_test/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/performance_test/config_init1.xml diff --git a/test/compass/ocean/global_ocean/QU240/performance_test/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/performance_test/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/performance_test/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/performance_test/config_init2.xml diff --git a/test/compass/ocean/global_ocean/QU240/restart_test/.gitignore b/testing_and_setup/compass/ocean/global_ocean/QU240/restart_test/.gitignore similarity index 100% rename from test/compass/ocean/global_ocean/QU240/restart_test/.gitignore rename to testing_and_setup/compass/ocean/global_ocean/QU240/restart_test/.gitignore diff --git a/test/compass/ocean/global_ocean/QU240/restart_test/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/restart_test/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/restart_test/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/restart_test/config_driver.xml diff --git a/test/compass/ocean/global_ocean/QU240/restart_test/config_full_run.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/restart_test/config_full_run.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/restart_test/config_full_run.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/restart_test/config_full_run.xml diff --git a/test/compass/ocean/global_ocean/QU240/restart_test/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/restart_test/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/restart_test/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/restart_test/config_init1.xml diff --git a/test/compass/ocean/global_ocean/QU240/restart_test/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/restart_test/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/restart_test/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/restart_test/config_init2.xml diff --git a/test/compass/ocean/global_ocean/QU240/restart_test/config_restart_run.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/restart_test/config_restart_run.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/restart_test/config_restart_run.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/restart_test/config_restart_run.xml diff --git a/test/compass/ocean/global_ocean/QU240/restart_test/restart_setup_template.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/restart_test/restart_setup_template.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/restart_test/restart_setup_template.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/restart_test/restart_setup_template.xml diff --git a/test/compass/ocean/global_ocean/QU240/rk4_blocks_test/.gitignore b/testing_and_setup/compass/ocean/global_ocean/QU240/rk4_blocks_test/.gitignore similarity index 100% rename from test/compass/ocean/global_ocean/QU240/rk4_blocks_test/.gitignore rename to testing_and_setup/compass/ocean/global_ocean/QU240/rk4_blocks_test/.gitignore diff --git a/test/compass/ocean/global_ocean/QU240/rk4_blocks_test/config_4blocks_run.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/rk4_blocks_test/config_4blocks_run.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/rk4_blocks_test/config_4blocks_run.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/rk4_blocks_test/config_4blocks_run.xml diff --git a/test/compass/ocean/global_ocean/QU240/rk4_blocks_test/config_8blocks_run.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/rk4_blocks_test/config_8blocks_run.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/rk4_blocks_test/config_8blocks_run.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/rk4_blocks_test/config_8blocks_run.xml diff --git a/test/compass/ocean/global_ocean/QU240/rk4_blocks_test/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/rk4_blocks_test/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/rk4_blocks_test/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/rk4_blocks_test/config_driver.xml diff --git a/test/compass/ocean/global_ocean/QU240/rk4_blocks_test/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/rk4_blocks_test/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/rk4_blocks_test/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/rk4_blocks_test/config_init1.xml diff --git a/test/compass/ocean/global_ocean/QU240/rk4_blocks_test/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/rk4_blocks_test/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/rk4_blocks_test/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/rk4_blocks_test/config_init2.xml diff --git a/test/compass/ocean/global_ocean/QU240/se_blocks_test/.gitignore b/testing_and_setup/compass/ocean/global_ocean/QU240/se_blocks_test/.gitignore similarity index 100% rename from test/compass/ocean/global_ocean/QU240/se_blocks_test/.gitignore rename to testing_and_setup/compass/ocean/global_ocean/QU240/se_blocks_test/.gitignore diff --git a/test/compass/ocean/global_ocean/QU240/se_blocks_test/config_4blocks_run.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/se_blocks_test/config_4blocks_run.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/se_blocks_test/config_4blocks_run.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/se_blocks_test/config_4blocks_run.xml diff --git a/test/compass/ocean/global_ocean/QU240/se_blocks_test/config_8blocks_run.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/se_blocks_test/config_8blocks_run.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/se_blocks_test/config_8blocks_run.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/se_blocks_test/config_8blocks_run.xml diff --git a/test/compass/ocean/global_ocean/QU240/se_blocks_test/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/se_blocks_test/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/se_blocks_test/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/se_blocks_test/config_driver.xml diff --git a/test/compass/ocean/global_ocean/QU240/se_blocks_test/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/se_blocks_test/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/se_blocks_test/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/se_blocks_test/config_init1.xml diff --git a/test/compass/ocean/global_ocean/QU240/se_blocks_test/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/se_blocks_test/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/se_blocks_test/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/se_blocks_test/config_init2.xml diff --git a/test/compass/ocean/global_ocean/QU240/template_forward.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/template_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/template_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/template_forward.xml diff --git a/test/compass/ocean/global_ocean/QU240/with_land_ice/config_adjust_ssh.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/with_land_ice/config_adjust_ssh.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/with_land_ice/config_adjust_ssh.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/with_land_ice/config_adjust_ssh.xml diff --git a/test/compass/ocean/global_ocean/QU240/with_land_ice/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/with_land_ice/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/with_land_ice/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/with_land_ice/config_driver.xml diff --git a/test/compass/ocean/global_ocean/QU240/with_land_ice/config_forward.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/with_land_ice/config_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/with_land_ice/config_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/with_land_ice/config_forward.xml diff --git a/test/compass/ocean/global_ocean/QU240/with_land_ice/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/with_land_ice/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/with_land_ice/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/with_land_ice/config_init1.xml diff --git a/test/compass/ocean/global_ocean/QU240/with_land_ice/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/with_land_ice/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/with_land_ice/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/with_land_ice/config_init2.xml diff --git a/test/compass/ocean/global_ocean/QU240/with_land_ice_no_iter/.gitignore b/testing_and_setup/compass/ocean/global_ocean/QU240/with_land_ice_no_iter/.gitignore similarity index 100% rename from test/compass/ocean/global_ocean/QU240/with_land_ice_no_iter/.gitignore rename to testing_and_setup/compass/ocean/global_ocean/QU240/with_land_ice_no_iter/.gitignore diff --git a/test/compass/ocean/global_ocean/QU240/with_land_ice_no_iter/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/with_land_ice_no_iter/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/with_land_ice_no_iter/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/with_land_ice_no_iter/config_driver.xml diff --git a/test/compass/ocean/global_ocean/QU240/with_land_ice_no_iter/config_forward.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/with_land_ice_no_iter/config_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/with_land_ice_no_iter/config_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/with_land_ice_no_iter/config_forward.xml diff --git a/test/compass/ocean/global_ocean/QU240/with_land_ice_no_iter/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/with_land_ice_no_iter/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/with_land_ice_no_iter/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/with_land_ice_no_iter/config_init1.xml diff --git a/test/compass/ocean/global_ocean/QU240/with_land_ice_no_iter/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/with_land_ice_no_iter/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/with_land_ice_no_iter/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/with_land_ice_no_iter/config_init2.xml diff --git a/test/compass/ocean/global_ocean/QU240/zstar_128_layers/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/zstar_128_layers/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/zstar_128_layers/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/zstar_128_layers/config_driver.xml diff --git a/test/compass/ocean/global_ocean/QU240/zstar_128_layers/config_forward.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/zstar_128_layers/config_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/zstar_128_layers/config_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/zstar_128_layers/config_forward.xml diff --git a/test/compass/ocean/global_ocean/QU240/zstar_128_layers/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/zstar_128_layers/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/zstar_128_layers/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/zstar_128_layers/config_init1.xml diff --git a/test/compass/ocean/global_ocean/QU240/zstar_128_layers/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/QU240/zstar_128_layers/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU240/zstar_128_layers/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/QU240/zstar_128_layers/config_init2.xml diff --git a/test/compass/ocean/global_ocean/QU480/default/.gitignore b/testing_and_setup/compass/ocean/global_ocean/QU480/default/.gitignore similarity index 100% rename from test/compass/ocean/global_ocean/QU480/default/.gitignore rename to testing_and_setup/compass/ocean/global_ocean/QU480/default/.gitignore diff --git a/test/compass/ocean/global_ocean/QU480/default/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/QU480/default/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU480/default/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/QU480/default/config_driver.xml diff --git a/test/compass/ocean/global_ocean/QU480/default/config_forward.xml b/testing_and_setup/compass/ocean/global_ocean/QU480/default/config_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU480/default/config_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/QU480/default/config_forward.xml diff --git a/test/compass/ocean/global_ocean/QU480/default/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/QU480/default/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU480/default/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/QU480/default/config_init1.xml diff --git a/test/compass/ocean/global_ocean/QU480/default/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/QU480/default/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU480/default/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/QU480/default/config_init2.xml diff --git a/test/compass/ocean/global_ocean/QU480/template_forward.xml b/testing_and_setup/compass/ocean/global_ocean/QU480/template_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/QU480/template_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/QU480/template_forward.xml diff --git a/test/compass/ocean/global_ocean/RRS15to5/default/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/RRS15to5/default/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS15to5/default/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS15to5/default/config_driver.xml diff --git a/test/compass/ocean/global_ocean/RRS15to5/default/config_forward.xml b/testing_and_setup/compass/ocean/global_ocean/RRS15to5/default/config_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS15to5/default/config_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS15to5/default/config_forward.xml diff --git a/test/compass/ocean/global_ocean/RRS15to5/default/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/RRS15to5/default/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS15to5/default/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS15to5/default/config_init1.xml diff --git a/test/compass/ocean/global_ocean/RRS15to5/default/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/RRS15to5/default/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS15to5/default/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS15to5/default/config_init2.xml diff --git a/test/compass/ocean/global_ocean/RRS15to5/spin_up/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/RRS15to5/spin_up/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS15to5/spin_up/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS15to5/spin_up/config_driver.xml diff --git a/test/compass/ocean/global_ocean/RRS15to5/spin_up/config_forward.xml b/testing_and_setup/compass/ocean/global_ocean/RRS15to5/spin_up/config_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS15to5/spin_up/config_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS15to5/spin_up/config_forward.xml diff --git a/test/compass/ocean/global_ocean/RRS15to5/spin_up/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/RRS15to5/spin_up/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS15to5/spin_up/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS15to5/spin_up/config_init1.xml diff --git a/test/compass/ocean/global_ocean/RRS15to5/spin_up/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/RRS15to5/spin_up/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS15to5/spin_up/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS15to5/spin_up/config_init2.xml diff --git a/test/compass/ocean/global_ocean/RRS15to5/spin_up/config_spin_up1.xml b/testing_and_setup/compass/ocean/global_ocean/RRS15to5/spin_up/config_spin_up1.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS15to5/spin_up/config_spin_up1.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS15to5/spin_up/config_spin_up1.xml diff --git a/test/compass/ocean/global_ocean/RRS15to5/spin_up/config_spin_up2.xml b/testing_and_setup/compass/ocean/global_ocean/RRS15to5/spin_up/config_spin_up2.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS15to5/spin_up/config_spin_up2.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS15to5/spin_up/config_spin_up2.xml diff --git a/test/compass/ocean/global_ocean/RRS15to5/spin_up/config_spin_up3.xml b/testing_and_setup/compass/ocean/global_ocean/RRS15to5/spin_up/config_spin_up3.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS15to5/spin_up/config_spin_up3.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS15to5/spin_up/config_spin_up3.xml diff --git a/test/compass/ocean/global_ocean/RRS15to5/spin_up/config_spin_up4.xml b/testing_and_setup/compass/ocean/global_ocean/RRS15to5/spin_up/config_spin_up4.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS15to5/spin_up/config_spin_up4.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS15to5/spin_up/config_spin_up4.xml diff --git a/test/compass/ocean/global_ocean/RRS15to5/template_forward.xml b/testing_and_setup/compass/ocean/global_ocean/RRS15to5/template_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS15to5/template_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS15to5/template_forward.xml diff --git a/test/compass/ocean/global_ocean/RRS18to6/default/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/RRS18to6/default/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS18to6/default/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS18to6/default/config_driver.xml diff --git a/test/compass/ocean/global_ocean/RRS18to6/default/config_forward.xml b/testing_and_setup/compass/ocean/global_ocean/RRS18to6/default/config_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS18to6/default/config_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS18to6/default/config_forward.xml diff --git a/test/compass/ocean/global_ocean/RRS18to6/default/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/RRS18to6/default/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS18to6/default/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS18to6/default/config_init1.xml diff --git a/test/compass/ocean/global_ocean/RRS18to6/default/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/RRS18to6/default/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS18to6/default/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS18to6/default/config_init2.xml diff --git a/test/compass/ocean/global_ocean/RRS18to6/spin_up/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/RRS18to6/spin_up/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS18to6/spin_up/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS18to6/spin_up/config_driver.xml diff --git a/test/compass/ocean/global_ocean/RRS18to6/spin_up/config_forward.xml b/testing_and_setup/compass/ocean/global_ocean/RRS18to6/spin_up/config_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS18to6/spin_up/config_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS18to6/spin_up/config_forward.xml diff --git a/test/compass/ocean/global_ocean/RRS18to6/spin_up/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/RRS18to6/spin_up/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS18to6/spin_up/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS18to6/spin_up/config_init1.xml diff --git a/test/compass/ocean/global_ocean/RRS18to6/spin_up/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/RRS18to6/spin_up/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS18to6/spin_up/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS18to6/spin_up/config_init2.xml diff --git a/test/compass/ocean/global_ocean/RRS18to6/spin_up/config_spin_up1.xml b/testing_and_setup/compass/ocean/global_ocean/RRS18to6/spin_up/config_spin_up1.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS18to6/spin_up/config_spin_up1.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS18to6/spin_up/config_spin_up1.xml diff --git a/test/compass/ocean/global_ocean/RRS18to6/spin_up/config_spin_up2.xml b/testing_and_setup/compass/ocean/global_ocean/RRS18to6/spin_up/config_spin_up2.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS18to6/spin_up/config_spin_up2.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS18to6/spin_up/config_spin_up2.xml diff --git a/test/compass/ocean/global_ocean/RRS18to6/spin_up/config_spin_up3.xml b/testing_and_setup/compass/ocean/global_ocean/RRS18to6/spin_up/config_spin_up3.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS18to6/spin_up/config_spin_up3.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS18to6/spin_up/config_spin_up3.xml diff --git a/test/compass/ocean/global_ocean/RRS18to6/spin_up/config_spin_up4.xml b/testing_and_setup/compass/ocean/global_ocean/RRS18to6/spin_up/config_spin_up4.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS18to6/spin_up/config_spin_up4.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS18to6/spin_up/config_spin_up4.xml diff --git a/test/compass/ocean/global_ocean/RRS18to6/template_forward.xml b/testing_and_setup/compass/ocean/global_ocean/RRS18to6/template_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS18to6/template_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS18to6/template_forward.xml diff --git a/test/compass/ocean/global_ocean/RRS30to10/default/.gitignore b/testing_and_setup/compass/ocean/global_ocean/RRS30to10/default/.gitignore similarity index 100% rename from test/compass/ocean/global_ocean/RRS30to10/default/.gitignore rename to testing_and_setup/compass/ocean/global_ocean/RRS30to10/default/.gitignore diff --git a/test/compass/ocean/global_ocean/RRS30to10/default/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/RRS30to10/default/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS30to10/default/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS30to10/default/config_driver.xml diff --git a/test/compass/ocean/global_ocean/RRS30to10/default/config_forward.xml b/testing_and_setup/compass/ocean/global_ocean/RRS30to10/default/config_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS30to10/default/config_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS30to10/default/config_forward.xml diff --git a/test/compass/ocean/global_ocean/RRS30to10/default/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/RRS30to10/default/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS30to10/default/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS30to10/default/config_init1.xml diff --git a/test/compass/ocean/global_ocean/RRS30to10/default/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/RRS30to10/default/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS30to10/default/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS30to10/default/config_init2.xml diff --git a/test/compass/ocean/global_ocean/RRS30to10/spin_up/.gitignore b/testing_and_setup/compass/ocean/global_ocean/RRS30to10/spin_up/.gitignore similarity index 100% rename from test/compass/ocean/global_ocean/RRS30to10/spin_up/.gitignore rename to testing_and_setup/compass/ocean/global_ocean/RRS30to10/spin_up/.gitignore diff --git a/test/compass/ocean/global_ocean/RRS30to10/spin_up/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/RRS30to10/spin_up/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS30to10/spin_up/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS30to10/spin_up/config_driver.xml diff --git a/test/compass/ocean/global_ocean/RRS30to10/spin_up/config_forward.xml b/testing_and_setup/compass/ocean/global_ocean/RRS30to10/spin_up/config_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS30to10/spin_up/config_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS30to10/spin_up/config_forward.xml diff --git a/test/compass/ocean/global_ocean/RRS30to10/spin_up/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/RRS30to10/spin_up/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS30to10/spin_up/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS30to10/spin_up/config_init1.xml diff --git a/test/compass/ocean/global_ocean/RRS30to10/spin_up/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/RRS30to10/spin_up/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS30to10/spin_up/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS30to10/spin_up/config_init2.xml diff --git a/test/compass/ocean/global_ocean/RRS30to10/spin_up/config_spin_up1.xml b/testing_and_setup/compass/ocean/global_ocean/RRS30to10/spin_up/config_spin_up1.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS30to10/spin_up/config_spin_up1.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS30to10/spin_up/config_spin_up1.xml diff --git a/test/compass/ocean/global_ocean/RRS30to10/spin_up/config_spin_up2.xml b/testing_and_setup/compass/ocean/global_ocean/RRS30to10/spin_up/config_spin_up2.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS30to10/spin_up/config_spin_up2.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS30to10/spin_up/config_spin_up2.xml diff --git a/test/compass/ocean/global_ocean/RRS30to10/spin_up/config_spin_up3.xml b/testing_and_setup/compass/ocean/global_ocean/RRS30to10/spin_up/config_spin_up3.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS30to10/spin_up/config_spin_up3.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS30to10/spin_up/config_spin_up3.xml diff --git a/test/compass/ocean/global_ocean/RRS30to10/spin_up/config_spin_up4.xml b/testing_and_setup/compass/ocean/global_ocean/RRS30to10/spin_up/config_spin_up4.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS30to10/spin_up/config_spin_up4.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS30to10/spin_up/config_spin_up4.xml diff --git a/test/compass/ocean/global_ocean/RRS30to10/template_forward.xml b/testing_and_setup/compass/ocean/global_ocean/RRS30to10/template_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS30to10/template_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS30to10/template_forward.xml diff --git a/test/compass/ocean/global_ocean/RRS30to10/with_land_ice/.gitignore b/testing_and_setup/compass/ocean/global_ocean/RRS30to10/with_land_ice/.gitignore similarity index 100% rename from test/compass/ocean/global_ocean/RRS30to10/with_land_ice/.gitignore rename to testing_and_setup/compass/ocean/global_ocean/RRS30to10/with_land_ice/.gitignore diff --git a/test/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_adjust_ssh.xml b/testing_and_setup/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_adjust_ssh.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_adjust_ssh.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_adjust_ssh.xml diff --git a/test/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_driver.xml b/testing_and_setup/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_driver.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_driver.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_driver.xml diff --git a/test/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_forward.xml b/testing_and_setup/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_forward.xml diff --git a/test/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_init1.xml b/testing_and_setup/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_init1.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_init1.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_init1.xml diff --git a/test/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_init2.xml b/testing_and_setup/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_init2.xml diff --git a/test/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_spin_up1.xml b/testing_and_setup/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_spin_up1.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_spin_up1.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_spin_up1.xml diff --git a/test/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_spin_up2.xml b/testing_and_setup/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_spin_up2.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_spin_up2.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_spin_up2.xml diff --git a/test/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_spin_up3.xml b/testing_and_setup/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_spin_up3.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_spin_up3.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_spin_up3.xml diff --git a/test/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_spin_up4.xml b/testing_and_setup/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_spin_up4.xml similarity index 100% rename from test/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_spin_up4.xml rename to testing_and_setup/compass/ocean/global_ocean/RRS30to10/with_land_ice/config_spin_up4.xml diff --git a/test/compass/ocean/global_ocean/init_step1.py b/testing_and_setup/compass/ocean/global_ocean/init_step1.py similarity index 100% rename from test/compass/ocean/global_ocean/init_step1.py rename to testing_and_setup/compass/ocean/global_ocean/init_step1.py diff --git a/test/compass/ocean/global_ocean/template_adjust_ssh.xml b/testing_and_setup/compass/ocean/global_ocean/template_adjust_ssh.xml similarity index 100% rename from test/compass/ocean/global_ocean/template_adjust_ssh.xml rename to testing_and_setup/compass/ocean/global_ocean/template_adjust_ssh.xml diff --git a/test/compass/ocean/global_ocean/template_critical_passages.xml b/testing_and_setup/compass/ocean/global_ocean/template_critical_passages.xml similarity index 100% rename from test/compass/ocean/global_ocean/template_critical_passages.xml rename to testing_and_setup/compass/ocean/global_ocean/template_critical_passages.xml diff --git a/test/compass/ocean/global_ocean/template_forward.xml b/testing_and_setup/compass/ocean/global_ocean/template_forward.xml similarity index 100% rename from test/compass/ocean/global_ocean/template_forward.xml rename to testing_and_setup/compass/ocean/global_ocean/template_forward.xml diff --git a/test/compass/ocean/global_ocean/template_init2.xml b/testing_and_setup/compass/ocean/global_ocean/template_init2.xml similarity index 100% rename from test/compass/ocean/global_ocean/template_init2.xml rename to testing_and_setup/compass/ocean/global_ocean/template_init2.xml diff --git a/test/compass/ocean/global_ocean/template_init_with_land_ice.xml b/testing_and_setup/compass/ocean/global_ocean/template_init_with_land_ice.xml similarity index 100% rename from test/compass/ocean/global_ocean/template_init_with_land_ice.xml rename to testing_and_setup/compass/ocean/global_ocean/template_init_with_land_ice.xml diff --git a/test/compass/ocean/internal_waves/5km/default/config_driver.xml b/testing_and_setup/compass/ocean/internal_waves/5km/default/config_driver.xml similarity index 100% rename from test/compass/ocean/internal_waves/5km/default/config_driver.xml rename to testing_and_setup/compass/ocean/internal_waves/5km/default/config_driver.xml diff --git a/test/compass/ocean/internal_waves/5km/default/config_forward.xml b/testing_and_setup/compass/ocean/internal_waves/5km/default/config_forward.xml similarity index 100% rename from test/compass/ocean/internal_waves/5km/default/config_forward.xml rename to testing_and_setup/compass/ocean/internal_waves/5km/default/config_forward.xml diff --git a/test/compass/ocean/internal_waves/5km/default/config_init1.xml b/testing_and_setup/compass/ocean/internal_waves/5km/default/config_init1.xml similarity index 100% rename from test/compass/ocean/internal_waves/5km/default/config_init1.xml rename to testing_and_setup/compass/ocean/internal_waves/5km/default/config_init1.xml diff --git a/test/compass/ocean/internal_waves/5km/default/config_init2.xml b/testing_and_setup/compass/ocean/internal_waves/5km/default/config_init2.xml similarity index 100% rename from test/compass/ocean/internal_waves/5km/default/config_init2.xml rename to testing_and_setup/compass/ocean/internal_waves/5km/default/config_init2.xml diff --git a/test/compass/ocean/internal_waves/5km/internal_waves_5km_template.xml b/testing_and_setup/compass/ocean/internal_waves/5km/internal_waves_5km_template.xml similarity index 100% rename from test/compass/ocean/internal_waves/5km/internal_waves_5km_template.xml rename to testing_and_setup/compass/ocean/internal_waves/5km/internal_waves_5km_template.xml diff --git a/test/compass/ocean/internal_waves/5km/ten-day/config_driver.xml b/testing_and_setup/compass/ocean/internal_waves/5km/ten-day/config_driver.xml similarity index 100% rename from test/compass/ocean/internal_waves/5km/ten-day/config_driver.xml rename to testing_and_setup/compass/ocean/internal_waves/5km/ten-day/config_driver.xml diff --git a/test/compass/ocean/internal_waves/5km/ten-day/config_forward.xml b/testing_and_setup/compass/ocean/internal_waves/5km/ten-day/config_forward.xml similarity index 100% rename from test/compass/ocean/internal_waves/5km/ten-day/config_forward.xml rename to testing_and_setup/compass/ocean/internal_waves/5km/ten-day/config_forward.xml diff --git a/test/compass/ocean/internal_waves/5km/ten-day/config_init1.xml b/testing_and_setup/compass/ocean/internal_waves/5km/ten-day/config_init1.xml similarity index 100% rename from test/compass/ocean/internal_waves/5km/ten-day/config_init1.xml rename to testing_and_setup/compass/ocean/internal_waves/5km/ten-day/config_init1.xml diff --git a/test/compass/ocean/internal_waves/5km/ten-day/config_init2.xml b/testing_and_setup/compass/ocean/internal_waves/5km/ten-day/config_init2.xml similarity index 100% rename from test/compass/ocean/internal_waves/5km/ten-day/config_init2.xml rename to testing_and_setup/compass/ocean/internal_waves/5km/ten-day/config_init2.xml diff --git a/test/compass/ocean/isomip/10km/expt1.01/config_adjust_ssh.xml b/testing_and_setup/compass/ocean/isomip/10km/expt1.01/config_adjust_ssh.xml similarity index 100% rename from test/compass/ocean/isomip/10km/expt1.01/config_adjust_ssh.xml rename to testing_and_setup/compass/ocean/isomip/10km/expt1.01/config_adjust_ssh.xml diff --git a/test/compass/ocean/isomip/10km/expt1.01/config_driver.xml b/testing_and_setup/compass/ocean/isomip/10km/expt1.01/config_driver.xml similarity index 100% rename from test/compass/ocean/isomip/10km/expt1.01/config_driver.xml rename to testing_and_setup/compass/ocean/isomip/10km/expt1.01/config_driver.xml diff --git a/test/compass/ocean/isomip/10km/expt1.01/config_forward.xml b/testing_and_setup/compass/ocean/isomip/10km/expt1.01/config_forward.xml similarity index 100% rename from test/compass/ocean/isomip/10km/expt1.01/config_forward.xml rename to testing_and_setup/compass/ocean/isomip/10km/expt1.01/config_forward.xml diff --git a/test/compass/ocean/isomip/10km/expt1.01/config_init1.xml b/testing_and_setup/compass/ocean/isomip/10km/expt1.01/config_init1.xml similarity index 100% rename from test/compass/ocean/isomip/10km/expt1.01/config_init1.xml rename to testing_and_setup/compass/ocean/isomip/10km/expt1.01/config_init1.xml diff --git a/test/compass/ocean/isomip/10km/expt1.01/config_init2.xml b/testing_and_setup/compass/ocean/isomip/10km/expt1.01/config_init2.xml similarity index 100% rename from test/compass/ocean/isomip/10km/expt1.01/config_init2.xml rename to testing_and_setup/compass/ocean/isomip/10km/expt1.01/config_init2.xml diff --git a/test/compass/ocean/isomip/10km/expt2.01/config_adjust_ssh.xml b/testing_and_setup/compass/ocean/isomip/10km/expt2.01/config_adjust_ssh.xml similarity index 100% rename from test/compass/ocean/isomip/10km/expt2.01/config_adjust_ssh.xml rename to testing_and_setup/compass/ocean/isomip/10km/expt2.01/config_adjust_ssh.xml diff --git a/test/compass/ocean/isomip/10km/expt2.01/config_driver.xml b/testing_and_setup/compass/ocean/isomip/10km/expt2.01/config_driver.xml similarity index 100% rename from test/compass/ocean/isomip/10km/expt2.01/config_driver.xml rename to testing_and_setup/compass/ocean/isomip/10km/expt2.01/config_driver.xml diff --git a/test/compass/ocean/isomip/10km/expt2.01/config_forward.xml b/testing_and_setup/compass/ocean/isomip/10km/expt2.01/config_forward.xml similarity index 100% rename from test/compass/ocean/isomip/10km/expt2.01/config_forward.xml rename to testing_and_setup/compass/ocean/isomip/10km/expt2.01/config_forward.xml diff --git a/test/compass/ocean/isomip/10km/expt2.01/config_init1.xml b/testing_and_setup/compass/ocean/isomip/10km/expt2.01/config_init1.xml similarity index 100% rename from test/compass/ocean/isomip/10km/expt2.01/config_init1.xml rename to testing_and_setup/compass/ocean/isomip/10km/expt2.01/config_init1.xml diff --git a/test/compass/ocean/isomip/10km/expt2.01/config_init2.xml b/testing_and_setup/compass/ocean/isomip/10km/expt2.01/config_init2.xml similarity index 100% rename from test/compass/ocean/isomip/10km/expt2.01/config_init2.xml rename to testing_and_setup/compass/ocean/isomip/10km/expt2.01/config_init2.xml diff --git a/test/compass/ocean/isomip/template_adjust_ssh.xml b/testing_and_setup/compass/ocean/isomip/template_adjust_ssh.xml similarity index 100% rename from test/compass/ocean/isomip/template_adjust_ssh.xml rename to testing_and_setup/compass/ocean/isomip/template_adjust_ssh.xml diff --git a/test/compass/ocean/isomip/template_forward.xml b/testing_and_setup/compass/ocean/isomip/template_forward.xml similarity index 100% rename from test/compass/ocean/isomip/template_forward.xml rename to testing_and_setup/compass/ocean/isomip/template_forward.xml diff --git a/test/compass/ocean/isomip/template_init.xml b/testing_and_setup/compass/ocean/isomip/template_init.xml similarity index 100% rename from test/compass/ocean/isomip/template_init.xml rename to testing_and_setup/compass/ocean/isomip/template_init.xml diff --git a/test/compass/ocean/isomip_plus/2km/Ocean0/.gitignore b/testing_and_setup/compass/ocean/isomip_plus/2km/Ocean0/.gitignore similarity index 100% rename from test/compass/ocean/isomip_plus/2km/Ocean0/.gitignore rename to testing_and_setup/compass/ocean/isomip_plus/2km/Ocean0/.gitignore diff --git a/test/compass/ocean/isomip_plus/2km/Ocean0/config_adjust_ssh.xml b/testing_and_setup/compass/ocean/isomip_plus/2km/Ocean0/config_adjust_ssh.xml similarity index 100% rename from test/compass/ocean/isomip_plus/2km/Ocean0/config_adjust_ssh.xml rename to testing_and_setup/compass/ocean/isomip_plus/2km/Ocean0/config_adjust_ssh.xml diff --git a/test/compass/ocean/isomip_plus/2km/Ocean0/config_driver.xml b/testing_and_setup/compass/ocean/isomip_plus/2km/Ocean0/config_driver.xml similarity index 100% rename from test/compass/ocean/isomip_plus/2km/Ocean0/config_driver.xml rename to testing_and_setup/compass/ocean/isomip_plus/2km/Ocean0/config_driver.xml diff --git a/test/compass/ocean/isomip_plus/2km/Ocean0/config_forward.xml b/testing_and_setup/compass/ocean/isomip_plus/2km/Ocean0/config_forward.xml similarity index 100% rename from test/compass/ocean/isomip_plus/2km/Ocean0/config_forward.xml rename to testing_and_setup/compass/ocean/isomip_plus/2km/Ocean0/config_forward.xml diff --git a/test/compass/ocean/isomip_plus/2km/Ocean0/config_forward_kpp.xml b/testing_and_setup/compass/ocean/isomip_plus/2km/Ocean0/config_forward_kpp.xml similarity index 100% rename from test/compass/ocean/isomip_plus/2km/Ocean0/config_forward_kpp.xml rename to testing_and_setup/compass/ocean/isomip_plus/2km/Ocean0/config_forward_kpp.xml diff --git a/test/compass/ocean/isomip_plus/2km/Ocean0/config_forward_short.xml b/testing_and_setup/compass/ocean/isomip_plus/2km/Ocean0/config_forward_short.xml similarity index 100% rename from test/compass/ocean/isomip_plus/2km/Ocean0/config_forward_short.xml rename to testing_and_setup/compass/ocean/isomip_plus/2km/Ocean0/config_forward_short.xml diff --git a/test/compass/ocean/isomip_plus/2km/Ocean0/config_forward_unforced.xml b/testing_and_setup/compass/ocean/isomip_plus/2km/Ocean0/config_forward_unforced.xml similarity index 100% rename from test/compass/ocean/isomip_plus/2km/Ocean0/config_forward_unforced.xml rename to testing_and_setup/compass/ocean/isomip_plus/2km/Ocean0/config_forward_unforced.xml diff --git a/test/compass/ocean/isomip_plus/2km/Ocean0/config_init1.xml b/testing_and_setup/compass/ocean/isomip_plus/2km/Ocean0/config_init1.xml similarity index 100% rename from test/compass/ocean/isomip_plus/2km/Ocean0/config_init1.xml rename to testing_and_setup/compass/ocean/isomip_plus/2km/Ocean0/config_init1.xml diff --git a/test/compass/ocean/isomip_plus/2km/Ocean0/config_init2.xml b/testing_and_setup/compass/ocean/isomip_plus/2km/Ocean0/config_init2.xml similarity index 100% rename from test/compass/ocean/isomip_plus/2km/Ocean0/config_init2.xml rename to testing_and_setup/compass/ocean/isomip_plus/2km/Ocean0/config_init2.xml diff --git a/test/compass/ocean/isomip_plus/2km/Ocean1/config_adjust_ssh.xml b/testing_and_setup/compass/ocean/isomip_plus/2km/Ocean1/config_adjust_ssh.xml similarity index 100% rename from test/compass/ocean/isomip_plus/2km/Ocean1/config_adjust_ssh.xml rename to testing_and_setup/compass/ocean/isomip_plus/2km/Ocean1/config_adjust_ssh.xml diff --git a/test/compass/ocean/isomip_plus/2km/Ocean1/config_driver.xml b/testing_and_setup/compass/ocean/isomip_plus/2km/Ocean1/config_driver.xml similarity index 100% rename from test/compass/ocean/isomip_plus/2km/Ocean1/config_driver.xml rename to testing_and_setup/compass/ocean/isomip_plus/2km/Ocean1/config_driver.xml diff --git a/test/compass/ocean/isomip_plus/2km/Ocean1/config_forward.xml b/testing_and_setup/compass/ocean/isomip_plus/2km/Ocean1/config_forward.xml similarity index 100% rename from test/compass/ocean/isomip_plus/2km/Ocean1/config_forward.xml rename to testing_and_setup/compass/ocean/isomip_plus/2km/Ocean1/config_forward.xml diff --git a/test/compass/ocean/isomip_plus/2km/Ocean1/config_forward_kpp.xml b/testing_and_setup/compass/ocean/isomip_plus/2km/Ocean1/config_forward_kpp.xml similarity index 100% rename from test/compass/ocean/isomip_plus/2km/Ocean1/config_forward_kpp.xml rename to testing_and_setup/compass/ocean/isomip_plus/2km/Ocean1/config_forward_kpp.xml diff --git a/test/compass/ocean/isomip_plus/2km/Ocean1/config_forward_short.xml b/testing_and_setup/compass/ocean/isomip_plus/2km/Ocean1/config_forward_short.xml similarity index 100% rename from test/compass/ocean/isomip_plus/2km/Ocean1/config_forward_short.xml rename to testing_and_setup/compass/ocean/isomip_plus/2km/Ocean1/config_forward_short.xml diff --git a/test/compass/ocean/isomip_plus/2km/Ocean1/config_init1.xml b/testing_and_setup/compass/ocean/isomip_plus/2km/Ocean1/config_init1.xml similarity index 100% rename from test/compass/ocean/isomip_plus/2km/Ocean1/config_init1.xml rename to testing_and_setup/compass/ocean/isomip_plus/2km/Ocean1/config_init1.xml diff --git a/test/compass/ocean/isomip_plus/2km/Ocean1/config_init2.xml b/testing_and_setup/compass/ocean/isomip_plus/2km/Ocean1/config_init2.xml similarity index 100% rename from test/compass/ocean/isomip_plus/2km/Ocean1/config_init2.xml rename to testing_and_setup/compass/ocean/isomip_plus/2km/Ocean1/config_init2.xml diff --git a/test/compass/ocean/isomip_plus/2km/Ocean2/config_adjust_ssh.xml b/testing_and_setup/compass/ocean/isomip_plus/2km/Ocean2/config_adjust_ssh.xml similarity index 100% rename from test/compass/ocean/isomip_plus/2km/Ocean2/config_adjust_ssh.xml rename to testing_and_setup/compass/ocean/isomip_plus/2km/Ocean2/config_adjust_ssh.xml diff --git a/test/compass/ocean/isomip_plus/2km/Ocean2/config_driver.xml b/testing_and_setup/compass/ocean/isomip_plus/2km/Ocean2/config_driver.xml similarity index 100% rename from test/compass/ocean/isomip_plus/2km/Ocean2/config_driver.xml rename to testing_and_setup/compass/ocean/isomip_plus/2km/Ocean2/config_driver.xml diff --git a/test/compass/ocean/isomip_plus/2km/Ocean2/config_forward.xml b/testing_and_setup/compass/ocean/isomip_plus/2km/Ocean2/config_forward.xml similarity index 100% rename from test/compass/ocean/isomip_plus/2km/Ocean2/config_forward.xml rename to testing_and_setup/compass/ocean/isomip_plus/2km/Ocean2/config_forward.xml diff --git a/test/compass/ocean/isomip_plus/2km/Ocean2/config_forward_kpp.xml b/testing_and_setup/compass/ocean/isomip_plus/2km/Ocean2/config_forward_kpp.xml similarity index 100% rename from test/compass/ocean/isomip_plus/2km/Ocean2/config_forward_kpp.xml rename to testing_and_setup/compass/ocean/isomip_plus/2km/Ocean2/config_forward_kpp.xml diff --git a/test/compass/ocean/isomip_plus/2km/Ocean2/config_forward_short.xml b/testing_and_setup/compass/ocean/isomip_plus/2km/Ocean2/config_forward_short.xml similarity index 100% rename from test/compass/ocean/isomip_plus/2km/Ocean2/config_forward_short.xml rename to testing_and_setup/compass/ocean/isomip_plus/2km/Ocean2/config_forward_short.xml diff --git a/test/compass/ocean/isomip_plus/2km/Ocean2/config_init1.xml b/testing_and_setup/compass/ocean/isomip_plus/2km/Ocean2/config_init1.xml similarity index 100% rename from test/compass/ocean/isomip_plus/2km/Ocean2/config_init1.xml rename to testing_and_setup/compass/ocean/isomip_plus/2km/Ocean2/config_init1.xml diff --git a/test/compass/ocean/isomip_plus/2km/Ocean2/config_init2.xml b/testing_and_setup/compass/ocean/isomip_plus/2km/Ocean2/config_init2.xml similarity index 100% rename from test/compass/ocean/isomip_plus/2km/Ocean2/config_init2.xml rename to testing_and_setup/compass/ocean/isomip_plus/2km/Ocean2/config_init2.xml diff --git a/test/compass/ocean/isomip_plus/5km/Ocean0/.gitignore b/testing_and_setup/compass/ocean/isomip_plus/5km/Ocean0/.gitignore similarity index 100% rename from test/compass/ocean/isomip_plus/5km/Ocean0/.gitignore rename to testing_and_setup/compass/ocean/isomip_plus/5km/Ocean0/.gitignore diff --git a/test/compass/ocean/isomip_plus/5km/Ocean0/config_adjust_ssh.xml b/testing_and_setup/compass/ocean/isomip_plus/5km/Ocean0/config_adjust_ssh.xml similarity index 100% rename from test/compass/ocean/isomip_plus/5km/Ocean0/config_adjust_ssh.xml rename to testing_and_setup/compass/ocean/isomip_plus/5km/Ocean0/config_adjust_ssh.xml diff --git a/test/compass/ocean/isomip_plus/5km/Ocean0/config_driver.xml b/testing_and_setup/compass/ocean/isomip_plus/5km/Ocean0/config_driver.xml similarity index 100% rename from test/compass/ocean/isomip_plus/5km/Ocean0/config_driver.xml rename to testing_and_setup/compass/ocean/isomip_plus/5km/Ocean0/config_driver.xml diff --git a/test/compass/ocean/isomip_plus/5km/Ocean0/config_forward.xml b/testing_and_setup/compass/ocean/isomip_plus/5km/Ocean0/config_forward.xml similarity index 100% rename from test/compass/ocean/isomip_plus/5km/Ocean0/config_forward.xml rename to testing_and_setup/compass/ocean/isomip_plus/5km/Ocean0/config_forward.xml diff --git a/test/compass/ocean/isomip_plus/5km/Ocean0/config_init1.xml b/testing_and_setup/compass/ocean/isomip_plus/5km/Ocean0/config_init1.xml similarity index 100% rename from test/compass/ocean/isomip_plus/5km/Ocean0/config_init1.xml rename to testing_and_setup/compass/ocean/isomip_plus/5km/Ocean0/config_init1.xml diff --git a/test/compass/ocean/isomip_plus/5km/Ocean0/config_init2.xml b/testing_and_setup/compass/ocean/isomip_plus/5km/Ocean0/config_init2.xml similarity index 100% rename from test/compass/ocean/isomip_plus/5km/Ocean0/config_init2.xml rename to testing_and_setup/compass/ocean/isomip_plus/5km/Ocean0/config_init2.xml diff --git a/test/compass/ocean/isomip_plus/5km/Ocean1/config_adjust_ssh.xml b/testing_and_setup/compass/ocean/isomip_plus/5km/Ocean1/config_adjust_ssh.xml similarity index 100% rename from test/compass/ocean/isomip_plus/5km/Ocean1/config_adjust_ssh.xml rename to testing_and_setup/compass/ocean/isomip_plus/5km/Ocean1/config_adjust_ssh.xml diff --git a/test/compass/ocean/isomip_plus/5km/Ocean1/config_driver.xml b/testing_and_setup/compass/ocean/isomip_plus/5km/Ocean1/config_driver.xml similarity index 100% rename from test/compass/ocean/isomip_plus/5km/Ocean1/config_driver.xml rename to testing_and_setup/compass/ocean/isomip_plus/5km/Ocean1/config_driver.xml diff --git a/test/compass/ocean/isomip_plus/5km/Ocean1/config_forward.xml b/testing_and_setup/compass/ocean/isomip_plus/5km/Ocean1/config_forward.xml similarity index 100% rename from test/compass/ocean/isomip_plus/5km/Ocean1/config_forward.xml rename to testing_and_setup/compass/ocean/isomip_plus/5km/Ocean1/config_forward.xml diff --git a/test/compass/ocean/isomip_plus/5km/Ocean1/config_init1.xml b/testing_and_setup/compass/ocean/isomip_plus/5km/Ocean1/config_init1.xml similarity index 100% rename from test/compass/ocean/isomip_plus/5km/Ocean1/config_init1.xml rename to testing_and_setup/compass/ocean/isomip_plus/5km/Ocean1/config_init1.xml diff --git a/test/compass/ocean/isomip_plus/5km/Ocean1/config_init2.xml b/testing_and_setup/compass/ocean/isomip_plus/5km/Ocean1/config_init2.xml similarity index 100% rename from test/compass/ocean/isomip_plus/5km/Ocean1/config_init2.xml rename to testing_and_setup/compass/ocean/isomip_plus/5km/Ocean1/config_init2.xml diff --git a/test/compass/ocean/isomip_plus/5km/Ocean2/config_adjust_ssh.xml b/testing_and_setup/compass/ocean/isomip_plus/5km/Ocean2/config_adjust_ssh.xml similarity index 100% rename from test/compass/ocean/isomip_plus/5km/Ocean2/config_adjust_ssh.xml rename to testing_and_setup/compass/ocean/isomip_plus/5km/Ocean2/config_adjust_ssh.xml diff --git a/test/compass/ocean/isomip_plus/5km/Ocean2/config_driver.xml b/testing_and_setup/compass/ocean/isomip_plus/5km/Ocean2/config_driver.xml similarity index 100% rename from test/compass/ocean/isomip_plus/5km/Ocean2/config_driver.xml rename to testing_and_setup/compass/ocean/isomip_plus/5km/Ocean2/config_driver.xml diff --git a/test/compass/ocean/isomip_plus/5km/Ocean2/config_forward.xml b/testing_and_setup/compass/ocean/isomip_plus/5km/Ocean2/config_forward.xml similarity index 100% rename from test/compass/ocean/isomip_plus/5km/Ocean2/config_forward.xml rename to testing_and_setup/compass/ocean/isomip_plus/5km/Ocean2/config_forward.xml diff --git a/test/compass/ocean/isomip_plus/5km/Ocean2/config_init1.xml b/testing_and_setup/compass/ocean/isomip_plus/5km/Ocean2/config_init1.xml similarity index 100% rename from test/compass/ocean/isomip_plus/5km/Ocean2/config_init1.xml rename to testing_and_setup/compass/ocean/isomip_plus/5km/Ocean2/config_init1.xml diff --git a/test/compass/ocean/isomip_plus/5km/Ocean2/config_init2.xml b/testing_and_setup/compass/ocean/isomip_plus/5km/Ocean2/config_init2.xml similarity index 100% rename from test/compass/ocean/isomip_plus/5km/Ocean2/config_init2.xml rename to testing_and_setup/compass/ocean/isomip_plus/5km/Ocean2/config_init2.xml diff --git a/test/compass/ocean/isomip_plus/5km/template_forward.xml b/testing_and_setup/compass/ocean/isomip_plus/5km/template_forward.xml similarity index 100% rename from test/compass/ocean/isomip_plus/5km/template_forward.xml rename to testing_and_setup/compass/ocean/isomip_plus/5km/template_forward.xml diff --git a/test/compass/ocean/isomip_plus/processInputGeometry.py b/testing_and_setup/compass/ocean/isomip_plus/processInputGeometry.py similarity index 100% rename from test/compass/ocean/isomip_plus/processInputGeometry.py rename to testing_and_setup/compass/ocean/isomip_plus/processInputGeometry.py diff --git a/test/compass/ocean/isomip_plus/setup_Ocean0_param_study.py b/testing_and_setup/compass/ocean/isomip_plus/setup_Ocean0_param_study.py similarity index 100% rename from test/compass/ocean/isomip_plus/setup_Ocean0_param_study.py rename to testing_and_setup/compass/ocean/isomip_plus/setup_Ocean0_param_study.py diff --git a/test/compass/ocean/isomip_plus/template_Ocean0_param_study.xml b/testing_and_setup/compass/ocean/isomip_plus/template_Ocean0_param_study.xml similarity index 100% rename from test/compass/ocean/isomip_plus/template_Ocean0_param_study.xml rename to testing_and_setup/compass/ocean/isomip_plus/template_Ocean0_param_study.xml diff --git a/test/compass/ocean/isomip_plus/template_adjust_ssh.xml b/testing_and_setup/compass/ocean/isomip_plus/template_adjust_ssh.xml similarity index 100% rename from test/compass/ocean/isomip_plus/template_adjust_ssh.xml rename to testing_and_setup/compass/ocean/isomip_plus/template_adjust_ssh.xml diff --git a/test/compass/ocean/isomip_plus/template_forward.xml b/testing_and_setup/compass/ocean/isomip_plus/template_forward.xml similarity index 100% rename from test/compass/ocean/isomip_plus/template_forward.xml rename to testing_and_setup/compass/ocean/isomip_plus/template_forward.xml diff --git a/test/compass/ocean/isomip_plus/template_init.xml b/testing_and_setup/compass/ocean/isomip_plus/template_init.xml similarity index 100% rename from test/compass/ocean/isomip_plus/template_init.xml rename to testing_and_setup/compass/ocean/isomip_plus/template_init.xml diff --git a/test/compass/ocean/isomip_plus/update_evaporationFlux.py b/testing_and_setup/compass/ocean/isomip_plus/update_evaporationFlux.py similarity index 100% rename from test/compass/ocean/isomip_plus/update_evaporationFlux.py rename to testing_and_setup/compass/ocean/isomip_plus/update_evaporationFlux.py diff --git a/test/compass/ocean/isomip_plus/viz/computeAndPlotResults.py b/testing_and_setup/compass/ocean/isomip_plus/viz/computeAndPlotResults.py similarity index 100% rename from test/compass/ocean/isomip_plus/viz/computeAndPlotResults.py rename to testing_and_setup/compass/ocean/isomip_plus/viz/computeAndPlotResults.py diff --git a/test/compass/ocean/isomip_plus/viz/computeBarotropicStreamfunction.py b/testing_and_setup/compass/ocean/isomip_plus/viz/computeBarotropicStreamfunction.py similarity index 100% rename from test/compass/ocean/isomip_plus/viz/computeBarotropicStreamfunction.py rename to testing_and_setup/compass/ocean/isomip_plus/viz/computeBarotropicStreamfunction.py diff --git a/test/compass/ocean/isomip_plus/viz/computeMISOMIPInterpCoeffs.py b/testing_and_setup/compass/ocean/isomip_plus/viz/computeMISOMIPInterpCoeffs.py similarity index 100% rename from test/compass/ocean/isomip_plus/viz/computeMISOMIPInterpCoeffs.py rename to testing_and_setup/compass/ocean/isomip_plus/viz/computeMISOMIPInterpCoeffs.py diff --git a/test/compass/ocean/isomip_plus/viz/computeOverturningStreamfunction.py b/testing_and_setup/compass/ocean/isomip_plus/viz/computeOverturningStreamfunction.py similarity index 100% rename from test/compass/ocean/isomip_plus/viz/computeOverturningStreamfunction.py rename to testing_and_setup/compass/ocean/isomip_plus/viz/computeOverturningStreamfunction.py diff --git a/test/compass/ocean/isomip_plus/viz/interpMISOMIPResults.py b/testing_and_setup/compass/ocean/isomip_plus/viz/interpMISOMIPResults.py similarity index 100% rename from test/compass/ocean/isomip_plus/viz/interpMISOMIPResults.py rename to testing_and_setup/compass/ocean/isomip_plus/viz/interpMISOMIPResults.py diff --git a/test/compass/ocean/isomip_plus/viz/plotMeltFluxes.py b/testing_and_setup/compass/ocean/isomip_plus/viz/plotMeltFluxes.py similarity index 100% rename from test/compass/ocean/isomip_plus/viz/plotMeltFluxes.py rename to testing_and_setup/compass/ocean/isomip_plus/viz/plotMeltFluxes.py diff --git a/test/compass/ocean/isomip_plus/viz/plotResults.py b/testing_and_setup/compass/ocean/isomip_plus/viz/plotResults.py similarity index 100% rename from test/compass/ocean/isomip_plus/viz/plotResults.py rename to testing_and_setup/compass/ocean/isomip_plus/viz/plotResults.py diff --git a/test/compass/ocean/iterative_ssh_landIcePressure_scripts/iterate_init.py b/testing_and_setup/compass/ocean/iterative_ssh_landIcePressure_scripts/iterate_init.py similarity index 100% rename from test/compass/ocean/iterative_ssh_landIcePressure_scripts/iterate_init.py rename to testing_and_setup/compass/ocean/iterative_ssh_landIcePressure_scripts/iterate_init.py diff --git a/test/compass/ocean/iterative_ssh_landIcePressure_scripts/plot_cart_ssh_landIcePressure.py b/testing_and_setup/compass/ocean/iterative_ssh_landIcePressure_scripts/plot_cart_ssh_landIcePressure.py similarity index 100% rename from test/compass/ocean/iterative_ssh_landIcePressure_scripts/plot_cart_ssh_landIcePressure.py rename to testing_and_setup/compass/ocean/iterative_ssh_landIcePressure_scripts/plot_cart_ssh_landIcePressure.py diff --git a/test/compass/ocean/lock_exchange/0.5km/default/config_driver.xml b/testing_and_setup/compass/ocean/lock_exchange/0.5km/default/config_driver.xml similarity index 100% rename from test/compass/ocean/lock_exchange/0.5km/default/config_driver.xml rename to testing_and_setup/compass/ocean/lock_exchange/0.5km/default/config_driver.xml diff --git a/test/compass/ocean/lock_exchange/0.5km/default/config_forward.xml b/testing_and_setup/compass/ocean/lock_exchange/0.5km/default/config_forward.xml similarity index 100% rename from test/compass/ocean/lock_exchange/0.5km/default/config_forward.xml rename to testing_and_setup/compass/ocean/lock_exchange/0.5km/default/config_forward.xml diff --git a/test/compass/ocean/lock_exchange/0.5km/default/config_init1.xml b/testing_and_setup/compass/ocean/lock_exchange/0.5km/default/config_init1.xml similarity index 100% rename from test/compass/ocean/lock_exchange/0.5km/default/config_init1.xml rename to testing_and_setup/compass/ocean/lock_exchange/0.5km/default/config_init1.xml diff --git a/test/compass/ocean/lock_exchange/0.5km/default/config_init2.xml b/testing_and_setup/compass/ocean/lock_exchange/0.5km/default/config_init2.xml similarity index 100% rename from test/compass/ocean/lock_exchange/0.5km/default/config_init2.xml rename to testing_and_setup/compass/ocean/lock_exchange/0.5km/default/config_init2.xml diff --git a/test/compass/ocean/lock_exchange/16km/default/config_driver.xml b/testing_and_setup/compass/ocean/lock_exchange/16km/default/config_driver.xml similarity index 100% rename from test/compass/ocean/lock_exchange/16km/default/config_driver.xml rename to testing_and_setup/compass/ocean/lock_exchange/16km/default/config_driver.xml diff --git a/test/compass/ocean/lock_exchange/16km/default/config_forward.xml b/testing_and_setup/compass/ocean/lock_exchange/16km/default/config_forward.xml similarity index 100% rename from test/compass/ocean/lock_exchange/16km/default/config_forward.xml rename to testing_and_setup/compass/ocean/lock_exchange/16km/default/config_forward.xml diff --git a/test/compass/ocean/lock_exchange/16km/default/config_init1.xml b/testing_and_setup/compass/ocean/lock_exchange/16km/default/config_init1.xml similarity index 100% rename from test/compass/ocean/lock_exchange/16km/default/config_init1.xml rename to testing_and_setup/compass/ocean/lock_exchange/16km/default/config_init1.xml diff --git a/test/compass/ocean/lock_exchange/16km/default/config_init2.xml b/testing_and_setup/compass/ocean/lock_exchange/16km/default/config_init2.xml similarity index 100% rename from test/compass/ocean/lock_exchange/16km/default/config_init2.xml rename to testing_and_setup/compass/ocean/lock_exchange/16km/default/config_init2.xml diff --git a/test/compass/ocean/overflow/10km/default/.gitignore b/testing_and_setup/compass/ocean/overflow/10km/default/.gitignore similarity index 100% rename from test/compass/ocean/overflow/10km/default/.gitignore rename to testing_and_setup/compass/ocean/overflow/10km/default/.gitignore diff --git a/test/compass/ocean/overflow/10km/default/config_driver.xml b/testing_and_setup/compass/ocean/overflow/10km/default/config_driver.xml similarity index 100% rename from test/compass/ocean/overflow/10km/default/config_driver.xml rename to testing_and_setup/compass/ocean/overflow/10km/default/config_driver.xml diff --git a/test/compass/ocean/overflow/10km/default/config_forward.xml b/testing_and_setup/compass/ocean/overflow/10km/default/config_forward.xml similarity index 100% rename from test/compass/ocean/overflow/10km/default/config_forward.xml rename to testing_and_setup/compass/ocean/overflow/10km/default/config_forward.xml diff --git a/test/compass/ocean/overflow/10km/default/config_init1.xml b/testing_and_setup/compass/ocean/overflow/10km/default/config_init1.xml similarity index 100% rename from test/compass/ocean/overflow/10km/default/config_init1.xml rename to testing_and_setup/compass/ocean/overflow/10km/default/config_init1.xml diff --git a/test/compass/ocean/overflow/10km/default/config_init2.xml b/testing_and_setup/compass/ocean/overflow/10km/default/config_init2.xml similarity index 100% rename from test/compass/ocean/overflow/10km/default/config_init2.xml rename to testing_and_setup/compass/ocean/overflow/10km/default/config_init2.xml diff --git a/test/compass/ocean/periodic_planar/20km/default_light/config_driver.xml b/testing_and_setup/compass/ocean/periodic_planar/20km/default_light/config_driver.xml similarity index 100% rename from test/compass/ocean/periodic_planar/20km/default_light/config_driver.xml rename to testing_and_setup/compass/ocean/periodic_planar/20km/default_light/config_driver.xml diff --git a/test/compass/ocean/periodic_planar/20km/default_light/config_forward.xml b/testing_and_setup/compass/ocean/periodic_planar/20km/default_light/config_forward.xml similarity index 100% rename from test/compass/ocean/periodic_planar/20km/default_light/config_forward.xml rename to testing_and_setup/compass/ocean/periodic_planar/20km/default_light/config_forward.xml diff --git a/test/compass/ocean/periodic_planar/20km/default_light/config_init1.xml b/testing_and_setup/compass/ocean/periodic_planar/20km/default_light/config_init1.xml similarity index 100% rename from test/compass/ocean/periodic_planar/20km/default_light/config_init1.xml rename to testing_and_setup/compass/ocean/periodic_planar/20km/default_light/config_init1.xml diff --git a/test/compass/ocean/periodic_planar/20km/default_light/config_init2.xml b/testing_and_setup/compass/ocean/periodic_planar/20km/default_light/config_init2.xml similarity index 100% rename from test/compass/ocean/periodic_planar/20km/default_light/config_init2.xml rename to testing_and_setup/compass/ocean/periodic_planar/20km/default_light/config_init2.xml diff --git a/test/compass/ocean/periodic_planar/20km/region_reset_light_test/config_driver.xml b/testing_and_setup/compass/ocean/periodic_planar/20km/region_reset_light_test/config_driver.xml similarity index 100% rename from test/compass/ocean/periodic_planar/20km/region_reset_light_test/config_driver.xml rename to testing_and_setup/compass/ocean/periodic_planar/20km/region_reset_light_test/config_driver.xml diff --git a/test/compass/ocean/periodic_planar/20km/region_reset_light_test/config_forward.xml b/testing_and_setup/compass/ocean/periodic_planar/20km/region_reset_light_test/config_forward.xml similarity index 100% rename from test/compass/ocean/periodic_planar/20km/region_reset_light_test/config_forward.xml rename to testing_and_setup/compass/ocean/periodic_planar/20km/region_reset_light_test/config_forward.xml diff --git a/test/compass/ocean/periodic_planar/20km/region_reset_light_test/config_init1.xml b/testing_and_setup/compass/ocean/periodic_planar/20km/region_reset_light_test/config_init1.xml similarity index 100% rename from test/compass/ocean/periodic_planar/20km/region_reset_light_test/config_init1.xml rename to testing_and_setup/compass/ocean/periodic_planar/20km/region_reset_light_test/config_init1.xml diff --git a/test/compass/ocean/periodic_planar/20km/region_reset_light_test/config_init2.xml b/testing_and_setup/compass/ocean/periodic_planar/20km/region_reset_light_test/config_init2.xml similarity index 100% rename from test/compass/ocean/periodic_planar/20km/region_reset_light_test/config_init2.xml rename to testing_and_setup/compass/ocean/periodic_planar/20km/region_reset_light_test/config_init2.xml diff --git a/test/compass/ocean/periodic_planar/20km/time_reset_light_test/config_driver.xml b/testing_and_setup/compass/ocean/periodic_planar/20km/time_reset_light_test/config_driver.xml similarity index 100% rename from test/compass/ocean/periodic_planar/20km/time_reset_light_test/config_driver.xml rename to testing_and_setup/compass/ocean/periodic_planar/20km/time_reset_light_test/config_driver.xml diff --git a/test/compass/ocean/periodic_planar/20km/time_reset_light_test/config_forward.xml b/testing_and_setup/compass/ocean/periodic_planar/20km/time_reset_light_test/config_forward.xml similarity index 100% rename from test/compass/ocean/periodic_planar/20km/time_reset_light_test/config_forward.xml rename to testing_and_setup/compass/ocean/periodic_planar/20km/time_reset_light_test/config_forward.xml diff --git a/test/compass/ocean/periodic_planar/20km/time_reset_light_test/config_init1.xml b/testing_and_setup/compass/ocean/periodic_planar/20km/time_reset_light_test/config_init1.xml similarity index 100% rename from test/compass/ocean/periodic_planar/20km/time_reset_light_test/config_init1.xml rename to testing_and_setup/compass/ocean/periodic_planar/20km/time_reset_light_test/config_init1.xml diff --git a/test/compass/ocean/periodic_planar/20km/time_reset_light_test/config_init2.xml b/testing_and_setup/compass/ocean/periodic_planar/20km/time_reset_light_test/config_init2.xml similarity index 100% rename from test/compass/ocean/periodic_planar/20km/time_reset_light_test/config_init2.xml rename to testing_and_setup/compass/ocean/periodic_planar/20km/time_reset_light_test/config_init2.xml diff --git a/test/compass/ocean/regression_suites/land_ice_fluxes.xml b/testing_and_setup/compass/ocean/regression_suites/land_ice_fluxes.xml similarity index 100% rename from test/compass/ocean/regression_suites/land_ice_fluxes.xml rename to testing_and_setup/compass/ocean/regression_suites/land_ice_fluxes.xml diff --git a/test/compass/ocean/regression_suites/light.xml b/testing_and_setup/compass/ocean/regression_suites/light.xml similarity index 100% rename from test/compass/ocean/regression_suites/light.xml rename to testing_and_setup/compass/ocean/regression_suites/light.xml diff --git a/test/compass/ocean/regression_suites/nightly.xml b/testing_and_setup/compass/ocean/regression_suites/nightly.xml similarity index 100% rename from test/compass/ocean/regression_suites/nightly.xml rename to testing_and_setup/compass/ocean/regression_suites/nightly.xml diff --git a/test/compass/ocean/scripts/plot_globalStats.py b/testing_and_setup/compass/ocean/scripts/plot_globalStats.py similarity index 100% rename from test/compass/ocean/scripts/plot_globalStats.py rename to testing_and_setup/compass/ocean/scripts/plot_globalStats.py diff --git a/test/compass/ocean/sea_mount/6.7km/.gitignore b/testing_and_setup/compass/ocean/sea_mount/6.7km/.gitignore similarity index 100% rename from test/compass/ocean/sea_mount/6.7km/.gitignore rename to testing_and_setup/compass/ocean/sea_mount/6.7km/.gitignore diff --git a/test/compass/ocean/sea_mount/6.7km/default/config_driver.xml b/testing_and_setup/compass/ocean/sea_mount/6.7km/default/config_driver.xml similarity index 100% rename from test/compass/ocean/sea_mount/6.7km/default/config_driver.xml rename to testing_and_setup/compass/ocean/sea_mount/6.7km/default/config_driver.xml diff --git a/test/compass/ocean/sea_mount/6.7km/default/config_forward.xml b/testing_and_setup/compass/ocean/sea_mount/6.7km/default/config_forward.xml similarity index 100% rename from test/compass/ocean/sea_mount/6.7km/default/config_forward.xml rename to testing_and_setup/compass/ocean/sea_mount/6.7km/default/config_forward.xml diff --git a/test/compass/ocean/sea_mount/6.7km/default/config_init1.xml b/testing_and_setup/compass/ocean/sea_mount/6.7km/default/config_init1.xml similarity index 100% rename from test/compass/ocean/sea_mount/6.7km/default/config_init1.xml rename to testing_and_setup/compass/ocean/sea_mount/6.7km/default/config_init1.xml diff --git a/test/compass/ocean/sea_mount/6.7km/default/config_init2.xml b/testing_and_setup/compass/ocean/sea_mount/6.7km/default/config_init2.xml similarity index 100% rename from test/compass/ocean/sea_mount/6.7km/default/config_init2.xml rename to testing_and_setup/compass/ocean/sea_mount/6.7km/default/config_init2.xml diff --git a/test/compass/ocean/sea_mount/6.7km/template_forward.xml b/testing_and_setup/compass/ocean/sea_mount/6.7km/template_forward.xml similarity index 100% rename from test/compass/ocean/sea_mount/6.7km/template_forward.xml rename to testing_and_setup/compass/ocean/sea_mount/6.7km/template_forward.xml diff --git a/test/compass/ocean/single_column_model/planar/cvmix_test/config_driver.xml b/testing_and_setup/compass/ocean/single_column_model/planar/cvmix_test/config_driver.xml similarity index 100% rename from test/compass/ocean/single_column_model/planar/cvmix_test/config_driver.xml rename to testing_and_setup/compass/ocean/single_column_model/planar/cvmix_test/config_driver.xml diff --git a/test/compass/ocean/single_column_model/planar/cvmix_test/config_forward.xml b/testing_and_setup/compass/ocean/single_column_model/planar/cvmix_test/config_forward.xml similarity index 100% rename from test/compass/ocean/single_column_model/planar/cvmix_test/config_forward.xml rename to testing_and_setup/compass/ocean/single_column_model/planar/cvmix_test/config_forward.xml diff --git a/test/compass/ocean/single_column_model/planar/cvmix_test/config_init.xml b/testing_and_setup/compass/ocean/single_column_model/planar/cvmix_test/config_init.xml similarity index 100% rename from test/compass/ocean/single_column_model/planar/cvmix_test/config_init.xml rename to testing_and_setup/compass/ocean/single_column_model/planar/cvmix_test/config_init.xml diff --git a/test/compass/ocean/single_column_model/sphere/cvmix_test/config_driver.xml b/testing_and_setup/compass/ocean/single_column_model/sphere/cvmix_test/config_driver.xml similarity index 100% rename from test/compass/ocean/single_column_model/sphere/cvmix_test/config_driver.xml rename to testing_and_setup/compass/ocean/single_column_model/sphere/cvmix_test/config_driver.xml diff --git a/test/compass/ocean/single_column_model/sphere/cvmix_test/config_forward.xml b/testing_and_setup/compass/ocean/single_column_model/sphere/cvmix_test/config_forward.xml similarity index 100% rename from test/compass/ocean/single_column_model/sphere/cvmix_test/config_forward.xml rename to testing_and_setup/compass/ocean/single_column_model/sphere/cvmix_test/config_forward.xml diff --git a/test/compass/ocean/single_column_model/sphere/cvmix_test/config_init.xml b/testing_and_setup/compass/ocean/single_column_model/sphere/cvmix_test/config_init.xml similarity index 100% rename from test/compass/ocean/single_column_model/sphere/cvmix_test/config_init.xml rename to testing_and_setup/compass/ocean/single_column_model/sphere/cvmix_test/config_init.xml diff --git a/test/compass/ocean/soma/16km/3layer/config_driver.xml b/testing_and_setup/compass/ocean/soma/16km/3layer/config_driver.xml similarity index 100% rename from test/compass/ocean/soma/16km/3layer/config_driver.xml rename to testing_and_setup/compass/ocean/soma/16km/3layer/config_driver.xml diff --git a/test/compass/ocean/soma/16km/3layer/config_forward.xml b/testing_and_setup/compass/ocean/soma/16km/3layer/config_forward.xml similarity index 100% rename from test/compass/ocean/soma/16km/3layer/config_forward.xml rename to testing_and_setup/compass/ocean/soma/16km/3layer/config_forward.xml diff --git a/test/compass/ocean/soma/16km/3layer/config_init1.xml b/testing_and_setup/compass/ocean/soma/16km/3layer/config_init1.xml similarity index 100% rename from test/compass/ocean/soma/16km/3layer/config_init1.xml rename to testing_and_setup/compass/ocean/soma/16km/3layer/config_init1.xml diff --git a/test/compass/ocean/soma/16km/3layer/config_init2.xml b/testing_and_setup/compass/ocean/soma/16km/3layer/config_init2.xml similarity index 100% rename from test/compass/ocean/soma/16km/3layer/config_init2.xml rename to testing_and_setup/compass/ocean/soma/16km/3layer/config_init2.xml diff --git a/test/compass/ocean/soma/16km/default/config_driver.xml b/testing_and_setup/compass/ocean/soma/16km/default/config_driver.xml similarity index 100% rename from test/compass/ocean/soma/16km/default/config_driver.xml rename to testing_and_setup/compass/ocean/soma/16km/default/config_driver.xml diff --git a/test/compass/ocean/soma/16km/default/config_forward.xml b/testing_and_setup/compass/ocean/soma/16km/default/config_forward.xml similarity index 100% rename from test/compass/ocean/soma/16km/default/config_forward.xml rename to testing_and_setup/compass/ocean/soma/16km/default/config_forward.xml diff --git a/test/compass/ocean/soma/16km/default/config_init1.xml b/testing_and_setup/compass/ocean/soma/16km/default/config_init1.xml similarity index 100% rename from test/compass/ocean/soma/16km/default/config_init1.xml rename to testing_and_setup/compass/ocean/soma/16km/default/config_init1.xml diff --git a/test/compass/ocean/soma/16km/default/config_init2.xml b/testing_and_setup/compass/ocean/soma/16km/default/config_init2.xml similarity index 100% rename from test/compass/ocean/soma/16km/default/config_init2.xml rename to testing_and_setup/compass/ocean/soma/16km/default/config_init2.xml diff --git a/test/compass/ocean/soma/16km/surface_restoring/config_driver.xml b/testing_and_setup/compass/ocean/soma/16km/surface_restoring/config_driver.xml similarity index 100% rename from test/compass/ocean/soma/16km/surface_restoring/config_driver.xml rename to testing_and_setup/compass/ocean/soma/16km/surface_restoring/config_driver.xml diff --git a/test/compass/ocean/soma/16km/surface_restoring/config_forward.xml b/testing_and_setup/compass/ocean/soma/16km/surface_restoring/config_forward.xml similarity index 100% rename from test/compass/ocean/soma/16km/surface_restoring/config_forward.xml rename to testing_and_setup/compass/ocean/soma/16km/surface_restoring/config_forward.xml diff --git a/test/compass/ocean/soma/16km/surface_restoring/config_init1.xml b/testing_and_setup/compass/ocean/soma/16km/surface_restoring/config_init1.xml similarity index 100% rename from test/compass/ocean/soma/16km/surface_restoring/config_init1.xml rename to testing_and_setup/compass/ocean/soma/16km/surface_restoring/config_init1.xml diff --git a/test/compass/ocean/soma/16km/surface_restoring/config_init2.xml b/testing_and_setup/compass/ocean/soma/16km/surface_restoring/config_init2.xml similarity index 100% rename from test/compass/ocean/soma/16km/surface_restoring/config_init2.xml rename to testing_and_setup/compass/ocean/soma/16km/surface_restoring/config_init2.xml diff --git a/test/compass/ocean/soma/32km/3layer/config_driver.xml b/testing_and_setup/compass/ocean/soma/32km/3layer/config_driver.xml similarity index 100% rename from test/compass/ocean/soma/32km/3layer/config_driver.xml rename to testing_and_setup/compass/ocean/soma/32km/3layer/config_driver.xml diff --git a/test/compass/ocean/soma/32km/3layer/config_forward.xml b/testing_and_setup/compass/ocean/soma/32km/3layer/config_forward.xml similarity index 100% rename from test/compass/ocean/soma/32km/3layer/config_forward.xml rename to testing_and_setup/compass/ocean/soma/32km/3layer/config_forward.xml diff --git a/test/compass/ocean/soma/32km/3layer/config_init1.xml b/testing_and_setup/compass/ocean/soma/32km/3layer/config_init1.xml similarity index 100% rename from test/compass/ocean/soma/32km/3layer/config_init1.xml rename to testing_and_setup/compass/ocean/soma/32km/3layer/config_init1.xml diff --git a/test/compass/ocean/soma/32km/3layer/config_init2.xml b/testing_and_setup/compass/ocean/soma/32km/3layer/config_init2.xml similarity index 100% rename from test/compass/ocean/soma/32km/3layer/config_init2.xml rename to testing_and_setup/compass/ocean/soma/32km/3layer/config_init2.xml diff --git a/test/compass/ocean/soma/32km/default/config_driver.xml b/testing_and_setup/compass/ocean/soma/32km/default/config_driver.xml similarity index 100% rename from test/compass/ocean/soma/32km/default/config_driver.xml rename to testing_and_setup/compass/ocean/soma/32km/default/config_driver.xml diff --git a/test/compass/ocean/soma/32km/default/config_forward.xml b/testing_and_setup/compass/ocean/soma/32km/default/config_forward.xml similarity index 100% rename from test/compass/ocean/soma/32km/default/config_forward.xml rename to testing_and_setup/compass/ocean/soma/32km/default/config_forward.xml diff --git a/test/compass/ocean/soma/32km/default/config_init1.xml b/testing_and_setup/compass/ocean/soma/32km/default/config_init1.xml similarity index 100% rename from test/compass/ocean/soma/32km/default/config_init1.xml rename to testing_and_setup/compass/ocean/soma/32km/default/config_init1.xml diff --git a/test/compass/ocean/soma/32km/default/config_init2.xml b/testing_and_setup/compass/ocean/soma/32km/default/config_init2.xml similarity index 100% rename from test/compass/ocean/soma/32km/default/config_init2.xml rename to testing_and_setup/compass/ocean/soma/32km/default/config_init2.xml diff --git a/test/compass/ocean/soma/32km/surface_restoring/config_driver.xml b/testing_and_setup/compass/ocean/soma/32km/surface_restoring/config_driver.xml similarity index 100% rename from test/compass/ocean/soma/32km/surface_restoring/config_driver.xml rename to testing_and_setup/compass/ocean/soma/32km/surface_restoring/config_driver.xml diff --git a/test/compass/ocean/soma/32km/surface_restoring/config_forward.xml b/testing_and_setup/compass/ocean/soma/32km/surface_restoring/config_forward.xml similarity index 100% rename from test/compass/ocean/soma/32km/surface_restoring/config_forward.xml rename to testing_and_setup/compass/ocean/soma/32km/surface_restoring/config_forward.xml diff --git a/test/compass/ocean/soma/32km/surface_restoring/config_init1.xml b/testing_and_setup/compass/ocean/soma/32km/surface_restoring/config_init1.xml similarity index 100% rename from test/compass/ocean/soma/32km/surface_restoring/config_init1.xml rename to testing_and_setup/compass/ocean/soma/32km/surface_restoring/config_init1.xml diff --git a/test/compass/ocean/soma/32km/surface_restoring/config_init2.xml b/testing_and_setup/compass/ocean/soma/32km/surface_restoring/config_init2.xml similarity index 100% rename from test/compass/ocean/soma/32km/surface_restoring/config_init2.xml rename to testing_and_setup/compass/ocean/soma/32km/surface_restoring/config_init2.xml diff --git a/test/compass/ocean/soma/4km/32to4km/config_driver.xml b/testing_and_setup/compass/ocean/soma/4km/32to4km/config_driver.xml similarity index 100% rename from test/compass/ocean/soma/4km/32to4km/config_driver.xml rename to testing_and_setup/compass/ocean/soma/4km/32to4km/config_driver.xml diff --git a/test/compass/ocean/soma/4km/32to4km/config_forward.xml b/testing_and_setup/compass/ocean/soma/4km/32to4km/config_forward.xml similarity index 100% rename from test/compass/ocean/soma/4km/32to4km/config_forward.xml rename to testing_and_setup/compass/ocean/soma/4km/32to4km/config_forward.xml diff --git a/test/compass/ocean/soma/4km/32to4km/config_init1.xml b/testing_and_setup/compass/ocean/soma/4km/32to4km/config_init1.xml similarity index 100% rename from test/compass/ocean/soma/4km/32to4km/config_init1.xml rename to testing_and_setup/compass/ocean/soma/4km/32to4km/config_init1.xml diff --git a/test/compass/ocean/soma/4km/32to4km/config_init2.xml b/testing_and_setup/compass/ocean/soma/4km/32to4km/config_init2.xml similarity index 100% rename from test/compass/ocean/soma/4km/32to4km/config_init2.xml rename to testing_and_setup/compass/ocean/soma/4km/32to4km/config_init2.xml diff --git a/test/compass/ocean/soma/4km/3layer/config_driver.xml b/testing_and_setup/compass/ocean/soma/4km/3layer/config_driver.xml similarity index 100% rename from test/compass/ocean/soma/4km/3layer/config_driver.xml rename to testing_and_setup/compass/ocean/soma/4km/3layer/config_driver.xml diff --git a/test/compass/ocean/soma/4km/3layer/config_forward.xml b/testing_and_setup/compass/ocean/soma/4km/3layer/config_forward.xml similarity index 100% rename from test/compass/ocean/soma/4km/3layer/config_forward.xml rename to testing_and_setup/compass/ocean/soma/4km/3layer/config_forward.xml diff --git a/test/compass/ocean/soma/4km/3layer/config_init1.xml b/testing_and_setup/compass/ocean/soma/4km/3layer/config_init1.xml similarity index 100% rename from test/compass/ocean/soma/4km/3layer/config_init1.xml rename to testing_and_setup/compass/ocean/soma/4km/3layer/config_init1.xml diff --git a/test/compass/ocean/soma/4km/3layer/config_init2.xml b/testing_and_setup/compass/ocean/soma/4km/3layer/config_init2.xml similarity index 100% rename from test/compass/ocean/soma/4km/3layer/config_init2.xml rename to testing_and_setup/compass/ocean/soma/4km/3layer/config_init2.xml diff --git a/test/compass/ocean/soma/4km/default/config_driver.xml b/testing_and_setup/compass/ocean/soma/4km/default/config_driver.xml similarity index 100% rename from test/compass/ocean/soma/4km/default/config_driver.xml rename to testing_and_setup/compass/ocean/soma/4km/default/config_driver.xml diff --git a/test/compass/ocean/soma/4km/default/config_forward.xml b/testing_and_setup/compass/ocean/soma/4km/default/config_forward.xml similarity index 100% rename from test/compass/ocean/soma/4km/default/config_forward.xml rename to testing_and_setup/compass/ocean/soma/4km/default/config_forward.xml diff --git a/test/compass/ocean/soma/4km/default/config_init1.xml b/testing_and_setup/compass/ocean/soma/4km/default/config_init1.xml similarity index 100% rename from test/compass/ocean/soma/4km/default/config_init1.xml rename to testing_and_setup/compass/ocean/soma/4km/default/config_init1.xml diff --git a/test/compass/ocean/soma/4km/default/config_init2.xml b/testing_and_setup/compass/ocean/soma/4km/default/config_init2.xml similarity index 100% rename from test/compass/ocean/soma/4km/default/config_init2.xml rename to testing_and_setup/compass/ocean/soma/4km/default/config_init2.xml diff --git a/test/compass/ocean/soma/4km/surface_restoring/config_driver.xml b/testing_and_setup/compass/ocean/soma/4km/surface_restoring/config_driver.xml similarity index 100% rename from test/compass/ocean/soma/4km/surface_restoring/config_driver.xml rename to testing_and_setup/compass/ocean/soma/4km/surface_restoring/config_driver.xml diff --git a/test/compass/ocean/soma/4km/surface_restoring/config_forward.xml b/testing_and_setup/compass/ocean/soma/4km/surface_restoring/config_forward.xml similarity index 100% rename from test/compass/ocean/soma/4km/surface_restoring/config_forward.xml rename to testing_and_setup/compass/ocean/soma/4km/surface_restoring/config_forward.xml diff --git a/test/compass/ocean/soma/4km/surface_restoring/config_init1.xml b/testing_and_setup/compass/ocean/soma/4km/surface_restoring/config_init1.xml similarity index 100% rename from test/compass/ocean/soma/4km/surface_restoring/config_init1.xml rename to testing_and_setup/compass/ocean/soma/4km/surface_restoring/config_init1.xml diff --git a/test/compass/ocean/soma/4km/surface_restoring/config_init2.xml b/testing_and_setup/compass/ocean/soma/4km/surface_restoring/config_init2.xml similarity index 100% rename from test/compass/ocean/soma/4km/surface_restoring/config_init2.xml rename to testing_and_setup/compass/ocean/soma/4km/surface_restoring/config_init2.xml diff --git a/test/compass/ocean/soma/8km/32to8km/config_driver.xml b/testing_and_setup/compass/ocean/soma/8km/32to8km/config_driver.xml similarity index 100% rename from test/compass/ocean/soma/8km/32to8km/config_driver.xml rename to testing_and_setup/compass/ocean/soma/8km/32to8km/config_driver.xml diff --git a/test/compass/ocean/soma/8km/32to8km/config_forward.xml b/testing_and_setup/compass/ocean/soma/8km/32to8km/config_forward.xml similarity index 100% rename from test/compass/ocean/soma/8km/32to8km/config_forward.xml rename to testing_and_setup/compass/ocean/soma/8km/32to8km/config_forward.xml diff --git a/test/compass/ocean/soma/8km/32to8km/config_init1.xml b/testing_and_setup/compass/ocean/soma/8km/32to8km/config_init1.xml similarity index 100% rename from test/compass/ocean/soma/8km/32to8km/config_init1.xml rename to testing_and_setup/compass/ocean/soma/8km/32to8km/config_init1.xml diff --git a/test/compass/ocean/soma/8km/32to8km/config_init2.xml b/testing_and_setup/compass/ocean/soma/8km/32to8km/config_init2.xml similarity index 100% rename from test/compass/ocean/soma/8km/32to8km/config_init2.xml rename to testing_and_setup/compass/ocean/soma/8km/32to8km/config_init2.xml diff --git a/test/compass/ocean/soma/8km/3layer/config_driver.xml b/testing_and_setup/compass/ocean/soma/8km/3layer/config_driver.xml similarity index 100% rename from test/compass/ocean/soma/8km/3layer/config_driver.xml rename to testing_and_setup/compass/ocean/soma/8km/3layer/config_driver.xml diff --git a/test/compass/ocean/soma/8km/3layer/config_forward.xml b/testing_and_setup/compass/ocean/soma/8km/3layer/config_forward.xml similarity index 100% rename from test/compass/ocean/soma/8km/3layer/config_forward.xml rename to testing_and_setup/compass/ocean/soma/8km/3layer/config_forward.xml diff --git a/test/compass/ocean/soma/8km/3layer/config_init1.xml b/testing_and_setup/compass/ocean/soma/8km/3layer/config_init1.xml similarity index 100% rename from test/compass/ocean/soma/8km/3layer/config_init1.xml rename to testing_and_setup/compass/ocean/soma/8km/3layer/config_init1.xml diff --git a/test/compass/ocean/soma/8km/3layer/config_init2.xml b/testing_and_setup/compass/ocean/soma/8km/3layer/config_init2.xml similarity index 100% rename from test/compass/ocean/soma/8km/3layer/config_init2.xml rename to testing_and_setup/compass/ocean/soma/8km/3layer/config_init2.xml diff --git a/test/compass/ocean/soma/8km/default/config_driver.xml b/testing_and_setup/compass/ocean/soma/8km/default/config_driver.xml similarity index 100% rename from test/compass/ocean/soma/8km/default/config_driver.xml rename to testing_and_setup/compass/ocean/soma/8km/default/config_driver.xml diff --git a/test/compass/ocean/soma/8km/default/config_forward.xml b/testing_and_setup/compass/ocean/soma/8km/default/config_forward.xml similarity index 100% rename from test/compass/ocean/soma/8km/default/config_forward.xml rename to testing_and_setup/compass/ocean/soma/8km/default/config_forward.xml diff --git a/test/compass/ocean/soma/8km/default/config_init1.xml b/testing_and_setup/compass/ocean/soma/8km/default/config_init1.xml similarity index 100% rename from test/compass/ocean/soma/8km/default/config_init1.xml rename to testing_and_setup/compass/ocean/soma/8km/default/config_init1.xml diff --git a/test/compass/ocean/soma/8km/default/config_init2.xml b/testing_and_setup/compass/ocean/soma/8km/default/config_init2.xml similarity index 100% rename from test/compass/ocean/soma/8km/default/config_init2.xml rename to testing_and_setup/compass/ocean/soma/8km/default/config_init2.xml diff --git a/test/compass/ocean/soma/8km/surface_restoring/config_driver.xml b/testing_and_setup/compass/ocean/soma/8km/surface_restoring/config_driver.xml similarity index 100% rename from test/compass/ocean/soma/8km/surface_restoring/config_driver.xml rename to testing_and_setup/compass/ocean/soma/8km/surface_restoring/config_driver.xml diff --git a/test/compass/ocean/soma/8km/surface_restoring/config_forward.xml b/testing_and_setup/compass/ocean/soma/8km/surface_restoring/config_forward.xml similarity index 100% rename from test/compass/ocean/soma/8km/surface_restoring/config_forward.xml rename to testing_and_setup/compass/ocean/soma/8km/surface_restoring/config_forward.xml diff --git a/test/compass/ocean/soma/8km/surface_restoring/config_init1.xml b/testing_and_setup/compass/ocean/soma/8km/surface_restoring/config_init1.xml similarity index 100% rename from test/compass/ocean/soma/8km/surface_restoring/config_init1.xml rename to testing_and_setup/compass/ocean/soma/8km/surface_restoring/config_init1.xml diff --git a/test/compass/ocean/soma/8km/surface_restoring/config_init2.xml b/testing_and_setup/compass/ocean/soma/8km/surface_restoring/config_init2.xml similarity index 100% rename from test/compass/ocean/soma/8km/surface_restoring/config_init2.xml rename to testing_and_setup/compass/ocean/soma/8km/surface_restoring/config_init2.xml diff --git a/test/compass/ocean/soma/soma_analysis_members.xml b/testing_and_setup/compass/ocean/soma/soma_analysis_members.xml similarity index 100% rename from test/compass/ocean/soma/soma_analysis_members.xml rename to testing_and_setup/compass/ocean/soma/soma_analysis_members.xml diff --git a/test/compass/ocean/soma/soma_run.xml b/testing_and_setup/compass/ocean/soma/soma_run.xml similarity index 100% rename from test/compass/ocean/soma/soma_run.xml rename to testing_and_setup/compass/ocean/soma/soma_run.xml diff --git a/test/compass/ocean/soma/soma_template.xml b/testing_and_setup/compass/ocean/soma/soma_template.xml similarity index 100% rename from test/compass/ocean/soma/soma_template.xml rename to testing_and_setup/compass/ocean/soma/soma_template.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/.gitignore b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/.gitignore similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/.gitignore rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/.gitignore diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_driver.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_driver.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_driver.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_driver.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_forward.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_forward.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_forward.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_forward.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_init1.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_init1.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_init1.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_init1.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_init2.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_init2.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_init2.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_init/config_init2.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_adjust_ssh.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_adjust_ssh.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_adjust_ssh.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_adjust_ssh.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_driver.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_driver.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_driver.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_driver.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_forward.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_forward.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_forward.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_forward.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_init1.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_init1.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_init1.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_init1.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_init2.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_init2.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_init2.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/Haney_number_iterative_init/config_init2.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/default/config_driver.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/default/config_driver.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/default/config_driver.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/default/config_driver.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/default/config_forward.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/default/config_forward.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/default/config_forward.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/default/config_forward.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/default/config_init1.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/default/config_init1.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/default/config_init1.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/default/config_init1.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/default/config_init2.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/default/config_init2.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/default/config_init2.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/default/config_init2.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/iterative_init/config_adjust_ssh.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/iterative_init/config_adjust_ssh.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/iterative_init/config_adjust_ssh.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/iterative_init/config_adjust_ssh.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/iterative_init/config_driver.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/iterative_init/config_driver.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/iterative_init/config_driver.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/iterative_init/config_driver.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/iterative_init/config_forward.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/iterative_init/config_forward.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/iterative_init/config_forward.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/iterative_init/config_forward.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/iterative_init/config_init1.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/iterative_init/config_init1.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/iterative_init/config_init1.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/iterative_init/config_init1.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/iterative_init/config_init2.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/iterative_init/config_init2.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/iterative_init/config_init2.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/iterative_init/config_init2.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/restart_test/config_adjust_ssh.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/restart_test/config_adjust_ssh.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/restart_test/config_adjust_ssh.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/restart_test/config_adjust_ssh.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/restart_test/config_driver.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/restart_test/config_driver.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/restart_test/config_driver.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/restart_test/config_driver.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/restart_test/config_full_run.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/restart_test/config_full_run.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/restart_test/config_full_run.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/restart_test/config_full_run.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/restart_test/config_init1.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/restart_test/config_init1.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/restart_test/config_init1.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/restart_test/config_init1.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/restart_test/config_init2.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/restart_test/config_init2.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/restart_test/config_init2.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/restart_test/config_init2.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/restart_test/config_restart_run.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/restart_test/config_restart_run.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/restart_test/config_restart_run.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/restart_test/config_restart_run.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/restart_test/restart_setup_template.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/restart_test/restart_setup_template.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/restart_test/restart_setup_template.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/restart_test/restart_setup_template.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/template_adjust_ssh.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/template_adjust_ssh.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/template_adjust_ssh.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/template_adjust_ssh.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/template_forward.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/template_forward.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/template_forward.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/template_forward.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/template_init.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/template_init.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/template_init.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/template_init.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/with_frazil/config_adjust_ssh.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/with_frazil/config_adjust_ssh.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/with_frazil/config_adjust_ssh.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/with_frazil/config_adjust_ssh.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/with_frazil/config_driver.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/with_frazil/config_driver.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/with_frazil/config_driver.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/with_frazil/config_driver.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/with_frazil/config_forward.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/with_frazil/config_forward.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/with_frazil/config_forward.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/with_frazil/config_forward.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/with_frazil/config_init1.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/with_frazil/config_init1.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/with_frazil/config_init1.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/with_frazil/config_init1.xml diff --git a/test/compass/ocean/sub_ice_shelf_2D/5km/with_frazil/config_init2.xml b/testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/with_frazil/config_init2.xml similarity index 100% rename from test/compass/ocean/sub_ice_shelf_2D/5km/with_frazil/config_init2.xml rename to testing_and_setup/compass/ocean/sub_ice_shelf_2D/5km/with_frazil/config_init2.xml diff --git a/test/compass/ocean/templates/analysis_members/debug_diagnostics.xml b/testing_and_setup/compass/ocean/templates/analysis_members/debug_diagnostics.xml similarity index 100% rename from test/compass/ocean/templates/analysis_members/debug_diagnostics.xml rename to testing_and_setup/compass/ocean/templates/analysis_members/debug_diagnostics.xml diff --git a/test/compass/ocean/templates/analysis_members/eddy_product_variables.xml b/testing_and_setup/compass/ocean/templates/analysis_members/eddy_product_variables.xml similarity index 100% rename from test/compass/ocean/templates/analysis_members/eddy_product_variables.xml rename to testing_and_setup/compass/ocean/templates/analysis_members/eddy_product_variables.xml diff --git a/test/compass/ocean/templates/analysis_members/eliassen_palm.xml b/testing_and_setup/compass/ocean/templates/analysis_members/eliassen_palm.xml similarity index 100% rename from test/compass/ocean/templates/analysis_members/eliassen_palm.xml rename to testing_and_setup/compass/ocean/templates/analysis_members/eliassen_palm.xml diff --git a/test/compass/ocean/templates/analysis_members/global_stats.xml b/testing_and_setup/compass/ocean/templates/analysis_members/global_stats.xml similarity index 100% rename from test/compass/ocean/templates/analysis_members/global_stats.xml rename to testing_and_setup/compass/ocean/templates/analysis_members/global_stats.xml diff --git a/test/compass/ocean/templates/analysis_members/global_stats_text_only.xml b/testing_and_setup/compass/ocean/templates/analysis_members/global_stats_text_only.xml similarity index 100% rename from test/compass/ocean/templates/analysis_members/global_stats_text_only.xml rename to testing_and_setup/compass/ocean/templates/analysis_members/global_stats_text_only.xml diff --git a/test/compass/ocean/templates/analysis_members/high_frequency_output.xml b/testing_and_setup/compass/ocean/templates/analysis_members/high_frequency_output.xml similarity index 100% rename from test/compass/ocean/templates/analysis_members/high_frequency_output.xml rename to testing_and_setup/compass/ocean/templates/analysis_members/high_frequency_output.xml diff --git a/test/compass/ocean/templates/analysis_members/lagrangian_particle_tracking.xml b/testing_and_setup/compass/ocean/templates/analysis_members/lagrangian_particle_tracking.xml similarity index 100% rename from test/compass/ocean/templates/analysis_members/lagrangian_particle_tracking.xml rename to testing_and_setup/compass/ocean/templates/analysis_members/lagrangian_particle_tracking.xml diff --git a/test/compass/ocean/templates/analysis_members/layer_volume_weighted_averages.xml b/testing_and_setup/compass/ocean/templates/analysis_members/layer_volume_weighted_averages.xml similarity index 100% rename from test/compass/ocean/templates/analysis_members/layer_volume_weighted_averages.xml rename to testing_and_setup/compass/ocean/templates/analysis_members/layer_volume_weighted_averages.xml diff --git a/test/compass/ocean/templates/analysis_members/meridional_heat_transport.xml b/testing_and_setup/compass/ocean/templates/analysis_members/meridional_heat_transport.xml similarity index 100% rename from test/compass/ocean/templates/analysis_members/meridional_heat_transport.xml rename to testing_and_setup/compass/ocean/templates/analysis_members/meridional_heat_transport.xml diff --git a/test/compass/ocean/templates/analysis_members/mixed_layer_depths.xml b/testing_and_setup/compass/ocean/templates/analysis_members/mixed_layer_depths.xml similarity index 100% rename from test/compass/ocean/templates/analysis_members/mixed_layer_depths.xml rename to testing_and_setup/compass/ocean/templates/analysis_members/mixed_layer_depths.xml diff --git a/test/compass/ocean/templates/analysis_members/okubo_weiss.xml b/testing_and_setup/compass/ocean/templates/analysis_members/okubo_weiss.xml similarity index 100% rename from test/compass/ocean/templates/analysis_members/okubo_weiss.xml rename to testing_and_setup/compass/ocean/templates/analysis_members/okubo_weiss.xml diff --git a/test/compass/ocean/templates/analysis_members/surface_area_weighted_averages.xml b/testing_and_setup/compass/ocean/templates/analysis_members/surface_area_weighted_averages.xml similarity index 100% rename from test/compass/ocean/templates/analysis_members/surface_area_weighted_averages.xml rename to testing_and_setup/compass/ocean/templates/analysis_members/surface_area_weighted_averages.xml diff --git a/test/compass/ocean/templates/analysis_members/test_compute_interval.xml b/testing_and_setup/compass/ocean/templates/analysis_members/test_compute_interval.xml similarity index 100% rename from test/compass/ocean/templates/analysis_members/test_compute_interval.xml rename to testing_and_setup/compass/ocean/templates/analysis_members/test_compute_interval.xml diff --git a/test/compass/ocean/templates/analysis_members/time_filters.xml b/testing_and_setup/compass/ocean/templates/analysis_members/time_filters.xml similarity index 100% rename from test/compass/ocean/templates/analysis_members/time_filters.xml rename to testing_and_setup/compass/ocean/templates/analysis_members/time_filters.xml diff --git a/test/compass/ocean/templates/analysis_members/time_series_stats.xml b/testing_and_setup/compass/ocean/templates/analysis_members/time_series_stats.xml similarity index 100% rename from test/compass/ocean/templates/analysis_members/time_series_stats.xml rename to testing_and_setup/compass/ocean/templates/analysis_members/time_series_stats.xml diff --git a/test/compass/ocean/templates/analysis_members/water_mass_census.xml b/testing_and_setup/compass/ocean/templates/analysis_members/water_mass_census.xml similarity index 100% rename from test/compass/ocean/templates/analysis_members/water_mass_census.xml rename to testing_and_setup/compass/ocean/templates/analysis_members/water_mass_census.xml diff --git a/test/compass/ocean/templates/analysis_members/zonal_mean.xml b/testing_and_setup/compass/ocean/templates/analysis_members/zonal_mean.xml similarity index 100% rename from test/compass/ocean/templates/analysis_members/zonal_mean.xml rename to testing_and_setup/compass/ocean/templates/analysis_members/zonal_mean.xml diff --git a/test/compass/ocean/templates/debugging.xml b/testing_and_setup/compass/ocean/templates/debugging.xml similarity index 100% rename from test/compass/ocean/templates/debugging.xml rename to testing_and_setup/compass/ocean/templates/debugging.xml diff --git a/test/compass/ocean/templates/streams/KPP_testing.xml b/testing_and_setup/compass/ocean/templates/streams/KPP_testing.xml similarity index 100% rename from test/compass/ocean/templates/streams/KPP_testing.xml rename to testing_and_setup/compass/ocean/templates/streams/KPP_testing.xml diff --git a/test/compass/ocean/templates/streams/forcing_data.xml b/testing_and_setup/compass/ocean/templates/streams/forcing_data.xml similarity index 100% rename from test/compass/ocean/templates/streams/forcing_data.xml rename to testing_and_setup/compass/ocean/templates/streams/forcing_data.xml diff --git a/test/compass/ocean/templates/streams/frazil.xml b/testing_and_setup/compass/ocean/templates/streams/frazil.xml similarity index 100% rename from test/compass/ocean/templates/streams/frazil.xml rename to testing_and_setup/compass/ocean/templates/streams/frazil.xml diff --git a/test/compass/ocean/templates/streams/land_ice_fluxes.xml b/testing_and_setup/compass/ocean/templates/streams/land_ice_fluxes.xml similarity index 100% rename from test/compass/ocean/templates/streams/land_ice_fluxes.xml rename to testing_and_setup/compass/ocean/templates/streams/land_ice_fluxes.xml diff --git a/test/compass/ocean/templates/streams/minimal_output.xml b/testing_and_setup/compass/ocean/templates/streams/minimal_output.xml similarity index 100% rename from test/compass/ocean/templates/streams/minimal_output.xml rename to testing_and_setup/compass/ocean/templates/streams/minimal_output.xml diff --git a/test/compass/ocean/templates/streams/output.xml b/testing_and_setup/compass/ocean/templates/streams/output.xml similarity index 100% rename from test/compass/ocean/templates/streams/output.xml rename to testing_and_setup/compass/ocean/templates/streams/output.xml diff --git a/test/compass/ocean/templates/streams/shortwave_forcing_data.xml b/testing_and_setup/compass/ocean/templates/streams/shortwave_forcing_data.xml similarity index 100% rename from test/compass/ocean/templates/streams/shortwave_forcing_data.xml rename to testing_and_setup/compass/ocean/templates/streams/shortwave_forcing_data.xml diff --git a/test/compass/ocean/templates/validations/LIGHT_comparison.xml b/testing_and_setup/compass/ocean/templates/validations/LIGHT_comparison.xml similarity index 100% rename from test/compass/ocean/templates/validations/LIGHT_comparison.xml rename to testing_and_setup/compass/ocean/templates/validations/LIGHT_comparison.xml diff --git a/test/compass/ocean/templates/validations/LIGHT_timers.xml b/testing_and_setup/compass/ocean/templates/validations/LIGHT_timers.xml similarity index 100% rename from test/compass/ocean/templates/validations/LIGHT_timers.xml rename to testing_and_setup/compass/ocean/templates/validations/LIGHT_timers.xml diff --git a/test/compass/ocean/templates/validations/ecosys_comparison.xml b/testing_and_setup/compass/ocean/templates/validations/ecosys_comparison.xml similarity index 100% rename from test/compass/ocean/templates/validations/ecosys_comparison.xml rename to testing_and_setup/compass/ocean/templates/validations/ecosys_comparison.xml diff --git a/test/compass/ocean/templates/validations/frazil_comparison.xml b/testing_and_setup/compass/ocean/templates/validations/frazil_comparison.xml similarity index 100% rename from test/compass/ocean/templates/validations/frazil_comparison.xml rename to testing_and_setup/compass/ocean/templates/validations/frazil_comparison.xml diff --git a/test/compass/ocean/templates/validations/land_ice_flux_comparison.xml b/testing_and_setup/compass/ocean/templates/validations/land_ice_flux_comparison.xml similarity index 100% rename from test/compass/ocean/templates/validations/land_ice_flux_comparison.xml rename to testing_and_setup/compass/ocean/templates/validations/land_ice_flux_comparison.xml diff --git a/test/compass/ocean/templates/validations/prognostic_comparison.xml b/testing_and_setup/compass/ocean/templates/validations/prognostic_comparison.xml similarity index 100% rename from test/compass/ocean/templates/validations/prognostic_comparison.xml rename to testing_and_setup/compass/ocean/templates/validations/prognostic_comparison.xml diff --git a/test/compass/ocean/ziso/10km/default/config_driver.xml b/testing_and_setup/compass/ocean/ziso/10km/default/config_driver.xml similarity index 100% rename from test/compass/ocean/ziso/10km/default/config_driver.xml rename to testing_and_setup/compass/ocean/ziso/10km/default/config_driver.xml diff --git a/test/compass/ocean/ziso/10km/default/config_forward.xml b/testing_and_setup/compass/ocean/ziso/10km/default/config_forward.xml similarity index 100% rename from test/compass/ocean/ziso/10km/default/config_forward.xml rename to testing_and_setup/compass/ocean/ziso/10km/default/config_forward.xml diff --git a/test/compass/ocean/ziso/10km/default/config_init1.xml b/testing_and_setup/compass/ocean/ziso/10km/default/config_init1.xml similarity index 100% rename from test/compass/ocean/ziso/10km/default/config_init1.xml rename to testing_and_setup/compass/ocean/ziso/10km/default/config_init1.xml diff --git a/test/compass/ocean/ziso/10km/default/config_init2.xml b/testing_and_setup/compass/ocean/ziso/10km/default/config_init2.xml similarity index 100% rename from test/compass/ocean/ziso/10km/default/config_init2.xml rename to testing_and_setup/compass/ocean/ziso/10km/default/config_init2.xml diff --git a/test/compass/ocean/ziso/2.5km/default/config_driver.xml b/testing_and_setup/compass/ocean/ziso/2.5km/default/config_driver.xml similarity index 100% rename from test/compass/ocean/ziso/2.5km/default/config_driver.xml rename to testing_and_setup/compass/ocean/ziso/2.5km/default/config_driver.xml diff --git a/test/compass/ocean/ziso/2.5km/default/config_forward.xml b/testing_and_setup/compass/ocean/ziso/2.5km/default/config_forward.xml similarity index 100% rename from test/compass/ocean/ziso/2.5km/default/config_forward.xml rename to testing_and_setup/compass/ocean/ziso/2.5km/default/config_forward.xml diff --git a/test/compass/ocean/ziso/2.5km/default/config_init1.xml b/testing_and_setup/compass/ocean/ziso/2.5km/default/config_init1.xml similarity index 100% rename from test/compass/ocean/ziso/2.5km/default/config_init1.xml rename to testing_and_setup/compass/ocean/ziso/2.5km/default/config_init1.xml diff --git a/test/compass/ocean/ziso/2.5km/default/config_init2.xml b/testing_and_setup/compass/ocean/ziso/2.5km/default/config_init2.xml similarity index 100% rename from test/compass/ocean/ziso/2.5km/default/config_init2.xml rename to testing_and_setup/compass/ocean/ziso/2.5km/default/config_init2.xml diff --git a/test/compass/ocean/ziso/20km/default/config_driver.xml b/testing_and_setup/compass/ocean/ziso/20km/default/config_driver.xml similarity index 100% rename from test/compass/ocean/ziso/20km/default/config_driver.xml rename to testing_and_setup/compass/ocean/ziso/20km/default/config_driver.xml diff --git a/test/compass/ocean/ziso/20km/default/config_forward.xml b/testing_and_setup/compass/ocean/ziso/20km/default/config_forward.xml similarity index 100% rename from test/compass/ocean/ziso/20km/default/config_forward.xml rename to testing_and_setup/compass/ocean/ziso/20km/default/config_forward.xml diff --git a/test/compass/ocean/ziso/20km/default/config_init1.xml b/testing_and_setup/compass/ocean/ziso/20km/default/config_init1.xml similarity index 100% rename from test/compass/ocean/ziso/20km/default/config_init1.xml rename to testing_and_setup/compass/ocean/ziso/20km/default/config_init1.xml diff --git a/test/compass/ocean/ziso/20km/default/config_init2.xml b/testing_and_setup/compass/ocean/ziso/20km/default/config_init2.xml similarity index 100% rename from test/compass/ocean/ziso/20km/default/config_init2.xml rename to testing_and_setup/compass/ocean/ziso/20km/default/config_init2.xml diff --git a/test/compass/ocean/ziso/20km/with_frazil/config_driver.xml b/testing_and_setup/compass/ocean/ziso/20km/with_frazil/config_driver.xml similarity index 100% rename from test/compass/ocean/ziso/20km/with_frazil/config_driver.xml rename to testing_and_setup/compass/ocean/ziso/20km/with_frazil/config_driver.xml diff --git a/test/compass/ocean/ziso/20km/with_frazil/config_forward.xml b/testing_and_setup/compass/ocean/ziso/20km/with_frazil/config_forward.xml similarity index 100% rename from test/compass/ocean/ziso/20km/with_frazil/config_forward.xml rename to testing_and_setup/compass/ocean/ziso/20km/with_frazil/config_forward.xml diff --git a/test/compass/ocean/ziso/20km/with_frazil/config_init1.xml b/testing_and_setup/compass/ocean/ziso/20km/with_frazil/config_init1.xml similarity index 100% rename from test/compass/ocean/ziso/20km/with_frazil/config_init1.xml rename to testing_and_setup/compass/ocean/ziso/20km/with_frazil/config_init1.xml diff --git a/test/compass/ocean/ziso/20km/with_frazil/config_init2.xml b/testing_and_setup/compass/ocean/ziso/20km/with_frazil/config_init2.xml similarity index 100% rename from test/compass/ocean/ziso/20km/with_frazil/config_init2.xml rename to testing_and_setup/compass/ocean/ziso/20km/with_frazil/config_init2.xml diff --git a/test/compass/ocean/ziso/5km/default/config_driver.xml b/testing_and_setup/compass/ocean/ziso/5km/default/config_driver.xml similarity index 100% rename from test/compass/ocean/ziso/5km/default/config_driver.xml rename to testing_and_setup/compass/ocean/ziso/5km/default/config_driver.xml diff --git a/test/compass/ocean/ziso/5km/default/config_forward.xml b/testing_and_setup/compass/ocean/ziso/5km/default/config_forward.xml similarity index 100% rename from test/compass/ocean/ziso/5km/default/config_forward.xml rename to testing_and_setup/compass/ocean/ziso/5km/default/config_forward.xml diff --git a/test/compass/ocean/ziso/5km/default/config_init1.xml b/testing_and_setup/compass/ocean/ziso/5km/default/config_init1.xml similarity index 100% rename from test/compass/ocean/ziso/5km/default/config_init1.xml rename to testing_and_setup/compass/ocean/ziso/5km/default/config_init1.xml diff --git a/test/compass/ocean/ziso/5km/default/config_init2.xml b/testing_and_setup/compass/ocean/ziso/5km/default/config_init2.xml similarity index 100% rename from test/compass/ocean/ziso/5km/default/config_init2.xml rename to testing_and_setup/compass/ocean/ziso/5km/default/config_init2.xml diff --git a/test/compass/ocean/ziso/ziso_analysis_members.xml b/testing_and_setup/compass/ocean/ziso/ziso_analysis_members.xml similarity index 100% rename from test/compass/ocean/ziso/ziso_analysis_members.xml rename to testing_and_setup/compass/ocean/ziso/ziso_analysis_members.xml diff --git a/test/compass/ocean/ziso/ziso_run.xml b/testing_and_setup/compass/ocean/ziso/ziso_run.xml similarity index 100% rename from test/compass/ocean/ziso/ziso_run.xml rename to testing_and_setup/compass/ocean/ziso/ziso_run.xml diff --git a/test/compass/ocean/ziso/ziso_template.xml b/testing_and_setup/compass/ocean/ziso/ziso_template.xml similarity index 100% rename from test/compass/ocean/ziso/ziso_template.xml rename to testing_and_setup/compass/ocean/ziso/ziso_template.xml diff --git a/test/compass/runtime_definitions/mpirun.xml b/testing_and_setup/compass/runtime_definitions/mpirun.xml similarity index 100% rename from test/compass/runtime_definitions/mpirun.xml rename to testing_and_setup/compass/runtime_definitions/mpirun.xml diff --git a/test/compass/runtime_definitions/srun.xml b/testing_and_setup/compass/runtime_definitions/srun.xml similarity index 100% rename from test/compass/runtime_definitions/srun.xml rename to testing_and_setup/compass/runtime_definitions/srun.xml diff --git a/test/compass/setup_testcase.py b/testing_and_setup/compass/setup_testcase.py similarity index 100% rename from test/compass/setup_testcase.py rename to testing_and_setup/compass/setup_testcase.py diff --git a/test/compass/test/basic_spherical/960km/.gitignore b/testing_and_setup/compass/test/basic_spherical/960km/.gitignore similarity index 100% rename from test/compass/test/basic_spherical/960km/.gitignore rename to testing_and_setup/compass/test/basic_spherical/960km/.gitignore diff --git a/test/compass/test/basic_spherical/960km/default/config_driver.xml b/testing_and_setup/compass/test/basic_spherical/960km/default/config_driver.xml similarity index 100% rename from test/compass/test/basic_spherical/960km/default/config_driver.xml rename to testing_and_setup/compass/test/basic_spherical/960km/default/config_driver.xml diff --git a/test/compass/test/basic_spherical/960km/default/config_test.xml b/testing_and_setup/compass/test/basic_spherical/960km/default/config_test.xml similarity index 100% rename from test/compass/test/basic_spherical/960km/default/config_test.xml rename to testing_and_setup/compass/test/basic_spherical/960km/default/config_test.xml diff --git a/test/compass/test/example_regression_suite.xml b/testing_and_setup/compass/test/example_regression_suite.xml similarity index 100% rename from test/compass/test/example_regression_suite.xml rename to testing_and_setup/compass/test/example_regression_suite.xml diff --git a/test/compass/utility_scripts/check_progress.py b/testing_and_setup/compass/utility_scripts/check_progress.py similarity index 100% rename from test/compass/utility_scripts/check_progress.py rename to testing_and_setup/compass/utility_scripts/check_progress.py diff --git a/test/compass/utility_scripts/compare_fields.py b/testing_and_setup/compass/utility_scripts/compare_fields.py similarity index 100% rename from test/compass/utility_scripts/compare_fields.py rename to testing_and_setup/compass/utility_scripts/compare_fields.py diff --git a/test/compass/utility_scripts/compare_timers.py b/testing_and_setup/compass/utility_scripts/compare_timers.py similarity index 100% rename from test/compass/utility_scripts/compare_timers.py rename to testing_and_setup/compass/utility_scripts/compare_timers.py diff --git a/test/compass/utility_scripts/make_graph_file.py b/testing_and_setup/compass/utility_scripts/make_graph_file.py similarity index 100% rename from test/compass/utility_scripts/make_graph_file.py rename to testing_and_setup/compass/utility_scripts/make_graph_file.py diff --git a/test/compass/utility_scripts/make_parameter_study_configs.py b/testing_and_setup/compass/utility_scripts/make_parameter_study_configs.py similarity index 100% rename from test/compass/utility_scripts/make_parameter_study_configs.py rename to testing_and_setup/compass/utility_scripts/make_parameter_study_configs.py diff --git a/test/compass/utility_scripts/setup_restart.py b/testing_and_setup/compass/utility_scripts/setup_restart.py similarity index 100% rename from test/compass/utility_scripts/setup_restart.py rename to testing_and_setup/compass/utility_scripts/setup_restart.py diff --git a/test/seaice/configurations/standard_bgc/namelist.seaice b/testing_and_setup/seaice/configurations/standard_bgc/namelist.seaice similarity index 100% rename from test/seaice/configurations/standard_bgc/namelist.seaice rename to testing_and_setup/seaice/configurations/standard_bgc/namelist.seaice diff --git a/test/seaice/configurations/standard_physics/README b/testing_and_setup/seaice/configurations/standard_physics/README similarity index 100% rename from test/seaice/configurations/standard_physics/README rename to testing_and_setup/seaice/configurations/standard_physics/README diff --git a/test/seaice/configurations/standard_physics/namelist.seaice b/testing_and_setup/seaice/configurations/standard_physics/namelist.seaice similarity index 100% rename from test/seaice/configurations/standard_physics/namelist.seaice rename to testing_and_setup/seaice/configurations/standard_physics/namelist.seaice diff --git a/test/seaice/configurations/standard_physics_single_cell/namelist.seaice b/testing_and_setup/seaice/configurations/standard_physics_single_cell/namelist.seaice similarity index 100% rename from test/seaice/configurations/standard_physics_single_cell/namelist.seaice rename to testing_and_setup/seaice/configurations/standard_physics_single_cell/namelist.seaice diff --git a/test/seaice/testing/.gitignore b/testing_and_setup/seaice/testing/.gitignore similarity index 100% rename from test/seaice/testing/.gitignore rename to testing_and_setup/seaice/testing/.gitignore diff --git a/test/seaice/testing/README b/testing_and_setup/seaice/testing/README similarity index 100% rename from test/seaice/testing/README rename to testing_and_setup/seaice/testing/README diff --git a/test/seaice/testing/compare_mpas_files.py b/testing_and_setup/seaice/testing/compare_mpas_files.py similarity index 100% rename from test/seaice/testing/compare_mpas_files.py rename to testing_and_setup/seaice/testing/compare_mpas_files.py diff --git a/test/seaice/testing/test_mpas-seaice.py b/testing_and_setup/seaice/testing/test_mpas-seaice.py similarity index 100% rename from test/seaice/testing/test_mpas-seaice.py rename to testing_and_setup/seaice/testing/test_mpas-seaice.py diff --git a/test/seaice/testing/testing_utils.py b/testing_and_setup/seaice/testing/testing_utils.py similarity index 100% rename from test/seaice/testing/testing_utils.py rename to testing_and_setup/seaice/testing/testing_utils.py diff --git a/test/seaice/testing/tests/parallelism.py b/testing_and_setup/seaice/testing/tests/parallelism.py similarity index 100% rename from test/seaice/testing/tests/parallelism.py rename to testing_and_setup/seaice/testing/tests/parallelism.py diff --git a/test/seaice/testing/tests/regression.py b/testing_and_setup/seaice/testing/tests/regression.py similarity index 100% rename from test/seaice/testing/tests/regression.py rename to testing_and_setup/seaice/testing/tests/regression.py diff --git a/test/seaice/testing/tests/restartability.py b/testing_and_setup/seaice/testing/tests/restartability.py similarity index 100% rename from test/seaice/testing/tests/restartability.py rename to testing_and_setup/seaice/testing/tests/restartability.py diff --git a/test/seaice/testing/testsuites/testsuite.standard.xml b/testing_and_setup/seaice/testing/testsuites/testsuite.standard.xml similarity index 100% rename from test/seaice/testing/testsuites/testsuite.standard.xml rename to testing_and_setup/seaice/testing/testsuites/testsuite.standard.xml diff --git a/test/seaice/testing/testsuites/testsuite.standard_bgc.xml b/testing_and_setup/seaice/testing/testsuites/testsuite.standard_bgc.xml similarity index 100% rename from test/seaice/testing/testsuites/testsuite.standard_bgc.xml rename to testing_and_setup/seaice/testing/testsuites/testsuite.standard_bgc.xml