diff --git a/.github/workflows/basic_checks.yml b/.github/workflows/basic_checks.yml new file mode 100644 index 000000000..4e40790b5 --- /dev/null +++ b/.github/workflows/basic_checks.yml @@ -0,0 +1,21 @@ +name: Basic checks for CCPP physics schemes + +on: [push, pull_request] + +jobs: + build: + + runs-on: macos-latest + + steps: + - name: Checkout + uses: actions/checkout@v2 + - name: Init submodules + run: git submodule update --init --recursive + #- name: Update packages + # run: | + # /usr/bin/ruby -e "$(curl -fsSL https://raw.githubusercontent.com/Homebrew/install/master/install)" + # #brew install autoconf automake coreutils gcc@9 libtool mpich gnu-sed wget + # brew install automake coreutils mpich gnu-sed + - name: Check for ASCII encoding + run: ./tools/check_encoding.py diff --git a/.gitmodules b/.gitmodules new file mode 100644 index 000000000..8421166ca --- /dev/null +++ b/.gitmodules @@ -0,0 +1,4 @@ +[submodule "physics/rte-rrtmgp"] + path = physics/rte-rrtmgp + url = https://github.com/RobertPincus/rte-rrtmgp + branch = dtc/ccpp diff --git a/CMakeLists.txt b/CMakeLists.txt index 8e6785c71..5e0175d0c 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -5,40 +5,21 @@ if(NOT PROJECT) endif (NOT PROJECT) #------------------------------------------------------------------------------ -cmake_minimum_required(VERSION 2.8.11) +cmake_minimum_required(VERSION 3.0) + +project(ccppphys + VERSION 4.0.0 + LANGUAGES C CXX Fortran) # Use rpaths on MacOSX set(CMAKE_MACOSX_RPATH 1) - -if(POLICY CMP0048) - cmake_policy(SET CMP0048 NEW) - project(ccppphys VERSION 3.0.0) -else(POLICY CMP0048) - project(ccppphys) - set(PROJECT_VERSION 3.0.0) - set(PROJECT_VERSION_MAJOR 3) - set(PROJECT_VERSION_MINOR 0) - set(PROJECT_VERSION_PATCH 0) -endif(POLICY CMP0048) - if(POLICY CMP0042) cmake_policy(SET CMP0042 NEW) endif(POLICY CMP0042) #------------------------------------------------------------------------------ set(PACKAGE "ccpp-physics") -set(AUTHORS "Grant J. Firl" "Dom Heinzeller") - -#------------------------------------------------------------------------------ -# Enable Fortran -enable_language(Fortran) - -if (PROJECT STREQUAL "CCPP-SCM") - #------------------------------------------------------------------------------ - # CMake Modules - # Set the CMake module path - list(APPEND CMAKE_MODULE_PATH "${CMAKE_CURRENT_SOURCE_DIR}/../framework/cmake") -endif (PROJECT STREQUAL "CCPP-SCM") +set(AUTHORS "Grant Firl" "Dom Heinzeller" "Man Zhang" "Laurie Carson") #------------------------------------------------------------------------------ # Set OpenMP flags for C/C++/Fortran @@ -77,41 +58,42 @@ if(NOT CMAKE_BUILD_TYPE AND NOT CMAKE_CONFIGURATION_TYPES) endif() #------------------------------------------------------------------------------ -# By default we want a shared library (unless a static build is requested) -if(STATIC) - option(BUILD_SHARED_LIBS "Build a static library" OFF) -else(STATIC) - option(BUILD_SHARED_LIBS "Build a shared library" ON) -endif(STATIC) +# Request a static build +option(BUILD_SHARED_LIBS "Build a shared library" OFF) #------------------------------------------------------------------------------ -# Add the CCPP include/module directory -set(CCPP_INCLUDE_DIRS "" CACHE FILEPATH "Path to ccpp includes") -set_property(DIRECTORY PROPERTY INCLUDE_DIRECTORIES ${CCPP_INCLUDE_DIRS}) - -#------------------------------------------------------------------------------ -# Add the CCPP library -set(CCPP_LIB_DIRS "" CACHE FILEPATH "Path to ccpp library") -link_directories(${CCPP_LIB_DIRS}) -list(APPEND LIBS "ccpp") +# Set the sources: physics type definitions +set(TYPEDEFS $ENV{CCPP_TYPEDEFS}) +if(TYPEDEFS) + message(STATUS "Got CCPP TYPEDEFS from environment variable: ${TYPEDEFS}") +else(TYPEDEFS) + include(./CCPP_TYPEDEFS.cmake) + message(STATUS "Got CCPP TYPEDEFS from cmakefile include file: ${TYPEDEFS}") +endif(TYPEDEFS) + +# Generate list of Fortran modules from the CCPP type +# definitions that need need to be installed +foreach(typedef_module ${TYPEDEFS}) + list(APPEND MODULES_F90 ${CMAKE_CURRENT_BINARY_DIR}/${typedef_module}) +endforeach() #------------------------------------------------------------------------------ # Set the sources: physics schemes set(SCHEMES $ENV{CCPP_SCHEMES}) if(SCHEMES) - message(INFO "Got CCPP_SCHEMES from environment variable: ${SCHEMES}") + message(STATUS "Got CCPP SCHEMES from environment variable: ${SCHEMES}") else(SCHEMES) include(./CCPP_SCHEMES.cmake) - message(INFO "Got SCHEMES from cmakefile include file: ${SCHEMES}") + message(STATUS "Got CCPP SCHEMES from cmakefile include file: ${SCHEMES}") endif(SCHEMES) # Set the sources: physics scheme caps set(CAPS $ENV{CCPP_CAPS}) if(CAPS) - message(INFO "Got CAPS from environment variable: ${CAPS}") + message(STATUS "Got CCPP CAPS from environment variable: ${CAPS}") else(CAPS) include(./CCPP_CAPS.cmake) - message(INFO "Got CAPS from cmakefile include file: ${CAPS}") + message(STATUS "Got CCPP CAPS from cmakefile include file: ${CAPS}") endif(CAPS) # Create empty lists for schemes with special compiler optimization flags @@ -342,51 +324,19 @@ elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "PGI") set_property(SOURCE ${CAPS} APPEND_STRING PROPERTY COMPILE_FLAGS " -Mnobounds ") endif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") -if (PROJECT STREQUAL "CCPP-SCM") - INCLUDE_DIRECTORIES(${CMAKE_BINARY_DIR}/ccpp/framework/src) -endif (PROJECT STREQUAL "CCPP-SCM") - #------------------------------------------------------------------------------ - -if(STATIC) - add_library(ccppphys STATIC ${SCHEMES} ${SCHEMES_SFX_OPT} ${CAPS}) - # Generate list of Fortran modules from defined sources - foreach(source_f90 ${CAPS}) - get_filename_component(tmp_source_f90 ${source_f90} NAME) - string(REGEX REPLACE ".F90" ".mod" tmp_module_f90 ${tmp_source_f90}) - string(TOLOWER ${tmp_module_f90} module_f90) - list(APPEND MODULES_F90 ${CMAKE_CURRENT_BINARY_DIR}/${module_f90}) - endforeach() -else(STATIC) - add_library(ccppphys SHARED ${SCHEMES} ${SCHEMES_SFX_OPT} ${CAPS}) -endif(STATIC) - -if (NOT STATIC) - target_link_libraries(ccppphys LINK_PUBLIC ${LIBS} ${BACIO_LIB4} ${SP_LIBd} ${W3NCO_LIBd}) -endif (NOT STATIC) +add_library(ccppphys STATIC ${SCHEMES} ${SCHEMES_SFX_OPT} ${CAPS}) +# Generate list of Fortran modules from defined sources +foreach(source_f90 ${CAPS}) + get_filename_component(tmp_source_f90 ${source_f90} NAME) + string(REGEX REPLACE ".F90" ".mod" tmp_module_f90 ${tmp_source_f90}) + string(TOLOWER ${tmp_module_f90} module_f90) + list(APPEND MODULES_F90 ${CMAKE_CURRENT_BINARY_DIR}/${module_f90}) +endforeach() set_target_properties(ccppphys PROPERTIES VERSION ${PROJECT_VERSION} SOVERSION ${PROJECT_VERSION_MAJOR}) -# DH* Hack for PGI compiler: rename objects in scheme cap object files for ISO_C compliancy, -# this is only needed for dynamics builds - static build generates plain Fortran code. -if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "PGI") - if (NOT STATIC) - set(CAPOBJS) - foreach(cap ${CAPS}) - string(REPLACE "_cap.F90" "_cap.F90.o" capobj "./${CMAKE_FILES_DIRECTORY}/ccppphys.dir/${cap}") - list(APPEND CAPOBJS ${capobj}) - endforeach(cap) - - add_custom_command(TARGET ccppphys - PRE_LINK - COMMAND ${CMAKE_CURRENT_SOURCE_DIR}/pgifix.py --cmake ${CAPOBJS} - WORKING_DIRECTORY ${CMAKE_CURRENT_BINARY_DIR} - COMMENT "Running pgifix_wrapper.py over all scheme caps") - endif (NOT STATIC) -endif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "PGI") -# *DH end hack for PGI compiler - if (PROJECT STREQUAL "CCPP-FV3") # Define where to install the library install(TARGETS ccppphys @@ -400,9 +350,7 @@ if (PROJECT STREQUAL "CCPP-FV3") FILE ccppphys-config.cmake DESTINATION lib/cmake ) - if(STATIC) - # Define where to install the C headers and Fortran modules - #install(FILES ${HEADERS_C} DESTINATION include) - install(FILES ${MODULES_F90} DESTINATION include) - endif(STATIC) + # Define where to install the C headers and Fortran modules + #install(FILES ${HEADERS_C} DESTINATION include) + install(FILES ${MODULES_F90} DESTINATION include) endif (PROJECT STREQUAL "CCPP-FV3") diff --git a/README.md b/README.md index 534b01a90..c1964c445 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,18 @@ -# GMTB GFS Physics +# CCPP Physics -This repository contains the GFS Physics scheme. +The Common Community Physics Package (CCPP) is designed to facilitate the implementation of physics innovations in state-of-the-art atmospheric models, the use of various models to develop physics, and the acceleration of transition of physics innovations to operational NOAA models. +Please see more information about the CCPP at the locations below. +- [CCPP website hosted by the Developmental Testbed Center (DTC)](https://dtcenter.org/ccpp) +- [CCPP public release information](https://dtcenter.org/community-code/common-community-physics-package-ccpp/ccpp-scm-version-4-0) +- [CCPP Technical Documentation](https://ccpp-techdoc.readthedocs.io/en/latest/) +- [CCPP Scientific Documentation](https://dtcenter.org/GMTB/v4.0/sci_doc/) +- [CCPP Physics GutHub wiki](https://github.com/NCAR/ccpp-physics/wiki) +- [CCPP Framework GitHub wiki](https://github.com/NCAR/ccpp-framework/wiki) + +For the use of CCPP with its Single Column Model, see the [Single Column Model User's Guide](https://dtcenter.org/GMTB/v4.0/scm-ccpp-guide-v4.0.pdf). + +For the use of CCPP with NOAA's Unified Forecast System (UFS), see the [UFS Medium-Range Application User's Guide](https://ufs-mrweather-app.readthedocs.io/en/latest/) and the [UFS Weather Model User's Guide](https://ufs-weather-model.readthedocs.io/en/latest/). + +Questions can be directed to the [CCPP Help Desk](mailto:gmtb-help@ucar.edu). When using the CCPP with NOAA's UFS, questions can be posted in the [UFS Weather Model](https://forums.ufscommunity.org/forum/ufs-weather-model) section of the [UFS Forum](https://forums.ufscommunity.org/) diff --git a/pgifix.py b/pgifix.py deleted file mode 100755 index cc6af76d2..000000000 --- a/pgifix.py +++ /dev/null @@ -1,93 +0,0 @@ -#!/usr/bin/env python - -import argparse -import os -import subprocess -import sys - -parser = argparse.ArgumentParser(description='Fix cap objects produced by PGI compiler') -parser.add_argument("--cmake", default=False, action='store_true') -parser.add_argument("caps", nargs='+') - -FIXCMD_TEMPLATE = 'objcopy ' - -def parse_args(): - args = parser.parse_args() - cmake = args.cmake - caps = args.caps - return (cmake, caps) - -def execute(cmd, debug = True, abort = True): - """Runs a local command in a shell. Waits for completion and - returns status, stdout and stderr. If abort = True, abort in - case an error occurs during the execution of the command.""" - - if debug: - print 'Executing "{0}"'.format(cmd) - p = subprocess.Popen(cmd, stdout = subprocess.PIPE, - stderr = subprocess.PIPE, shell = True) - (stdout, stderr) = p.communicate() - status = p.returncode - if debug: - message = 'Execution of "{0}" returned with exit code {1}\n'.format(cmd, status) - message += ' stdout: "{0}"\n'.format(stdout.rstrip('\n')) - message += ' stderr: "{0}"'.format(stderr.rstrip('\n')) - print message - if not status == 0: - message = 'Execution of command {0} failed, exit code {1}\n'.format(cmd, status) - message += ' stdout: "{0}"\n'.format(stdout.rstrip('\n')) - message += ' stderr: "{0}"'.format(stderr.rstrip('\n')) - if abort: - raise Exception(message) - else: - print message - return (status, stdout.rstrip('\n'), stderr.rstrip('\n')) - -def correct_cap_object_names(fixcmd, cmake, cap): - (cappath, capname) = os.path.split(cap) - # Determine pgi-prepended prefix to remove, different - # for cmake builds and make builds (object filename) - if cmake: - pgiprefix = capname.rstrip('.F90.o').lower() + '_' - else: - pgiprefix = capname.rstrip('.o').lower() + '_' - # Get list of all symbols in cap object - nmcmd = 'nm {0}'.format(cap) - (status, stdout, stderr) = execute(nmcmd) - del nmcmd - # Parse all symbols and generate objcopy command - found = False - for line in stdout.split('\n'): - try: - (address, symboltype, objectname) = line.split() - except ValueError: - continue - if not symboltype == 'T': - continue - if objectname.startswith(pgiprefix): - newname = objectname[len(pgiprefix):] - else: - continue - if newname.endswith('_cap'): - fixcmd += '--redefine-sym {0}={1} '.format(objectname, newname) - found = True - if not found: - raise Exception('Unable to rename CCPP scheme caps in cap "{0}"'.format(cap)) - return fixcmd - -def correct_object_names(fixcmd, cap): - tmp = cap + '.tmp' - fixcmd += '{0} {1}'.format(cap, tmp) - execute(fixcmd) - mvcmd = 'mv -v {0} {1}'.format(tmp, cap) - execute(mvcmd) - -def main(): - (cmake, caps) = parse_args() - for cap in caps: - fixcmd = FIXCMD_TEMPLATE - fixcmd = correct_cap_object_names(fixcmd, cmake, cap) - correct_object_names(fixcmd, cap) - -if __name__ == '__main__': - main() diff --git a/physics/GFS_DCNV_generic.F90 b/physics/GFS_DCNV_generic.F90 index 95430c732..bfe97bc70 100644 --- a/physics/GFS_DCNV_generic.F90 +++ b/physics/GFS_DCNV_generic.F90 @@ -11,23 +11,21 @@ end subroutine GFS_DCNV_generic_pre_init subroutine GFS_DCNV_generic_pre_finalize() end subroutine GFS_DCNV_generic_pre_finalize -#if 0 !> \brief Interstitial scheme called prior to any deep convective scheme to save state variables for calculating tendencies after the deep convective scheme is executed !! \section arg_table_GFS_DCNV_generic_pre_run Argument Table !! \htmlinclude GFS_DCNV_generic_pre_run.html !! -#endif - subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, do_ca, cplchm,& - isppt_deep, gu0, gv0, gt0, gq0_water_vapor, & - save_u, save_v, save_t, save_qv, ca_deep, & - dqdti, errmsg, errflg) + subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, cplchm,& + gu0, gv0, gt0, gq0_water_vapor, & + save_u, save_v, save_t, save_qv, dqdti, & + errmsg, errflg) use machine, only: kind_phys implicit none integer, intent(in) :: im, levs - logical, intent(in) :: ldiag3d, do_cnvgwd, do_ca, cplchm, isppt_deep, qdiag3d + logical, intent(in) :: ldiag3d, qdiag3d, do_cnvgwd, cplchm real(kind=kind_phys), dimension(im,levs), intent(in) :: gu0 real(kind=kind_phys), dimension(im,levs), intent(in) :: gv0 real(kind=kind_phys), dimension(im,levs), intent(in) :: gt0 @@ -36,7 +34,6 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, do_c real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_v real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_t real(kind=kind_phys), dimension(im,levs), intent(inout) :: save_qv - real(kind=kind_phys), dimension(im), intent(in) :: ca_deep ! dqdti only allocated if cplchm is .true. real(kind=kind_phys), dimension(:,:), intent(inout) :: dqdti character(len=*), intent(out) :: errmsg @@ -49,15 +46,7 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, do_c errmsg = '' errflg = 0 - if (do_ca) then - do k=1,levs - do i=1,im - gq0_water_vapor(i,k) = gq0_water_vapor(i,k)*(1.0 + ca_deep(i)/500.) - enddo - enddo - endif - - if (ldiag3d .or. isppt_deep) then + if (ldiag3d) then do k=1,levs do i=1,im save_t(i,k) = gt0(i,k) @@ -73,7 +62,7 @@ subroutine GFS_DCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, do_cnvgwd, do_c enddo endif - if ((ldiag3d.and.qdiag3d) .or. cplchm .or. isppt_deep) then + if ((ldiag3d.and.qdiag3d) .or. cplchm) then do k=1,levs do i=1,im save_qv(i,k) = gq0_water_vapor(i,k) @@ -102,19 +91,19 @@ end subroutine GFS_DCNV_generic_post_finalize !> \section arg_table_GFS_DCNV_generic_post_run Argument Table !! \htmlinclude GFS_DCNV_generic_post_run.html !! - subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, cscnv, do_ca, & - isppt_deep, frain, rain1, dtf, cld1d, save_u, save_v, save_t, save_qv, gu0, gv0, gt0, & - gq0_water_vapor, ud_mf, dd_mf, dt_mf, con_g, clw_ice, clw_liquid, npdf3d, num_p3d, ncnvcld3d, & - rainc, cldwrk, dt3dt, dq3dt, du3dt, dv3dt, upd_mf, dwn_mf, det_mf, & - cnvw, cnvc, cnvw_phy_f3d, cnvc_phy_f3d, flag_for_dcnv_generic_tend, & - cape, tconvtend, qconvtend, uconvtend, vconvtend, errmsg, errflg) + subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, cscnv, & + frain, rain1, dtf, cld1d, save_u, save_v, save_t, save_qv, gu0, gv0, gt0, & + gq0_water_vapor, ud_mf, dd_mf, dt_mf, con_g, npdf3d, num_p3d, ncnvcld3d, & + rainc, cldwrk, dt3dt, dq3dt, du3dt, dv3dt, upd_mf, dwn_mf, det_mf, & + cnvw, cnvc, cnvw_phy_f3d, cnvc_phy_f3d, flag_for_dcnv_generic_tend, errmsg, errflg) + use machine, only: kind_phys implicit none integer, intent(in) :: im, levs - logical, intent(in) :: lssav, ldiag3d, ras, cscnv, do_ca, isppt_deep, qdiag3d + logical, intent(in) :: lssav, ldiag3d, qdiag3d, ras, cscnv logical, intent(in) :: flag_for_dcnv_generic_tend real(kind=kind_phys), intent(in) :: frain, dtf @@ -123,7 +112,6 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, cs real(kind=kind_phys), dimension(im,levs), intent(in) :: gu0, gv0, gt0, gq0_water_vapor real(kind=kind_phys), dimension(im,levs), intent(in) :: ud_mf, dd_mf, dt_mf real(kind=kind_phys), intent(in) :: con_g - real(kind=kind_phys), dimension(im,levs), intent(in) :: clw_ice, clw_liquid integer, intent(in) :: npdf3d, num_p3d, ncnvcld3d real(kind=kind_phys), dimension(im), intent(inout) :: rainc, cldwrk @@ -137,9 +125,6 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, cs ! as long as these do not get used when not allocated (it is still invalid Fortran code, though). real(kind=kind_phys), dimension(:,:), intent(inout) :: cnvw_phy_f3d, cnvc_phy_f3d - real(kind=kind_phys), dimension(im), intent(inout) :: cape - real(kind=kind_phys), dimension(im,levs), intent(inout) :: tconvtend, qconvtend, uconvtend, vconvtend - character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -150,11 +135,6 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, cs errflg = 0 if (.not. ras .and. .not. cscnv) then - if(do_ca) then - do i=1,im - cape(i)=cld1d(i) - enddo - endif if (npdf3d == 3 .and. num_p3d == 4) then do k=1,levs do i=1,im @@ -190,9 +170,9 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, cs du3dt(i,k) = du3dt(i,k) + (gu0(i,k)-save_u(i,k)) * frain dv3dt(i,k) = dv3dt(i,k) + (gv0(i,k)-save_v(i,k)) * frain -! upd_mf(i,k) = upd_mf(i,k) + ud_mf(i,k) * (con_g*frain) -! dwn_mf(i,k) = dwn_mf(i,k) + dd_mf(i,k) * (con_g*frain) -! det_mf(i,k) = det_mf(i,k) + dt_mf(i,k) * (con_g*frain) +! upd_mf(i,k) = upd_mf(i,k) + ud_mf(i,k) * (con_g*frain) +! dwn_mf(i,k) = dwn_mf(i,k) + dd_mf(i,k) * (con_g*frain) +! det_mf(i,k) = det_mf(i,k) + dt_mf(i,k) * (con_g*frain) enddo enddo if(qdiag3d) then @@ -206,18 +186,6 @@ subroutine GFS_DCNV_generic_post_run (im, levs, lssav, ldiag3d, qdiag3d, ras, cs endif ! if (lssav) - - if (isppt_deep) then - do k=1,levs - do i=1,im - tconvtend(i,k) = gt0(i,k) - save_t(i,k) - qconvtend(i,k) = gq0_water_vapor(i,k) - save_qv(i,k) - uconvtend(i,k) = gu0(i,k) - save_u(i,k) - vconvtend(i,k) = gv0(i,k) - save_v(i,k) - enddo - enddo - endif - end subroutine GFS_DCNV_generic_post_run end module GFS_DCNV_generic_post diff --git a/physics/GFS_DCNV_generic.meta b/physics/GFS_DCNV_generic.meta index 1e4a59a77..aa2c99c6a 100644 --- a/physics/GFS_DCNV_generic.meta +++ b/physics/GFS_DCNV_generic.meta @@ -41,14 +41,6 @@ type = logical intent = in optional = F -[do_ca] - standard_name = flag_for_cellular_automata - long_name = cellular automata main switch - units = flag - dimensions = () - type = logical - intent = in - optional = F [cplchm] standard_name = flag_for_chemistry_coupling long_name = flag controlling cplchm collection (default off) @@ -57,14 +49,6 @@ type = logical intent = in optional = F -[isppt_deep] - standard_name = flag_for_combination_of_sppt_with_isppt_deep - long_name = switch for combination with isppt_deep. - units = flag - dimensions = () - type = logical - intent = in - optional = F [gu0] standard_name = x_wind_updated_by_physics long_name = zonal wind updated by physics @@ -137,15 +121,6 @@ kind = kind_phys intent = inout optional = F -[ca_deep] - standard_name = fraction_of_cellular_automata_for_deep_convection - long_name = fraction of cellular automata for deep convection - units = frac - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F [dqdti] standard_name = instantaneous_water_vapor_specific_humidity_tendency_due_to_convection long_name = instantaneous moisture tendency due to convection @@ -233,22 +208,6 @@ type = logical intent = in optional = F -[do_ca] - standard_name = flag_for_cellular_automata - long_name = cellular automata main switch - units = flag - dimensions = () - type = logical - intent = in - optional = F -[isppt_deep] - standard_name = flag_for_combination_of_sppt_with_isppt_deep - long_name = switch for combination with isppt_deep. - units = flag - dimensions = () - type = logical - intent = in - optional = F [frain] standard_name = dynamics_to_physics_timestep_ratio long_name = ratio of dynamics timestep to physics timestep @@ -393,24 +352,6 @@ kind = kind_phys intent = in optional = F -[clw_ice] - standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[clw_liquid] - standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) in the convectively transported tracer array - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F [npdf3d] standard_name = number_of_3d_arrays_associated_with_pdf_based_clouds long_name = number of 3d arrays associated with pdf based clouds/mp @@ -552,15 +493,6 @@ kind = kind_phys intent = inout optional = F -[cape] - standard_name = convective_available_potential_energy_for_coupling - long_name = convective available potential energy for coupling - units = m2 s-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [flag_for_dcnv_generic_tend] standard_name = flag_for_generic_deep_convection_tendency long_name = true if GFS_DCNV_generic should calculate tendencies @@ -568,42 +500,6 @@ dimensions = () type = logical intent = in -[tconvtend] - standard_name = tendency_of_air_temperature_due_to_deep_convection_for_coupling_on_physics_timestep - long_name = tendency of air temperature due to deep convection - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[qconvtend] - standard_name = tendency_of_water_vapor_specific_humidity_due_to_deep_convection_for_coupling_on_physics_timestep - long_name = tendency of specific humidity due to deep convection - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[uconvtend] - standard_name = tendency_of_x_wind_due_to_deep_convection_for_coupling_on_physics_timestep - long_name = tendency_of_x_wind_due_to_deep_convection - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[vconvtend] - standard_name = tendency_of_y_wind_due_to_deep_convection_for_coupling_on_physics_timestep - long_name = tendency_of_y_wind_due_to_deep_convection - units = m s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index d1fb5d299..13f8243ed 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -97,7 +97,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt rann, xlat, xlon, gt0, gq0, prsl, prsi, phii, tsfc, ice, snow, graupel, save_t, save_qv, rain0, ice0, snow0, & graupel0, del, rain, domr_diag, domzr_diag, domip_diag, doms_diag, tprcp, srflag, sr, cnvprcp, totprcp, totice, & totsnw, totgrp, cnvprcpb, totprcpb, toticeb, totsnwb, totgrpb, dt3dt, dq3dt, rain_cpl, rainc_cpl, snow_cpl, pwat, & - do_sppt, dtdtr, dtdtc, drain_cpl, dsnow_cpl, lsm, lsm_ruc, lsm_noahmp, raincprv, rainncprv, iceprv, snowprv, & + do_sppt, ca_global, dtdtr, dtdtc, drain_cpl, dsnow_cpl, lsm, lsm_ruc, lsm_noahmp, raincprv, rainncprv, iceprv, snowprv, & graupelprv, draincprv, drainncprv, diceprv, dsnowprv, dgraupelprv, dtp, errmsg, errflg) ! use machine, only: kind_phys @@ -127,7 +127,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt real(kind=kind_phys), dimension(:,:), intent(inout) :: dq3dt ! only if ldiag3d and qdiag3d ! Stochastic physics / surface perturbations - logical, intent(in) :: do_sppt + logical, intent(in) :: do_sppt, ca_global real(kind=kind_phys), dimension(im,levs), intent(inout) :: dtdtr real(kind=kind_phys), dimension(im,levs), intent(in) :: dtdtc real(kind=kind_phys), dimension(im), intent(inout) :: drain_cpl @@ -170,9 +170,9 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt errflg = 0 onebg = one/con_g - + do i = 1, im - rain(i) = rainc(i) + frain * rain1(i) ! time-step convective plus explicit + rain(i) = rainc(i) + frain * rain1(i) ! time-step convective plus explicit enddo !> - If requested (e.g. Zhao-Carr MP scheme), call calpreciptype() to calculate dominant @@ -204,11 +204,11 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt end if if (lsm==lsm_ruc .or. lsm==lsm_noahmp) then - raincprv(:) = rainc(:) - rainncprv(:) = frain * rain1(:) - iceprv(:) = ice(:) - snowprv(:) = snow(:) - graupelprv(:) = graupel(:) + raincprv(:) = rainc(:) + rainncprv(:) = frain * rain1(:) + iceprv(:) = ice(:) + snowprv(:) = snow(:) + graupelprv(:) = graupel(:) !for NoahMP, calculate precipitation rates from liquid water equivalent thickness for use in next time step !Note (GJF): Precipitation LWE thicknesses are multiplied by the frain factor, and are thus on the dynamics time step, but the conversion as written ! (with dtp in the denominator) assumes the rate is calculated on the physics time step. This only works as expected when dtf=dtp (i.e. when frain=1). @@ -224,20 +224,12 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt if (cal_pre) then ! hchuang: add dominant precipitation type algorithm ! - call calpreciptype (kdt, nrcm, im, ix, levs, levs+1, & - rann, xlat, xlon, gt0, & - gq0(:,:,1), prsl, prsi, & - rain, phii, tsfc, & !input - domr, domzr, domip, doms) ! output + call calpreciptype (kdt, nrcm, im, ix, levs, levs+1, & + rann, xlat, xlon, gt0, & + gq0(:,:,1), prsl, prsi, & + rain, phii, tsfc, & ! input + domr, domzr, domip, doms) ! output ! -! if (lprnt) print*,'debug calpreciptype: DOMR,DOMZR,DOMIP,DOMS ' -! &,DOMR(ipr),DOMZR(ipr),DOMIP(ipr),DOMS(ipr) -! do i=1,im -! if (abs(xlon(i)*57.29578-114.0) .lt. 0.2 .and. -! & abs(xlat(i)*57.29578-40.0) .lt. 0.2) -! & print*,'debug calpreciptype: DOMR,DOMZR,DOMIP,DOMS ', -! & DOMR(i),DOMZR(i),DOMIP(i),DOMS(i) -! end do ! HCHUANG: use new precipitation type to decide snow flag for LSM snow accumulation if (imp_physics /= imp_physics_gfdl .and. imp_physics /= imp_physics_thompson) then @@ -300,7 +292,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt do k = 1, levs-1 do i = 1, im if (prsl(i,k) > p850 .and. prsl(i,k+1) <= p850) then - t850(i) = gt0(i,k) - (prsl(i,k)-p850) / & + t850(i) = gt0(i,k) - (prsl(i,k)-p850) / & (prsl(i,k)-prsl(i,k+1)) * & (gt0(i,k)-gt0(i,k+1)) endif @@ -318,7 +310,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt ! determine convective rain/snow by surface temperature ! determine large-scale rain/snow by rain/snow coming out directly from MP - if (lsm/=lsm_ruc) then + if (lsm /= lsm_ruc) then do i = 1, im !tprcp(i) = max(0.0, rain(i) )! clu: rain -> tprcp ! DH now lines 245-250 srflag(i) = 0. ! clu: default srflag as 'rain' (i.e. 0) @@ -345,7 +337,8 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt enddo endif ! lsm==lsm_ruc elseif( .not. cal_pre) then - if (imp_physics == imp_physics_mg) then ! MG microphysics + if (imp_physics == imp_physics_mg) then ! MG microphysics + tem = con_day / (dtp * con_p001) ! mm / day do i=1,im tprcp(i) = max(0.0, rain(i) ) ! clu: rain -> tprcp if (rain(i)*tem > rainmin) then @@ -367,14 +360,16 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt if (cplflx .or. cplchm) then do i = 1, im - rain_cpl(i) = rain_cpl(i) + rain(i) * (one-srflag(i)) - snow_cpl(i) = snow_cpl(i) + rain(i) * srflag(i) + drain_cpl(i) = rain(i) * (one-srflag(i)) + dsnow_cpl(i) = rain(i) * srflag(i) + rain_cpl(i) = rain_cpl(i) + drain_cpl(i) + snow_cpl(i) = snow_cpl(i) + dsnow_cpl(i) enddo endif if (cplchm) then do i = 1, im - rainc_cpl(i) = rainc_cpl(i) + rainc(i) + rainc_cpl(i) = rainc_cpl(i) + rainc(i) enddo endif @@ -393,26 +388,15 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt do i=1,im pwat(i) = pwat(i) + del(i,k)*(gq0(i,k,1)+work1(i)) enddo -! if (lprnt .and. i == ipr) write(0,*)' gq0=', -! &gq0(i,k,1),' qgrs=',qgrs(i,k,1),' work2=',work2(i),' k=',k enddo do i=1,im pwat(i) = pwat(i) * onebg enddo ! Stochastic physics / surface perturbations - if (do_sppt) then + if (do_sppt .or. ca_global) then !--- radiation heating rate dtdtr(1:im,:) = dtdtr(1:im,:) + dtdtc(1:im,:)*dtf - do i = 1, im - if (t850(i) > 273.16) then -!--- change in change in rain precip - drain_cpl(i) = rain(i) - drain_cpl(i) - else -!--- change in change in snow precip - dsnow_cpl(i) = rain(i) - dsnow_cpl(i) - endif - enddo endif end subroutine GFS_MP_generic_post_run diff --git a/physics/GFS_MP_generic.meta b/physics/GFS_MP_generic.meta index c49b1ca46..3ecc94c00 100644 --- a/physics/GFS_MP_generic.meta +++ b/physics/GFS_MP_generic.meta @@ -747,6 +747,14 @@ type = logical intent = in optional = F +[ca_global] + standard_name = flag_for_global_cellular_automata + long_name = switch for global ca + units = flag + dimensions = () + type = logical + intent = in + optional = F [dtdtr] standard_name = tendency_of_air_temperature_due_to_radiative_heating_on_physics_time_step long_name = temp. change due to radiative heating per time step diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index bd9df41df..75c27fcc7 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -81,11 +81,11 @@ end subroutine GFS_PBL_generic_pre_finalize !! subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, & ntqv, ntcw, ntiw, ntrw, ntsw, ntlnc, ntinc, ntrnc, ntsnc, ntgnc, & - ntwa, ntia, ntgl, ntoz, ntke, ntkev, nqrimef, trans_aero, ntchs, ntchm, & + ntwa, ntia, ntgl, ntoz, ntke, ntkev, nqrimef, trans_aero, ntchs, ntchm, & imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, & - imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires, cplchm, ltaerosol, hybedmf, do_shoc, & - satmedmf, qgrs, vdftra, save_u, save_v, save_t, save_q, ldiag3d, qdiag3d, lssav, & - ugrs, vgrs, tgrs, errmsg, errflg) + imp_physics_zhao_carr, imp_physics_mg, imp_physics_fer_hires, cplchm, ltaerosol, & + hybedmf, do_shoc, satmedmf, qgrs, vdftra, save_u, save_v, save_t, save_q, & + ldiag3d, qdiag3d, lssav, ugrs, vgrs, tgrs, errmsg, errflg) use machine, only : kind_phys use GFS_PBL_generic_common, only : set_aerosol_tracer_index @@ -106,10 +106,11 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, real(kind=kind_phys), dimension(im, levs), intent(out) :: save_u, save_v, save_t real(kind=kind_phys), dimension(im, levs, ntrac), intent(out) :: save_q + ! CCPP error handling variables character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + integer, intent(out) :: errflg - !local variables + ! Local variables integer :: i, k, kk, k1, n ! Initialize CCPP error handling variables @@ -307,13 +308,13 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, trans_aero, ntchs, ntchm, & imp_physics, imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6, imp_physics_zhao_carr, imp_physics_mg, & imp_physics_fer_hires, & - ltaerosol, cplflx, cplchm, lssav, flag_for_pbl_generic_tend, ldiag3d, qdiag3d, lsidea, hybedmf, do_shoc, satmedmf, shinhong, do_ysu, & - dvdftra, dusfc1, dvsfc1, dtsfc1, dqsfc1, dtf, dudt, dvdt, dtdt, htrsw, htrlw, xmu, & + ltaerosol, cplflx, cplchm, lssav, flag_for_pbl_generic_tend, ldiag3d, qdiag3d, lsidea, hybedmf, do_shoc, satmedmf, & + shinhong, do_ysu, dvdftra, dusfc1, dvsfc1, dtsfc1, dqsfc1, dtf, dudt, dvdt, dtdt, htrsw, htrlw, xmu, & dqdt, dusfc_cpl, dvsfc_cpl, dtsfc_cpl, & dqsfc_cpl, dusfci_cpl, dvsfci_cpl, dtsfci_cpl, dqsfci_cpl, dusfc_diag, dvsfc_diag, dtsfc_diag, dqsfc_diag, & - dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag, dt3dt, du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, dq3dt,& + dusfci_diag, dvsfci_diag, dtsfci_diag, dqsfci_diag, dt3dt, du3dt_PBL, du3dt_OGWD, dv3dt_PBL, dv3dt_OGWD, dq3dt, & dq3dt_ozone, rd, cp,fvirt, hvap, t1, q1, prsl, hflx, ushfsfci, oceanfrac, fice, dusfc_cice, dvsfc_cice, dtsfc_cice, & - dqsfc_cice, wet, dry, icy, wind, stress_ocn, hflx_ocn, evap_ocn, ugrs1, vgrs1, dkt_cpl, dkt, & + dqsfc_cice, wet, dry, icy, wind, stress_ocn, hflx_ocn, evap_ocn, ugrs1, vgrs1, dkt_cpl, dkt, hffac, hefac, & ugrs, vgrs, tgrs, qgrs, save_u, save_v, save_t, save_q, errmsg, errflg) use machine, only : kind_phys @@ -363,9 +364,16 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, real(kind=kind_phys), dimension(:,:), intent(inout) :: dkt_cpl real(kind=kind_phys), dimension(:,:), intent(in) :: dkt + ! From canopy heat storage - reduction factors in latent/sensible heat flux due to surface roughness + real(kind=kind_phys), dimension(im), intent(in) :: hffac, hefac + character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + real(kind=kind_phys), parameter :: zero = 0.0d0 + real(kind=kind_phys), parameter :: one = 1.0d0 + real(kind=kind_phys), parameter :: huge = 9.9692099683868690E36 ! NetCDF float FillValue, same as in GFS_typedefs.F90 + real(kind=kind_phys), parameter :: epsln = 1.0d-10 ! same as in GFS_physics_driver.F90 integer :: i, k, kk, k1, n real(kind=kind_phys) :: tem, tem1, rho @@ -524,7 +532,7 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, if (cplchm) then do i = 1, im tem1 = max(q1(i), 1.e-8) - tem = prsl(i,1) / (rd*t1(i)*(1.0+fvirt*tem1)) + tem = prsl(i,1) / (rd*t1(i)*(one+fvirt*tem1)) ushfsfci(i) = -cp * tem * hflx(i) ! upward sensible heat flux enddo ! dkt_cpl has dimensions (1:im,1:levs), but dkt has (1:im,1:levs-1) @@ -536,39 +544,42 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, if_cplflx: if (cplflx) then do i=1,im - if (oceanfrac(i) > 0.0) then ! Ocean only, NO LAKES -! if (fice(i) == ceanfrac(i)) then ! use results from CICE -! dusfci_cpl(i) = dusfc_cice(i) -! dvsfci_cpl(i) = dvsfc_cice(i) -! dtsfci_cpl(i) = dtsfc_cice(i) -! dqsfci_cpl(i) = dqsfc_cice(i) -! elseif (dry(i) .or. icy(i)) then ! use stress_ocean from sfc_diff for opw component at mixed point - if (wet(i)) then ! use stress_ocean from sfc_diff for opw component at mixed point - if (icy(i) .or. dry(i)) then - tem1 = max(q1(i), 1.e-8) - rho = prsl(i,1) / (rd*t1(i)*(1.0+fvirt*tem1)) - if (wind(i) > 0.0) then - tem = - rho * stress_ocn(i) / wind(i) - dusfci_cpl(i) = tem * ugrs1(i) ! U-momentum flux - dvsfci_cpl(i) = tem * vgrs1(i) ! V-momentum flux - else - dusfci_cpl(i) = 0.0 - dvsfci_cpl(i) = 0.0 - endif - dtsfci_cpl(i) = cp * rho * hflx_ocn(i) ! sensible heat flux over open ocean - dqsfci_cpl(i) = hvap * rho * evap_ocn(i) ! latent heat flux over open ocean - else ! use results from PBL scheme for 100% open ocean - dusfci_cpl(i) = dusfc1(i) - dvsfci_cpl(i) = dvsfc1(i) - dtsfci_cpl(i) = dtsfc1(i) - dqsfci_cpl(i) = dqsfc1(i) + if (oceanfrac(i) > zero) then ! Ocean only, NO LAKES + if (fice(i) > one - epsln) then ! no open water, use results from CICE + dusfci_cpl(i) = dusfc_cice(i) + dvsfci_cpl(i) = dvsfc_cice(i) + dtsfci_cpl(i) = dtsfc_cice(i) + dqsfci_cpl(i) = dqsfc_cice(i) + elseif (icy(i) .or. dry(i)) then ! use stress_ocean from sfc_diff for opw component at mixed point + tem1 = max(q1(i), 1.e-8) + rho = prsl(i,1) / (rd*t1(i)*(one+fvirt*tem1)) + if (wind(i) > zero) then + tem = - rho * stress_ocn(i) / wind(i) + dusfci_cpl(i) = tem * ugrs1(i) ! U-momentum flux + dvsfci_cpl(i) = tem * vgrs1(i) ! V-momentum flux + else + dusfci_cpl(i) = zero + dvsfci_cpl(i) = zero endif + dtsfci_cpl(i) = cp * rho * hflx_ocn(i) ! sensible heat flux over open ocean + dqsfci_cpl(i) = hvap * rho * evap_ocn(i) ! latent heat flux over open ocean + else ! use results from PBL scheme for 100% open ocean + dusfci_cpl(i) = dusfc1(i) + dvsfci_cpl(i) = dvsfc1(i) + dtsfci_cpl(i) = dtsfc1(i)*hffac(i) + dqsfci_cpl(i) = dqsfc1(i)*hefac(i) endif ! dusfc_cpl (i) = dusfc_cpl(i) + dusfci_cpl(i) * dtf dvsfc_cpl (i) = dvsfc_cpl(i) + dvsfci_cpl(i) * dtf dtsfc_cpl (i) = dtsfc_cpl(i) + dtsfci_cpl(i) * dtf dqsfc_cpl (i) = dqsfc_cpl(i) + dqsfci_cpl(i) * dtf +! + else + dusfc_cpl(i) = huge + dvsfc_cpl(i) = huge + dtsfc_cpl(i) = huge + dqsfc_cpl(i) = huge !! endif ! Ocean only, NO LAKES enddo @@ -579,17 +590,13 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, do i=1,im dusfc_diag (i) = dusfc_diag(i) + dusfc1(i)*dtf dvsfc_diag (i) = dvsfc_diag(i) + dvsfc1(i)*dtf - dtsfc_diag (i) = dtsfc_diag(i) + dtsfc1(i)*dtf - dqsfc_diag (i) = dqsfc_diag(i) + dqsfc1(i)*dtf + dtsfc_diag (i) = dtsfc_diag(i) + dtsfc1(i)*hffac(i)*dtf + dqsfc_diag (i) = dqsfc_diag(i) + dqsfc1(i)*hefac(i)*dtf dusfci_diag(i) = dusfc1(i) dvsfci_diag(i) = dvsfc1(i) - dtsfci_diag(i) = dtsfc1(i) - dqsfci_diag(i) = dqsfc1(i) + dtsfci_diag(i) = dtsfc1(i)*hffac(i) + dqsfci_diag(i) = dqsfc1(i)*hefac(i) enddo - ! if (lprnt) then - ! write(0,*)' dusfc=',dusfc(ipr),' dusfc1=',dusfc1(ipr),' dtf=', - ! & dtf,' kdt=',kdt,' lat=',lat - ! endif if_diag: if (ldiag3d .and. flag_for_pbl_generic_tend .and. lssav) then if (lsidea) then diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index 57a1163a2..9a130831c 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -834,7 +834,7 @@ intent = in optional = F [htrsw] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky sw heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -843,7 +843,7 @@ intent = in optional = F [htrlw] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky lw heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -1176,8 +1176,8 @@ intent = in optional = F [dusfc_cice] - standard_name = surface_x_momentum_flux_for_coupling_interstitial - long_name = sfc x momentum flux for coupling interstitial + standard_name = surface_x_momentum_flux_for_coupling + long_name = sfc x momentum flux for coupling units = Pa dimensions = (horizontal_dimension) type = real @@ -1185,8 +1185,8 @@ intent = in optional = F [dvsfc_cice] - standard_name = surface_y_momentum_flux_for_coupling_interstitial - long_name = sfc y momentum flux for coupling interstitial + standard_name = surface_y_momentum_flux_for_coupling + long_name = sfc y momentum flux for coupling units = Pa dimensions = (horizontal_dimension) type = real @@ -1194,8 +1194,8 @@ intent = in optional = F [dtsfc_cice] - standard_name = surface_upward_sensible_heat_flux_for_coupling_interstitial - long_name = sfc sensible heat flux for coupling interstitial + standard_name = surface_upward_sensible_heat_flux_for_coupling + long_name = sfc sensible heat flux for coupling units = W m-2 dimensions = (horizontal_dimension) type = real @@ -1203,8 +1203,8 @@ intent = in optional = F [dqsfc_cice] - standard_name = surface_upward_latent_heat_flux_for_coupling_interstitial - long_name = sfc latent heat flux for coupling interstitial + standard_name = surface_upward_latent_heat_flux_for_coupling + long_name = sfc latent heat flux for coupling units = W m-2 dimensions = (horizontal_dimension) type = real @@ -1307,6 +1307,24 @@ kind = kind_phys intent = in optional = F +[hefac] + standard_name = surface_upward_latent_heat_flux_reduction_factor + long_name = surface upward latent heat flux reduction factor from canopy heat storage + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hffac] + standard_name = surface_upward_sensible_heat_flux_reduction_factor + long_name = surface upward sensible heat flux reduction factor from canopy heat storage + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F [ugrs] standard_name = x_wind long_name = zonal wind diff --git a/physics/GFS_SCNV_generic.F90 b/physics/GFS_SCNV_generic.F90 index 2b74c1837..ae8fac5f9 100644 --- a/physics/GFS_SCNV_generic.F90 +++ b/physics/GFS_SCNV_generic.F90 @@ -54,6 +54,7 @@ subroutine GFS_SCNV_generic_pre_run (im, levs, ldiag3d, qdiag3d, gu0, gv0, gt0, end subroutine GFS_SCNV_generic_pre_run + end module GFS_SCNV_generic_pre module GFS_SCNV_generic_post diff --git a/physics/GFS_debug.F90 b/physics/GFS_debug.F90 index b99529cc5..0d010ed76 100644 --- a/physics/GFS_debug.F90 +++ b/physics/GFS_debug.F90 @@ -404,7 +404,12 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Coupling%rain_cpl', Coupling%rain_cpl) call print_var(mpirank,omprank, blkno, 'Coupling%snow_cpl', Coupling%snow_cpl) end if + if (Model%cplwav2atm) then + call print_var(mpirank,omprank, blkno, 'Coupling%zorlwav_cpl' , Coupling%zorlwav_cpl ) + end if if (Model%cplflx) then + call print_var(mpirank,omprank, blkno, 'Coupling%oro_cpl' , Coupling%oro_cpl ) + call print_var(mpirank,omprank, blkno, 'Coupling%slmsk_cpl' , Coupling%slmsk_cpl ) call print_var(mpirank,omprank, blkno, 'Coupling%slimskin_cpl', Coupling%slimskin_cpl ) call print_var(mpirank,omprank, blkno, 'Coupling%dusfcin_cpl ', Coupling%dusfcin_cpl ) call print_var(mpirank,omprank, blkno, 'Coupling%dvsfcin_cpl ', Coupling%dvsfcin_cpl ) @@ -468,11 +473,19 @@ subroutine GFS_diagtoscreen_run (Model, Statein, Stateout, Sfcprop, Coupling, call print_var(mpirank,omprank, blkno, 'Coupling%shum_wts', Coupling%shum_wts) end if if (Model%do_skeb) then - call print_var(mpirank,omprank, blkno, 'Coupling%skebu_wts', Coupling%skebu_wts) - call print_var(mpirank,omprank, blkno, 'Coupling%skebv_wts', Coupling%skebv_wts) + call print_var(mpirank,omprank, blkno, 'Coupling%skebu_wts', Coupling%skebu_wts ) + call print_var(mpirank,omprank, blkno, 'Coupling%skebv_wts', Coupling%skebv_wts ) end if if (Model%do_sfcperts) then - call print_var(mpirank,omprank, blkno, 'Coupling%sfc_wts', Coupling%sfc_wts) + call print_var(mpirank,omprank, blkno, 'Coupling%sfc_wts' , Coupling%sfc_wts ) + end if + if (Model%do_ca) then + call print_var(mpirank,omprank, blkno, 'Coupling%ca1 ', Coupling%ca1 ) + call print_var(mpirank,omprank, blkno, 'Coupling%ca_deep ', Coupling%ca_deep ) + call print_var(mpirank,omprank, blkno, 'Coupling%ca_turb ', Coupling%ca_turb ) + call print_var(mpirank,omprank, blkno, 'Coupling%ca_shal ', Coupling%ca_shal ) + call print_var(mpirank,omprank, blkno, 'Coupling%ca_rad ', Coupling%ca_rad ) + call print_var(mpirank,omprank, blkno, 'Coupling%ca_micro ', Coupling%ca_micro ) end if if(Model%imp_physics == Model%imp_physics_thompson .and. Model%ltaerosol) then call print_var(mpirank,omprank, blkno, 'Coupling%nwfa2d', Coupling%nwfa2d) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 2b79d6883..bed8e14e1 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -61,7 +61,6 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e integer :: nb, nblks, nt integer :: i, j, ix logical :: non_uniform_blocks - ! Initialize CCPP error handling variables errmsg = '' errflg = 0 @@ -153,7 +152,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e !$OMP section !> - Call read_aerdata() to read aerosol climatology - if (Model%aero_in) then + if (Model%iaerclm) then ! Consistency check that the value for ntrcaerm set in GFS_typedefs.F90 ! and used to allocate Tbd%aer_nm matches the value defined in aerclm_def if (size(Data(1)%Tbd%aer_nm, dim=3).ne.ntrcaerm) then @@ -164,21 +163,21 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e else ! Update the value of ntrcaer in aerclm_def with the value defined ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. - ! If Model%aero_in is .true., then ntrcaer == ntrcaerm + ! If Model%iaerclm is .true., then ntrcaer == ntrcaerm ntrcaer = size(Data(1)%Tbd%aer_nm, dim=3) ! Read aerosol climatology - call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate) + call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate,errmsg,errflg) endif else ! Update the value of ntrcaer in aerclm_def with the value defined ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. - ! If Model%aero_in is .false., then ntrcaer == 1 + ! If Model%iaerclm is .false., then ntrcaer == 1 ntrcaer = size(Data(1)%Tbd%aer_nm, dim=3) endif !$OMP section !> - Call read_cidata() to read IN and CCN data - if (Model%iccn) then + if (Model%iccn == 1) then call read_cidata ( Model%me, Model%master) ! No consistency check needed for in/ccn data, all values are ! hardcoded in module iccn_def.F and GFS_typedefs.F90 @@ -230,7 +229,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e endif !> - Call setindxaer() to initialize aerosols data - if (Model%aero_in) then + if (Model%iaerclm) then !$OMP do schedule (dynamic,1) do nb = 1, nblks call setindxaer (Model%blksz(nb), Data(nb)%Grid%xlat_d, Data(nb)%Grid%jindx1_aer, & @@ -242,7 +241,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e endif !> - Call setindxci() to initialize IN and CCN data - if (Model%iccn) then + if (Model%iccn == 1) then !$OMP do schedule (dynamic,1) do nb = 1, nblks call setindxci (Model%blksz(nb), Data(nb)%Grid%xlat_d, Data(nb)%Grid%jindx1_ci, & @@ -260,7 +259,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e do j = 1,Model%ny do i = 1,Model%nx ix = ix + 1 - if (ix .gt. Model%blksz(nb)) then + if (ix > Model%blksz(nb)) then ix = 1 nb = nb + 1 endif @@ -436,7 +435,7 @@ subroutine GFS_phys_time_vary_run (Data, Model, nthrds, first_time_step, errmsg, endif !> - Call aerinterpol() to make aerosol interpolation - if (Model%aero_in) then + if (Model%iaerclm) then !$OMP do schedule (dynamic,1) do nb = 1, nblks call aerinterpol (Model%me, Model%master, Model%blksz(nb), & @@ -451,7 +450,7 @@ subroutine GFS_phys_time_vary_run (Data, Model, nthrds, first_time_step, errmsg, endif !> - Call ciinterpol() to make IN and CCN data interpolation - if (Model%iccn) then + if (Model%iccn == 1) then !$OMP do schedule (dynamic,1) do nb = 1, nblks call ciinterpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index 3b4bbaf77..5fcc9ed84 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -96,7 +96,7 @@ subroutine GFS_phys_time_vary_init (Grid, Model, Interstitial, Tbd, errmsg, errf errflg = 1 end if - if (Model%aero_in) then + if (Model%iaerclm) then ! Consistency check that the value for ntrcaerm set in GFS_typedefs.F90 ! and used to allocate Tbd%aer_nm matches the value defined in aerclm_def if (size(Tbd%aer_nm, dim=3).ne.ntrcaerm) then @@ -107,19 +107,20 @@ subroutine GFS_phys_time_vary_init (Grid, Model, Interstitial, Tbd, errmsg, errf else ! Update the value of ntrcaer in aerclm_def with the value defined ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. - ! If Model%aero_in is .true., then ntrcaer == ntrcaerm + ! If Model%iaerclm is .true., then ntrcaer == ntrcaerm ntrcaer = size(Tbd%aer_nm, dim=3) ! Read aerosol climatology - call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate) + call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate,errmsg,errflg) + if (errflg/=0) return endif else ! Update the value of ntrcaer in aerclm_def with the value defined ! in GFS_typedefs.F90 that is used to allocate the Tbd DDT. - ! If Model%aero_in is .false., then ntrcaer == 1 + ! If Model%iaerclm is .false., then ntrcaer == 1 ntrcaer = size(Tbd%aer_nm, dim=3) endif - if (Model%iccn) then + if (Model%iccn == 1) then call read_cidata ( Model%me, Model%master) ! No consistency check needed for in/ccn data, all values are ! hardcoded in module iccn_def.F and GFS_typedefs.F90 @@ -149,14 +150,14 @@ subroutine GFS_phys_time_vary_init (Grid, Model, Interstitial, Tbd, errmsg, errf endif !--- read in and initialize aerosols - if (Model%aero_in) then + if (Model%iaerclm) then call setindxaer (Model%blksz(nb), Grid%xlat_d, Grid%jindx1_aer, & Grid%jindx2_aer, Grid%ddy_aer, Grid%xlon_d, & Grid%iindx1_aer, Grid%iindx2_aer, Grid%ddx_aer, & Model%me, Model%master) endif !--- read in and initialize IN and CCN - if (Model%iccn) then + if (Model%iccn == 1) then call setindxci (Model%blksz(nb), Grid%xlat_d, Grid%jindx1_ci, & Grid%jindx2_ci, Grid%ddy_ci, Grid%xlon_d, & Grid%iindx1_ci, Grid%iindx2_ci, Grid%ddx_ci) @@ -321,7 +322,7 @@ subroutine GFS_phys_time_vary_run (Grid, Statein, Model, Tbd, Sfcprop, Cldprop, endif !--- aerosol interpolation - if (Model%aero_in) then + if (Model%iaerclm) then call aerinterpol (Model%me, Model%master, Model%blksz(nb), & Model%idate, Model%fhour, & Grid%jindx1_aer, Grid%jindx2_aer, & @@ -331,7 +332,7 @@ subroutine GFS_phys_time_vary_run (Grid, Statein, Model, Tbd, Sfcprop, Cldprop, Tbd%aer_nm) endif !--- ICCN interpolation - if (Model%iccn) then + if (Model%iccn == 1) then call ciinterpol (Model%me, Model%blksz(nb), Model%idate, Model%fhour, & Grid%jindx1_ci, Grid%jindx2_ci, & Grid%ddy_ci,Grid%iindx1_ci, & diff --git a/physics/GFS_rrtmg_post.F90 b/physics/GFS_rrtmg_post.F90 index db3de4f44..c910d2fb1 100644 --- a/physics/GFS_rrtmg_post.F90 +++ b/physics/GFS_rrtmg_post.F90 @@ -75,12 +75,18 @@ subroutine GFS_rrtmg_post_run (Model, Grid, Diag, Radtend, Statein, & if (Model%lssav) then if (Model%lsswr) then do i=1,im - Diag%fluxr(i,34) = Diag%fluxr(i,34) + Model%fhswr*aerodp(i,1) ! total aod at 550nm - Diag%fluxr(i,35) = Diag%fluxr(i,35) + Model%fhswr*aerodp(i,2) ! DU aod at 550nm - Diag%fluxr(i,36) = Diag%fluxr(i,36) + Model%fhswr*aerodp(i,3) ! BC aod at 550nm - Diag%fluxr(i,37) = Diag%fluxr(i,37) + Model%fhswr*aerodp(i,4) ! OC aod at 550nm - Diag%fluxr(i,38) = Diag%fluxr(i,38) + Model%fhswr*aerodp(i,5) ! SU aod at 550nm - Diag%fluxr(i,39) = Diag%fluxr(i,39) + Model%fhswr*aerodp(i,6) ! SS aod at 550nm +! Diag%fluxr(i,34) = Diag%fluxr(i,34) + Model%fhswr*aerodp(i,1) ! total aod at 550nm +! Diag%fluxr(i,35) = Diag%fluxr(i,35) + Model%fhswr*aerodp(i,2) ! DU aod at 550nm +! Diag%fluxr(i,36) = Diag%fluxr(i,36) + Model%fhswr*aerodp(i,3) ! BC aod at 550nm +! Diag%fluxr(i,37) = Diag%fluxr(i,37) + Model%fhswr*aerodp(i,4) ! OC aod at 550nm +! Diag%fluxr(i,38) = Diag%fluxr(i,38) + Model%fhswr*aerodp(i,5) ! SU aod at 550nm +! Diag%fluxr(i,39) = Diag%fluxr(i,39) + Model%fhswr*aerodp(i,6) ! SS aod at 550nm + Diag%fluxr(i,34) = aerodp(i,1) ! total aod at 550nm + Diag%fluxr(i,35) = aerodp(i,2) ! DU aod at 550nm + Diag%fluxr(i,36) = aerodp(i,3) ! BC aod at 550nm + Diag%fluxr(i,37) = aerodp(i,4) ! OC aod at 550nm + Diag%fluxr(i,38) = aerodp(i,5) ! SU aod at 550nm + Diag%fluxr(i,39) = aerodp(i,6) ! SS aod at 550nm enddo endif diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index d123c9e4b..d2ecef895 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -505,9 +505,10 @@ subroutine GFS_rrtmg_pre_run (Model, Grid, Sfcprop, Statein, & ! input !check print *,' in grrad : calling setaer ' call setaer (plvl, plyr, prslk1, tvly, rhly, Sfcprop%slmsk, & ! --- inputs - tracer1, Grid%xlon, Grid%xlat, IM, LMK, LMP, & - Model%lsswr, Model%lslwr, & - faersw, faerlw, aerodp) ! --- outputs + tracer1, Tbd%aer_nm, & + Grid%xlon, Grid%xlat, IM, LMK, LMP, & + Model%lsswr,Model%lslwr, & + faersw,faerlw,aerodp) ! --- outputs ! CCPP do j = 1,NBDSW diff --git a/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90 new file mode 100644 index 000000000..103d88274 --- /dev/null +++ b/physics/GFS_rrtmgp_lw_post.F90 @@ -0,0 +1,233 @@ +module GFS_rrtmgp_lw_post + use machine, only: kind_phys + use GFS_typedefs, only: GFS_coupling_type, & + GFS_control_type, & + GFS_grid_type, & + GFS_radtend_type, & + GFS_statein_type, & + GFS_diag_type + use module_radiation_aerosols, only: NSPC1 + use module_radlw_parameters, only: topflw_type, sfcflw_type, proflw_type + ! RRTMGP DDT's + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_fluxes_byband, only: ty_fluxes_byband + use mo_heating_rates, only: compute_heating_rate + use rrtmgp_aux, only: check_error_msg + implicit none + + public GFS_rrtmgp_lw_post_init,GFS_rrtmgp_lw_post_run,GFS_rrtmgp_lw_post_finalize + +contains + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_lw_post_init + ! ######################################################################################### + subroutine GFS_rrtmgp_lw_post_init() + end subroutine GFS_rrtmgp_lw_post_init + + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_lw_post_run + ! ######################################################################################### +!> \section arg_table_GFS_rrtmgp_lw_post_run +!! \htmlinclude GFS_rrtmgp_lw_post.html +!! + subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statein, im, & + p_lev, tsfa, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky,& + raddt, aerodp, cldsa, mtopa, mbota, cld_frac, cldtaulw, & + flxprf_lw, errmsg, errflg) + + ! Inputs + type(GFS_control_type), intent(in) :: & + Model ! Fortran DDT: FV3-GFS model control parameters + type(GFS_grid_type), intent(in) :: & + Grid ! Fortran DDT: FV3-GFS grid and interpolation related data + type(GFS_statein_type), intent(in) :: & + Statein ! Fortran DDT: FV3-GFS prognostic state data in from dycore + integer, intent(in) :: & + im ! Horizontal loop extent + real(kind_phys), dimension(size(Grid%xlon,1)), intent(in) :: & + tsfa ! Lowest model layer air temperature for radiation (K) + real(kind_phys), dimension(size(Grid%xlon,1), Model%levs+1), intent(in) :: & + p_lev ! Pressure @ model layer-interfaces (hPa) + real(kind_phys), dimension(size(Grid%xlon,1), Model%levs+1), intent(in) :: & + fluxlwUP_allsky, & ! RRTMGP longwave all-sky flux (W/m2) + fluxlwDOWN_allsky, & ! RRTMGP longwave all-sky flux (W/m2) + fluxlwUP_clrsky, & ! RRTMGP longwave clear-sky flux (W/m2) + fluxlwDOWN_clrsky ! RRTMGP longwave clear-sky flux (W/m2) + real(kind_phys), intent(in) :: & + raddt ! Radiation time step + real(kind_phys), dimension(im,NSPC1), intent(in) :: & + aerodp ! Vertical integrated optical depth for various aerosol species + real(kind_phys), dimension(im,5), intent(in) :: & + cldsa ! Fraction of clouds for low, middle, high, total and BL + integer, dimension(im,3), intent(in) ::& + mbota, & ! vertical indices for low, middle and high cloud tops + mtopa ! vertical indices for low, middle and high cloud bases + real(kind_phys), dimension(im,Model%levs), intent(in) :: & + cld_frac, & ! Total cloud fraction in each layer + cldtaulw ! approx 10.mu band layer cloud optical depth + real(kind_phys),dimension(size(Grid%xlon,1), Model%levs) :: & + hlwc, & ! Longwave all-sky heating-rate (K/sec) + hlw0 ! Longwave clear-sky heating-rate (K/sec) + + ! Outputs (mandatory) + character(len=*), intent(out) :: & + errmsg + integer, intent(out) :: & + errflg + type(GFS_coupling_type), intent(inout) :: & + Coupling ! Fortran DDT: FV3-GFS fields to/from coupling with other components + type(GFS_radtend_type), intent(inout) :: & + Radtend ! Fortran DDT: FV3-GFS radiation tendencies + type(GFS_diag_type), intent(inout) :: & + Diag ! Fortran DDT: FV3-GFS diagnotics data + + ! Outputs (optional) + type(proflw_type), dimension(size(Grid%xlon,1), Model%levs+1), optional, intent(inout) :: & + flxprf_lw ! 2D radiative fluxes, components: + ! upfxc - total sky upward flux (W/m2) + ! dnfxc - total sky dnward flux (W/m2) + ! upfx0 - clear sky upward flux (W/m2) + ! dnfx0 - clear sky dnward flux (W/m2) + + ! Local variables + integer :: i, j, k, iSFC, iTOA, itop, ibtc + logical :: l_fluxeslw2d, top_at_1 + real(kind_phys) :: tem0d, tem1, tem2 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. Model%lslwr) return + + ! Are any optional outputs requested? + l_fluxeslw2d = present(flxprf_lw) + + ! ####################################################################################### + ! What is vertical ordering? + ! ####################################################################################### + top_at_1 = (p_lev(1,1) .lt. p_lev(1, Model%levs)) + if (top_at_1) then + iSFC = Model%levs+1 + iTOA = 1 + else + iSFC = 1 + iTOA = Model%levs+1 + endif + + ! ####################################################################################### + ! Compute LW heating-rates. + ! ####################################################################################### + if (Model%lslwr) then + ! Clear-sky heating-rate (optional) + if (Model%lwhtr) then + call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & + fluxlwUP_clrsky, & ! IN - RRTMGP upward longwave clear-sky flux profiles (W/m2) + fluxlwDOWN_clrsky, & ! IN - RRTMGP downward longwave clear-sky flux profiles (W/m2) + p_lev, & ! IN - Pressure @ layer-interfaces (Pa) + hlw0)) ! OUT - Longwave clear-sky heating rate (K/sec) + endif + ! All-sky heating-rate (mandatory) + call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & + fluxlwUP_allsky, & ! IN - RRTMGP upward longwave all-sky flux profiles (W/m2) + fluxlwDOWN_allsky, & ! IN - RRTMGP downward longwave all-sky flux profiles (W/m2) + p_lev, & ! IN - Pressure @ layer-interfaces (Pa) + hlwc)) ! OUT - Longwave all-sky heating rate (K/sec) + + ! Copy fluxes from RRTGMP types into model radiation types. + ! Mandatory outputs + Diag%topflw(:)%upfxc = fluxlwUP_allsky(:,iTOA) + Diag%topflw(:)%upfx0 = fluxlwUP_clrsky(:,iTOA) + Radtend%sfcflw(:)%upfxc = fluxlwUP_allsky(:,iSFC) + Radtend%sfcflw(:)%upfx0 = fluxlwUP_clrsky(:,iSFC) + Radtend%sfcflw(:)%dnfxc = fluxlwDOWN_allsky(:,iSFC) + Radtend%sfcflw(:)%dnfx0 = fluxlwDOWN_clrsky(:,iSFC) + + ! Optional outputs + if(l_fluxeslw2d) then + flxprf_lw%upfxc = fluxlwUP_allsky + flxprf_lw%dnfxc = fluxlwDOWN_allsky + flxprf_lw%upfx0 = fluxlwUP_clrsky + flxprf_lw%dnfx0 = fluxlwDOWN_clrsky + endif + endif + + ! ####################################################################################### + ! Save LW outputs. + ! ####################################################################################### + if (Model%lslwr) then + ! Save surface air temp for diurnal adjustment at model t-steps + Radtend%tsflw (:) = tsfa(:) + + ! All-sky heating rate profile + do k = 1, model%levs + Radtend%htrlw(1:im,k) = hlwc(1:im,k) + enddo + if (Model%lwhtr) then + do k = 1, model%levs + Radtend%lwhc(1:im,k) = hlw0(1:im,k) + enddo + endif + + ! Radiation fluxes for other physics processes + Coupling%sfcdlw(:) = Radtend%sfcflw(:)%dnfxc + endif + + ! ####################################################################################### + ! Save LW diagnostics + ! - For time averaged output quantities (including total-sky and clear-sky SW and LW + ! fluxes at TOA and surface; conventional 3-domain cloud amount, cloud top and base + ! pressure, and cloud top temperature; aerosols AOD, etc.), store computed results in + ! corresponding slots of array fluxr with appropriate time weights. + ! - Collect the fluxr data for wrtsfc + ! ####################################################################################### + if (Model%lssav) then + if (Model%lslwr) then + do i=1,im + ! LW all-sky fluxes + Diag%fluxr(i,1 ) = Diag%fluxr(i,1 ) + Model%fhlwr * fluxlwUP_allsky( i,iTOA) ! total sky top lw up + Diag%fluxr(i,19) = Diag%fluxr(i,19) + Model%fhlwr * fluxlwDOWN_allsky(i,iSFC) ! total sky sfc lw dn + Diag%fluxr(i,20) = Diag%fluxr(i,20) + Model%fhlwr * fluxlwUP_allsky( i,iSFC) ! total sky sfc lw up + ! LW clear-sky fluxes + Diag%fluxr(i,28) = Diag%fluxr(i,28) + Model%fhlwr * fluxlwUP_clrsky( i,iTOA) ! clear sky top lw up + Diag%fluxr(i,30) = Diag%fluxr(i,30) + Model%fhlwr * fluxlwDOWN_clrsky(i,iSFC) ! clear sky sfc lw dn + Diag%fluxr(i,33) = Diag%fluxr(i,33) + Model%fhlwr * fluxlwUP_clrsky( i,iSFC) ! clear sky sfc lw up + enddo + + do i=1,im + Diag%fluxr(i,17) = Diag%fluxr(i,17) + raddt * cldsa(i,4) + Diag%fluxr(i,18) = Diag%fluxr(i,18) + raddt * cldsa(i,5) + enddo + + ! Save cld frac,toplyr,botlyr and top temp, note that the order of h,m,l cloud is reversed for + ! the fluxr output. save interface pressure (pa) of top/bot + do j = 1, 3 + do i = 1, IM + tem0d = raddt * cldsa(i,j) + itop = mtopa(i,j) + ibtc = mbota(i,j) + Diag%fluxr(i, 8-j) = Diag%fluxr(i, 8-j) + tem0d + Diag%fluxr(i,11-j) = Diag%fluxr(i,11-j) + tem0d * Statein%prsi(i,itop) + Diag%fluxr(i,14-j) = Diag%fluxr(i,14-j) + tem0d * Statein%prsi(i,ibtc) + Diag%fluxr(i,17-j) = Diag%fluxr(i,17-j) + tem0d * Statein%tgrs(i,itop) + + ! Add optical depth and emissivity output + tem2 = 0. + do k=ibtc,itop + tem2 = tem2 + cldtaulw(i,k) ! approx 10. mu channel + enddo + Diag%fluxr(i,46-j) = Diag%fluxr(i,46-j) + tem0d * (1.0-exp(-tem2)) + enddo + enddo + endif + endif + + end subroutine GFS_rrtmgp_lw_post_run + + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_lw_post_finalize + ! ######################################################################################### + subroutine GFS_rrtmgp_lw_post_finalize () + end subroutine GFS_rrtmgp_lw_post_finalize + +end module GFS_rrtmgp_lw_post diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta new file mode 100644 index 000000000..dbe96120d --- /dev/null +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -0,0 +1,199 @@ +[ccpp-arg-table] + name = GFS_rrtmgp_lw_post_run + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = instance of derived type GFS_control_type + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[Grid] + standard_name = GFS_grid_type_instance + long_name = instance of derived type GFS_grid_type + units = DDT + dimensions = () + type = GFS_grid_type + intent = in + optional = F +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = instance of derived type GFS_radtend_type + units = DDT + dimensions = () + type = GFS_radtend_type + intent = inout + optional = F +[Coupling] + standard_name = GFS_coupling_type_instance + long_name = instance of derived type GFS_coupling_type + units = DDT + dimensions = () + type = GFS_coupling_type + intent = inout + optional = F +[Diag] + standard_name = GFS_diag_type_instance + long_name = instance of derived type GFS_diag_type + units = DDT + dimensions = () + type = GFS_diag_type + intent = inout + optional = F +[Statein] + standard_name = GFS_statein_type_instance + long_name = instance of derived type GFS_statein_type + units = DDT + dimensions = () + type = GFS_statein_type + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[tsfa] + standard_name = surface_air_temperature_for_radiation + long_name = lowest model layer air temperature for radiation + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure level + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[fluxlwUP_allsky] + standard_name = RRTMGP_lw_flux_profile_upward_allsky + long_name = RRTMGP upward longwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[fluxlwDOWN_allsky] + standard_name = RRTMGP_lw_flux_profile_downward_allsky + long_name = RRTMGP downward longwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[fluxlwUP_clrsky] + standard_name = RRTMGP_lw_flux_profile_upward_clrsky + long_name = RRTMGP upward longwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[fluxlwDOWN_clrsky] + standard_name = RRTMGP_lw_flux_profile_downward_clrsky + long_name = RRTMGP downward longwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[raddt] + standard_name = time_step_for_radiation + long_name = radiation time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[aerodp] + standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles + long_name = vertical integrated optical depth for various aerosol species + units = none + dimensions = (horizontal_dimension,number_of_species_for_aerosol_optical_depth) + type = real + kind = kind_phys + intent = in + optional = F +[cldsa] + standard_name = cloud_area_fraction_for_radiation + long_name = fraction of clouds for low, middle, high, total and BL + units = frac + dimensions = (horizontal_dimension,5) + type = real + kind = kind_phys + intent = in + optional = F +[mtopa] + standard_name = model_layer_number_at_cloud_top + long_name = vertical indices for low, middle and high cloud tops + units = index + dimensions = (horizontal_dimension,3) + type = integer + intent = in + optional = F +[mbota] + standard_name = model_layer_number_at_cloud_base + long_name = vertical indices for low, middle and high cloud bases + units = index + dimensions = (horizontal_dimension,3) + type = integer + intent = in + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cldtaulw] + standard_name = RRTMGP_cloud_optical_depth_layers_at_10mu_band + long_name = approx 10mu band layer cloud optical depth + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[flxprf_lw] + standard_name = RRTMGP_lw_fluxes + long_name = lw fluxes total sky / csk and up / down at levels + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = proflw_type + intent = inout + optional = T +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 new file mode 100644 index 000000000..1344f269c --- /dev/null +++ b/physics/GFS_rrtmgp_pre.F90 @@ -0,0 +1,783 @@ +module GFS_rrtmgp_pre + use physparam + use machine, only: & + kind_phys ! Working type + use GFS_typedefs, only: & + GFS_statein_type, & ! Prognostic state data in from dycore + GFS_stateout_type, & ! Prognostic state or tendencies return to dycore + GFS_sfcprop_type, & ! Surface fields + GFS_coupling_type, & ! Fields to/from coupling with other components (e.g. land/ice/ocean/etc.) + GFS_control_type, & ! Model control parameters + GFS_grid_type, & ! Grid and interpolation related data + GFS_tbd_type, & ! To-Be-Determined data that doesn't fit in any one container + GFS_radtend_type, & ! Radiation tendencies needed in physics + GFS_diag_type ! Fields targetted for diagnostic output + use physcons, only: & + eps => con_eps, & ! Rd/Rv + epsm1 => con_epsm1, & ! Rd/Rv-1 + fvirt => con_fvirt, & ! Rv/Rd-1 + rog => con_rog ! Rd/g + use radcons, only: & + qmin, epsq ! Minimum vlaues for varius calculations + use funcphys, only: & + fpvs ! Function ot compute sat. vapor pressure over liq. + use module_radiation_astronomy,only: & + coszmn ! Function to compute cos(SZA) + use module_radiation_gases, only: & + NF_VGAS, & ! Number of active gas species + getgases, & ! Routine to setup trace gases + getozn ! Routine to setup ozone + use module_radiation_aerosols, only: & + NF_AESW, & ! Number of optical-fields in SW output (3=tau+g+omega) + NF_AELW, & ! Number of optical-fields in LW output (3=tau+g+omega) + setaer, & ! Routine to compute aerosol radiative properties (tau,g,omega) + NSPC1 ! Number of species for vertically integrated aerosol optical-depth + use module_radiation_clouds, only: & + NF_CLDS, & ! Number of fields in "clouds" array (e.g. (cloud(1)=lwp,clouds(2)=ReffLiq,...) + progcld1, & ! Zhao/Moorthi's prognostic cloud scheme + progcld3, & ! Zhao/Moorthi's prognostic cloud+pdfcld + progcld4, & ! GFDL cloud scheme + progcld5, & ! Thompson / WSM6 cloud micrphysics scheme + progclduni ! Unified cloud-scheme + use surface_perturbation, only: & + cdfnor ! Routine to compute CDF (used to compute percentiles) + use module_radiation_surface, only: & + setemis, & ! Routine to compute surface-emissivity + NF_ALBD, & ! Number of surface albedo categories (4; nir-direct, nir-diffuse, uvvis-direct, uvvis-diffuse) + setalb ! Routine to compute surface albedo + ! RRTMGP types + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_gas_concentrations, only: ty_gas_concs + use rrtmgp_aux, only: check_error_msg!, rrtmgp_minP, rrtmgp_minT + use mo_rrtmgp_constants, only: grav, avogad + use mo_rrtmg_lw_cloud_optics + + real(kind_phys), parameter :: & + amd = 28.9644_kind_phys, & ! Molecular weight of dry-air (g/mol) + amw = 18.0154_kind_phys, & ! Molecular weight of water vapor (g/mol) + amo3 = 47.9982_kind_phys, & ! Modelular weight of ozone (g/mol) + amdw = amd/amw, & ! Molecular weight of dry air / water vapor + amdo3 = amd/amo3 ! Molecular weight of dry air / ozone + + ! Some common trace gas on/off flags. + ! This allows for control over which trace gases are used in RRTMGP radiation scheme via + ! namelist. + logical :: & + isActive_h2o = .false., & ! + isActive_co2 = .false., & ! + isActive_o3 = .false., & ! + isActive_n2o = .false., & ! + isActive_ch4 = .false., & ! + isActive_o2 = .false., & ! + isActive_ccl4 = .false., & ! + isActive_cfc11 = .false., & ! + isActive_cfc12 = .false., & ! + isActive_cfc22 = .false. ! + integer :: iStr_h2o, iStr_co2, iStr_o3, iStr_n2o, iStr_ch4, iStr_o2, iStr_ccl4, & + iStr_cfc11, iStr_cfc12, iStr_cfc22 + + public GFS_rrtmgp_pre_run,GFS_rrtmgp_pre_init,GFS_rrtmgp_pre_finalize +contains + + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_pre_init + ! ######################################################################################### +!! \section arg_table_GFS_rrtmgp_pre_init +!! \htmlinclude GFS_rrtmgp_pre_init.html +!! + subroutine GFS_rrtmgp_pre_init(Model, Radtend, active_gases_array, errmsg, errflg) + ! Inputs + type(GFS_control_type), intent(inout) :: & + Model ! DDT: FV3-GFS model control parameters + type(GFS_radtend_type), intent(inout) :: & + Radtend ! DDT: FV3-GFS radiation tendencies + + ! Outputs + character(len=*),dimension(Model%ngases), intent(out) :: & + active_gases_array ! Character array containing trace gases to include in RRTMGP + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error flag + + ! Local variables + character(len=1) :: tempstr + integer :: ij, count + integer,dimension(Model%ngases,2) :: gasIndices + + ! Initialize + errmsg = '' + errflg = 0 + + if (len(Model%active_gases) .eq. 0) return + + ! Which gases are active? Provided via physics namelist. + + ! Pull out gas names from list... + ! First grab indices in character array corresponding to start:end of gas name. + gasIndices(1,1)=1 + count=1 + do ij=1,len(Model%active_gases) + tempstr=trim(Model%active_gases(ij:ij)) + if (tempstr .eq. '_') then + gasIndices(count,2)=ij-1 + gasIndices(count+1,1)=ij+1 + count=count+1 + endif + enddo + gasIndices(Model%ngases,2)=len(trim(Model%active_gases)) + + ! Now extract the gas names + do ij=1,Model%ngases + active_gases_array(ij) = Model%active_gases(gasIndices(ij,1):gasIndices(ij,2)) + enddo + + ! Which gases are active? (This is purely for flexibility) + do ij=1,Model%ngases + if(trim(active_gases_array(ij)) .eq. 'h2o') then + isActive_h2o = .true. + istr_h2o = ij + endif + if(trim(active_gases_array(ij)) .eq. 'co2') then + isActive_co2 = .true. + istr_co2 = ij + endif + if(trim(active_gases_array(ij)) .eq. 'o3') then + isActive_o3 = .true. + istr_o3 = ij + endif + if(trim(active_gases_array(ij)) .eq. 'n2o') then + isActive_n2o = .true. + istr_n2o = ij + endif + if(trim(active_gases_array(ij)) .eq. 'ch4') then + isActive_ch4 = .true. + istr_ch4 = ij + endif + if(trim(active_gases_array(ij)) .eq. 'o2') then + isActive_o2 = .true. + istr_o2 = ij + endif + if(trim(active_gases_array(ij)) .eq. 'ccl4') then + isActive_ccl4 = .true. + istr_ccl4 = ij + endif + if(trim(active_gases_array(ij)) .eq. 'cfc11') then + isActive_cfc11 = .true. + istr_cfc11 = ij + endif + if(trim(active_gases_array(ij)) .eq. 'cfc12') then + isActive_cfc12 = .true. + istr_cfc12 = ij + endif + if(trim(active_gases_array(ij)) .eq. 'cfc22') then + isActive_cfc22 = .true. + istr_cfc22 = ij + endif + enddo + + end subroutine GFS_rrtmgp_pre_init + + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_pre_run + ! ######################################################################################### +!> \section arg_table_GFS_rrtmgp_pre_run +!! \htmlinclude GFS_rrtmgp_pre_run.html +!! + subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, Tbd, & ! IN + ncol, lw_gas_props, active_gases_array, & ! IN + sec_diff_byband, raddt, p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, cld_frac, cld_lwp,& ! OUT + cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, cld_rerain, & ! OUT + tv_lay, relhum, tracer, cldsa, mtopa, mbota, de_lgth, gas_concentrations, & ! OUT + errmsg, errflg) + + ! Inputs + type(GFS_control_type), intent(in) :: & + Model ! DDT: FV3-GFS model control parameters + type(GFS_grid_type), intent(in) :: & + Grid ! DDT: FV3-GFS grid and interpolation related data + type(GFS_statein_type), intent(in) :: & + Statein ! DDT: FV3-GFS prognostic state data in from dycore + type(GFS_coupling_type), intent(in) :: & + Coupling ! DDT: FV3-GFS fields to/from coupling with other components + type(GFS_radtend_type), intent(inout) :: & + Radtend ! DDT: FV3-GFS radiation tendencies + type(GFS_sfcprop_type), intent(in) :: & + Sfcprop ! DDT: FV3-GFS surface fields + type(GFS_tbd_type), intent(in) :: & + Tbd ! DDT: FV3-GFS data not yet assigned to a defined container + integer, intent(in) :: & + ncol ! Number of horizontal grid points + type(ty_gas_optics_rrtmgp),intent(in) :: & + lw_gas_props ! RRTMGP DDT: longwave spectral information + character(len=*),dimension(Model%ngases), intent(in) :: & + active_gases_array ! Character array containing trace gases to include in RRTMGP + + ! Outputs + real(kind_phys), dimension(ncol,Model%levs), intent(out) :: & + p_lay, & ! Pressure at model-layer + t_lay ! Temperature at model layer + real(kind_phys), dimension(ncol,Model%levs+1), intent(out) :: & + p_lev, & ! Pressure at model-interface + t_lev ! Temperature at model-interface + real(kind_phys), intent(out) :: & + raddt ! Radiation time-step + real(kind_phys), dimension(ncol), intent(out) :: & + tsfg, & ! Ground temperature + tsfa ! Skin temperature + type(ty_gas_concs),intent(out) :: & + gas_concentrations ! RRTMGP DDT: gas volumne mixing ratios + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error flag + real(kind_phys), dimension(ncol,Model%levs),intent(out) :: & + cld_frac, & ! Total cloud fraction + cld_lwp, & ! Cloud liquid water path + cld_reliq, & ! Cloud liquid effective radius + cld_iwp, & ! Cloud ice water path + cld_reice, & ! Cloud ice effecive radius + cld_swp, & ! Cloud snow water path + cld_resnow, & ! Cloud snow effective radius + cld_rwp, & ! Cloud rain water path + cld_rerain ! Cloud rain effective radius + real(kind_phys), dimension(ncol,Model%levs),intent(out) :: & + tv_lay, & ! Virtual temperatue at model-layers + relhum ! Relative-humidity at model-layers + real(kind_phys), dimension(ncol, Model%levs, 2:Model%ntrac),intent(out) :: & + tracer ! Array containing trace gases + integer,dimension(ncol,3),intent(out) :: & + mbota, & ! Vertical indices for cloud tops + mtopa ! Vertical indices for cloud bases + real(kind_phys), dimension(ncol,5), intent(out) :: & + cldsa ! Fraction of clouds for low, middle, high, total and BL + real(kind_phys), dimension(ncol), intent(out) :: & + de_lgth ! Decorrelation length + real(kind_phys), dimension(lw_gas_props%get_nband(),ncol),intent(out) :: & + sec_diff_byband + + ! Local variables + integer :: i, j, iCol, iBand, iSFC, iTOA, iLay + logical :: top_at_1 + real(kind_phys),dimension(NCOL,Model%levs) :: vmr_o3, vmr_h2o, coldry, tem0, colamt + real(kind_phys) :: es, qs, tem1, tem2 + real(kind_phys), dimension(ncol, NF_ALBD) :: sfcalb + real(kind_phys), dimension(ncol, Model%levs) :: qs_lay, q_lay, deltaZ, deltaP, o3_lay + real(kind_phys), dimension(ncol, Model%levs, NF_VGAS) :: gas_vmr + real(kind_phys), dimension(ncol, Model%levs, NF_CLDS) :: clouds + real(kind_phys), dimension(ncol) :: precipitableH2o + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. (Model%lsswr .or. Model%lslwr)) return + + ! ####################################################################################### + ! What is vertical ordering? + ! ####################################################################################### + top_at_1 = (Statein%prsi(1,1) .lt. Statein%prsi(1, Model%levs)) + if (top_at_1) then + iSFC = Model%levs + iTOA = 1 + else + iSFC = 1 + iTOA = Model%levs + endif + + ! ####################################################################################### + ! Compute some fields needed by RRTMGP + ! ####################################################################################### + + ! Water-vapor mixing-ratio + q_lay(1:ncol,:) = Statein%qgrs(1:NCOL,:,1) + where(q_lay .lt. 1.e-6) q_lay = 1.e-6 + + ! Pressure at layer-interface + p_lev(1:NCOL,:) = Statein%prsi(1:NCOL,:) + + ! Pressure at layer-center + p_lay(1:NCOL,:) = Statein%prsl(1:NCOL,:) + + ! Temperature at layer-center + t_lay(1:NCOL,:) = Statein%tgrs(1:NCOL,:) + + ! Temperature at layer-interfaces + if (top_at_1) then + t_lev(1:NCOL,1) = t_lay(1:NCOL,iTOA) + t_lev(1:NCOL,2:iSFC) = (t_lay(1:NCOL,2:iSFC)+t_lay(1:NCOL,1:iSFC-1))/2._kind_phys + t_lev(1:NCOL,iSFC+1) = Sfcprop%tsfc(1:NCOL) + else + t_lev(1:NCOL,1) = Sfcprop%tsfc(1:NCOL) + t_lev(1:NCOL,2:iTOA) = (t_lay(1:NCOL,2:iTOA)+t_lay(1:NCOL,1:iTOA-1))/2._kind_phys + t_lev(1:NCOL,iTOA+1) = t_lay(1:NCOL,iTOA) + endif + + ! Compute layer pressure thicknes + deltaP = abs(p_lev(:,2:model%levs+1)-p_lev(:,1:model%levs)) + + ! Compute a bunch of thermodynamic fields needed by the macrophysics schemes. Relative humidity, + ! saturation mixing-ratio, vapor mixing-ratio, virtual temperature, layer thickness,... + do iCol=1,NCOL + do iLay=1,Model%levs + es = min( p_lay(iCol,iLay), fpvs( t_lay(iCol,iLay) ) ) ! fpvs and prsl in pa + qs = max( QMIN, eps * es / (p_lay(iCol,iLay) + epsm1*es) ) + relhum(iCol,iLay) = max( 0._kind_phys, min( 1._kind_phys, max(QMIN, q_lay(iCol,iLay))/qs ) ) + qs_lay(iCol,iLay) = qs + tv_lay(iCol,iLay) = t_lay(iCol,iLay) * (1._kind_phys + fvirt*q_lay(iCol,iLay)) + deltaZ(iCol,iLay) = (rog*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) + enddo + enddo + + ! ####################################################################################### + ! Get layer ozone mass mixing ratio + ! ####################################################################################### + ! First recast remaining all tracers (except sphum) forcing them all to be positive + do j = 2, model%NTRAC + tracer(1:NCOL,:,j) = Statein%qgrs(1:NCOL,:,j) + where(tracer(:,:,j) .lt. 0.0) tracer(:,:,j) = 0._kind_phys + enddo + + if (Model%ntoz > 0) then + do iLay=1,Model%levs + do iCol=1,NCOL + o3_lay(iCol,iLay) = max( QMIN, tracer(iCol,iLay,Model%ntoz) ) + enddo + enddo + ! OR Use climatological ozone data + else + call getozn (Statein%prslk(1:NCOL,:), Grid%xlat, NCOL, Model%levs, o3_lay) + endif + + ! ####################################################################################### + ! Set gas concentrations for RRTMGP + ! ####################################################################################### + ! Call getgases(), to set up non-prognostic gas volume mixing ratios (gas_vmr). + call getgases (p_lev/100., Grid%xlon, Grid%xlat, NCOL, Model%levs, gas_vmr) + + ! Compute volume mixing-ratios for ozone (mmr) and specific-humidity. + vmr_h2o = merge((q_lay/(1-q_lay))*amdw, 0., q_lay .ne. 1.) + vmr_o3 = merge(o3_lay*amdo3, 0., o3_lay .gt. 0.) + + ! Initialize and opulate RRTMGP DDT w/ gas-concentrations + call check_error_msg('sw_gas_optics_init',gas_concentrations%init(active_gases_array)) + call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_o2), gas_vmr(:,:,4))) + call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_co2), gas_vmr(:,:,1))) + call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_ch4), gas_vmr(:,:,3))) + call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_n2o), gas_vmr(:,:,2))) + call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_h2o), vmr_h2o)) + call check_error_msg('GFS_rrtmgp_pre_run',gas_concentrations%set_vmr(active_gases_array(iStr_o3), vmr_o3)) + + ! ####################################################################################### + ! Compute diffusivity angle adjustments for each longwave band + ! *NOTE* Legacy RRTMGP code + ! ####################################################################################### + ! Conpute diffusivity angle adjustments. + ! First need to compute precipitable water in each column + tem0 = (1._kind_phys - vmr_h2o)*amd + vmr_h2o*amw + coldry = ( 1.0e-20 * 1.0e3 *avogad)*(deltap*.01) / (100.*grav*tem0*(1._kind_phys + vmr_h2o)) + colamt = max(0._kind_phys, coldry*vmr_h2o) + do iCol=1,nCol + tem1 = 0._kind_phys + tem2 = 0._kind_phys + do iLay=1,Model%levs + tem1 = tem1 + coldry(iCol,iLay)+colamt(iCol,iLay) + tem2 = tem2 + colamt(iCol,iLay) + enddo + precipitableH2o(iCol) = p_lev(iCol,iSFC)*0.01*(10._kind_phys*tem2 / (amdw*tem1*grav)) + enddo + + ! Reset diffusivity angle for Bands 2-3 and 5-9 to vary (between 1.50 + ! and 1.80) as a function of total column water vapor. the function + ! has been defined to minimize flux and cooling rate errors in these bands + ! over a wide range of precipitable water values. + do iCol=1,nCol + do iBand = 1, lw_gas_props%get_nband() + if (iBand==1 .or. iBand==4 .or. iBand==10) then + sec_diff_byband(iBand,iCol) = diffusivityB1410 + else + sec_diff_byband(iBand,iCol) = min( diffusivityHigh, max(diffusivityLow, & + a0(iBand)+a1(iBand)*exp(a2(iBand)*precipitableH2o(iCol)))) + endif + enddo + enddo + + ! ####################################################################################### + ! Radiation time step (output) (Is this really needed?) (Used by some diangostics) + ! ####################################################################################### + raddt = min(Model%fhswr, Model%fhlwr) + + ! ####################################################################################### + ! Setup surface ground temperature and ground/air skin temperature if required. + ! ####################################################################################### + tsfg(1:NCOL) = Sfcprop%tsfc(1:NCOL) + tsfa(1:NCOL) = Sfcprop%tsfc(1:NCOL) + + ! ####################################################################################### + ! Cloud microphysics + ! ####################################################################################### + call cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_lay, p_lev, & + tv_lay, relhum, qs_lay, q_lay, deltaZ, deltaP, clouds, cldsa, mbota, mtopa, de_lgth) + + ! Copy output cloud fields + cld_frac = clouds(:,:,1) + cld_lwp = clouds(:,:,2) + cld_reliq = clouds(:,:,3) + cld_iwp = clouds(:,:,4) + cld_reice = clouds(:,:,5) + cld_rwp = clouds(:,:,6) + cld_rerain = clouds(:,:,7) + cld_swp = clouds(:,:,8) + cld_resnow = clouds(:,:,9) + + end subroutine GFS_rrtmgp_pre_run + + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_pre_finalize + ! ######################################################################################### + subroutine GFS_rrtmgp_pre_finalize () + end subroutine GFS_rrtmgp_pre_finalize + + ! ######################################################################################### + ! Subroutine cloud_microphysics() + ! ######################################################################################### + subroutine cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_lay, p_lev,& + tv_lay, relhum, qs_lay, q_lay, deltaZ, deltaP, clouds, cldsa, mbota, mtopa, de_lgth) + + ! Inputs + type(GFS_control_type), intent(in) :: & + Model ! DDT: FV3-GFS model control parameters + type(GFS_tbd_type), intent(in) :: & + Tbd ! DDT: FV3-GFS data not yet assigned to a defined container + type(GFS_grid_type), intent(in) :: & + Grid ! DDT: FV3-GFS grid and interpolation related data + type(GFS_sfcprop_type), intent(in) :: & + Sfcprop ! DDT: FV3-GFS surface fields + integer, intent(in) :: & + ncol ! Number of horizontal gridpoints + real(kind_phys), dimension(ncol, Model%levs, 2:Model%ntrac),intent(in) :: & + tracer ! Cloud condensate amount in layer by type () + real(kind_phys), dimension(ncol,Model%levs), intent(in) :: & + p_lay, & ! Pressure @ model layer centers (Pa) + t_lay, & ! Temperature @ layer centers (K) + tv_lay, & ! Virtual temperature @ layer centers (K) + relhum, & ! Relative humidity @ layer centers(1) + qs_lay, & ! Saturation specific humidity @ layer center (kg/kg) + q_lay, & ! Specific humidity @ layer centers(kg/kg) + deltaZ, & ! Layer thickness (km) + deltaP ! Layer thickness (Pa) + real(kind_phys), dimension(ncol,Model%levs+1), intent(in) :: & + p_lev ! Pressure @ model layer interface (Pa) + + ! Outputs + real(kind_phys), dimension(ncol, Model%levs, NF_CLDS),intent(out) :: & + clouds ! Cloud properties (NCOL,Model%levs,NF_CLDS) + integer,dimension(ncol,3), intent(out) :: & + mbota, & ! Vertical indices for low, mid, hi cloud bases (NCOL,3) + mtopa ! Vertical indices for low, mid, hi cloud tops (NCOL,3) + real(kind_phys), dimension(ncol), intent(out) ::& + de_lgth ! Clouds decorrelation length (km) + real(kind_phys), dimension(ncol, 5), intent(out) :: & + cldsa ! Fraction of clouds for low, mid, hi, tot, bl (NCOL,5) + + ! Local variables + real(kind_phys), dimension(ncol, Model%levs, Model%ncnd) :: cld_condensate + integer :: i,k + real(kind_phys), parameter :: xrc3 = 100. + real(kind_phys), dimension(ncol, Model%levs) :: delta_q, cnv_w, cnv_c, effr_l, & + effr_i, effr_r, effr_s, cldcov + + ! ####################################################################################### + ! Obtain cloud information for radiation calculations + ! (clouds,cldsa,mtopa,mbota) + ! for prognostic cloud: + ! - For Zhao/Moorthi's prognostic cloud scheme, + ! call module_radiation_clouds::progcld1() + ! - For Zhao/Moorthi's prognostic cloud+pdfcld, + ! call module_radiation_clouds::progcld3() + ! call module_radiation_clouds::progclduni() for unified cloud and ncld=2 + ! ####################################################################################### + cld_condensate = 0.0_kind_phys + if (Model%ncnd == 1) then ! Zhao_Carr_Sundqvist + cld_condensate(1:NCOL,1:Model%levs,1) = tracer(1:NCOL,1:Model%levs,Model%ntcw) ! -liquid water/ice + elseif (Model%ncnd == 2) then ! MG + cld_condensate(1:NCOL,1:Model%levs,1) = tracer(1:NCOL,1:Model%levs,Model%ntcw) ! -liquid water + cld_condensate(1:NCOL,1:Model%levs,2) = tracer(1:NCOL,1:Model%levs,Model%ntiw) ! -ice water + elseif (Model%ncnd == 4) then ! MG2 + cld_condensate(1:NCOL,1:Model%levs,1) = tracer(1:NCOL,1:Model%levs,Model%ntcw) ! -liquid water + cld_condensate(1:NCOL,1:Model%levs,2) = tracer(1:NCOL,1:Model%levs,Model%ntiw) ! -ice water + cld_condensate(1:NCOL,1:Model%levs,3) = tracer(1:NCOL,1:Model%levs,Model%ntrw) ! -rain water + cld_condensate(1:NCOL,1:Model%levs,4) = tracer(1:NCOL,1:Model%levs,Model%ntsw) ! -snow water + elseif (Model%ncnd == 5) then ! GFDL MP, Thompson, MG3 + cld_condensate(1:NCOL,1:Model%levs,1) = tracer(1:NCOL,1:Model%levs,Model%ntcw) ! -liquid water + cld_condensate(1:NCOL,1:Model%levs,2) = tracer(1:NCOL,1:Model%levs,Model%ntiw) ! -ice water + cld_condensate(1:NCOL,1:Model%levs,3) = tracer(1:NCOL,1:Model%levs,Model%ntrw) ! -rain water + cld_condensate(1:NCOL,1:Model%levs,4) = tracer(1:NCOL,1:Model%levs,Model%ntsw) + & ! -snow + grapuel + tracer(1:NCOL,1:Model%levs,Model%ntgl) + endif + where(cld_condensate < epsq) cld_condensate = 0.0 + + ! For GFDL microphysics scheme... + if (Model%imp_physics == 11 ) then + if (.not. Model%lgfdlmprad) then + cld_condensate(:,:,1) = tracer(:,1:Model%levs,Model%ntcw) + cld_condensate(:,:,1) = cld_condensate(:,:,1) + tracer(:,1:Model%levs,Model%ntrw) + cld_condensate(:,:,1) = cld_condensate(:,:,1) + tracer(:,1:Model%levs,Model%ntiw) + cld_condensate(:,:,1) = cld_condensate(:,:,1) + tracer(:,1:Model%levs,Model%ntsw) + cld_condensate(:,:,1) = cld_condensate(:,:,1) + tracer(:,1:Model%levs,Model%ntgl) + endif + do k=1,Model%levs + do i=1,NCOL + if (cld_condensate(i,k,1) < EPSQ ) cld_condensate(i,k,1) = 0.0 + enddo + enddo + endif + + if (Model%uni_cld) then + if (Model%effr_in) then + cldcov(:,:) = Tbd%phy_f3d(:,:,Model%indcld) + effr_l(:,:) = Tbd%phy_f3d(:,:,2) + effr_i(:,:) = Tbd%phy_f3d(:,:,3) + effr_r(:,:) = Tbd%phy_f3d(:,:,4) + effr_s(:,:) = Tbd%phy_f3d(:,:,5) + else + do k=1,model%levs + do i=1,ncol + cldcov(i,k) = Tbd%phy_f3d(i,k,Model%indcld) + enddo + enddo + endif + elseif (Model%imp_physics == Model%imp_physics_gfdl) then ! GFDL MP + cldcov(1:NCOL,1:Model%levs) = tracer(1:NCOL,1:Model%levs,Model%ntclamt) + if (Model%effr_in) then + effr_l(:,:) = Tbd%phy_f3d(:,:,1) + effr_i(:,:) = Tbd%phy_f3d(:,:,2) + effr_r(:,:) = Tbd%phy_f3d(:,:,3) + effr_s(:,:) = Tbd%phy_f3d(:,:,4) + endif + else ! neither of the other two cases + cldcov = 0.0 + endif + + + ! Add suspended convective cloud water to grid-scale cloud water + ! only for cloud fraction & radiation computation it is to enhance + ! cloudiness due to suspended convec cloud water for zhao/moorthi's + ! (imp_phys=99) & ferrier's (imp_phys=5) microphysics schemes + if ((Model%num_p3d == 4) .and. (Model%npdf3d == 3)) then ! same as Model%imp_physics = 99 + delta_q(1:ncol,1:Model%levs) = Tbd%phy_f3d(1:ncol,Model%levs:1:-1,5) + cnv_w (1:ncol,1:Model%levs) = Tbd%phy_f3d(1:ncol,Model%levs:1:-1,6) + cnv_c (1:ncol,1:Model%levs) = Tbd%phy_f3d(1:ncol,Model%levs:1:-1,7) + elseif ((Model%npdf3d == 0) .and. (Model%ncnvcld3d == 1)) then ! same as MOdel%imp_physics=98 + delta_q(1:ncol,1:Model%levs) = 0.0 + cnv_w (1:ncol,1:Model%levs) = Tbd%phy_f3d(1:ncol,1:Model%levs,Model%num_p3d+1) + cnv_c (1:ncol,1:Model%levs) = 0.0 + else ! all the rest + delta_q(1:ncol,1:Model%levs) = 0.0 + cnv_w (1:ncol,1:Model%levs) = 0.0 + cnv_c (1:ncol,1:Model%levs) = 0.0 + endif + + ! For zhao/moorthi's prognostic cloud scheme, add in convective cloud water to liquid-cloud water + if (Model%imp_physics == 99) then + cld_condensate(1:NCOL,1:Model%levs,1) = cld_condensate(1:NCOL,1:Model%levs,1) + cnv_w(1:NCOL,1:Model%levs) + endif + + ! For MG prognostic cloud scheme, add in convective cloud water to liquid-and-ice-cloud condensate + if (Model%imp_physics == 10) then + cld_condensate(1:NCOL,1:Model%levs,1) = cld_condensate(1:NCOL,1:Model%levs,1) + cnv_w(1:NCOL,1:Model%levs) + cld_condensate(1:NCOL,1:Model%levs,2) + endif + + ! ####################################################################################### + ! MICROPHYSICS + ! ####################################################################################### + ! *) zhao/moorthi's prognostic cloud scheme or unified cloud and/or with MG microphysics + if (Model%imp_physics == 99 .or. Model%imp_physics == 10) then + if (Model%uni_cld .and. Model%ncld >= 2) then + call progclduni( & + p_lay/100., & ! IN - Pressure at model layer centers (mb) + p_lev/100., & ! IN - Pressure at model interfaces (mb) + t_lay, & ! IN - Temperature at layer centers (K) + tv_lay, & ! IN - Virtual temperature at layer centers (K) + cld_condensate, & ! IN - Cloud condensate amount (Model%ncnd types) () + Model%ncnd, & ! IN - Number of cloud condensate types () + Grid%xlat, & ! IN - Latitude (radians) + Grid%xlon, & ! IN - Longitude (radians) + Sfcprop%slmsk, & ! IN - Land/Sea mask () + deltaZ, & ! IN - Layer thickness (km) + deltaP/100., & ! IN - Layer thickness (hPa) + NCOL, & ! IN - Number of horizontal gridpoints + MODEL%LEVS, & ! IN - Number of model layers + MODEL%LEVS+1, & ! IN - Number of model levels + cldcov, & ! IN - Layer cloud fraction (used if uni_cld=.true.) + effr_l, & ! IN - Liquid-water effective radius (microns) + effr_i, & ! IN - Ice-water effective radius (microns) + effr_r, & ! IN - Rain-water effective radius (microns) + effr_s, & ! IN - Snow-water effective radius (microns) + Model%effr_in, & ! IN - Logical, if .true. use input effective radii + clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) + cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) + mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) + mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) + de_lgth) ! OUT - clouds decorrelation length (km) + else + call progcld1 ( & + p_lay/100., & ! IN - Pressure at model layer centers (mb) + p_lev/100., & ! IN - Pressure at model interfaces (mb) + t_lay, & ! IN - Temperature at layer centers (K) + tv_lay, & ! IN - Virtual temperature at layer centers (K) + q_lay, & ! IN - Specific humidity at layer center (kg/kg) + qs_lay, & ! IN - Saturation specific humidity at layer center (kg/kg) + relhum, & ! IN - Relative humidity at layer center (1) + cld_condensate(:,:,1),& ! IN - Cloud condensate amount () + ! (Zhao: liq+convective; MG: liq+ice+convective) + Grid%xlat, & ! IN - Latitude (radians) + Grid%xlon, & ! IN - Longitude (radians) + Sfcprop%slmsk, & ! IN - Land/Sea mask () + deltaZ, & ! IN - Layer thickness (km) + deltaP/100., & ! IN - Layer thickness (hPa) + NCOL, & ! IN - Number of horizontal gridpoints + MODEL%LEVS, & ! IN - Number of model layers + MODEL%LEVS+1, & ! IN - Number of model levels + Model%uni_cld, & ! IN - True for cloud fraction from shoc + Model%lmfshal, & ! IN - True for mass flux shallow convection + Model%lmfdeep2, & ! IN - True for mass flux deep convection + cldcov, & ! IN - Layer cloud fraction (used if uni_cld=.true.) + effr_l, & ! IN - Liquid-water effective radius (microns) + effr_i, & ! IN - Ice-water effective radius (microns) + effr_r, & ! IN - Rain-water effective radius (microns) + effr_s, & ! IN - Snow-water effective radius (microns) + Model%effr_in, & ! IN - Logical, if .true. use input effective radii + clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) + cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) + mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) + mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) + de_lgth) ! OUT - clouds decorrelation length (km) + endif + ! *) zhao/moorthi's prognostic cloud+pdfcld + elseif(Model%imp_physics == 98) then + call progcld3 ( & + p_lay/100., & ! IN - Pressure at model layer centers (mb) + p_lev/100., & ! IN - Pressure at model interfaces (mb) + t_lay, & ! IN - Temperature at layer centers (K) + tv_lay, & ! IN - Virtual temperature at layer centers (K) + q_lay, & ! IN - Specific humidity at layer center (kg/kg) + qs_lay, & ! IN - Saturation specific humidity at layer center (kg/kg) + relhum, & ! IN - Relative humidity at layer center (1) + cld_condensate(:,:,1),& ! IN - Cloud condensate amount (only h20) () + cnv_w, & ! IN - Layer convective cloud condensate + cnv_c, & ! IN - Layer convective cloud cover + Grid%xlat, & ! IN - Latitude (radians) + Grid%xlon, & ! IN - Longitude (radians) + Sfcprop%slmsk, & ! IN - Land/Sea mask () + deltaZ, & ! IN - Layer thickness (km) + deltaP/100., & ! IN - Layer thickness (hPa) + NCOL, & ! IN - Number of horizontal gridpoints + MODEL%LEVS, & ! IN - Number of model layers + MODEL%LEVS+1, & ! IN - Number of model levels + delta_q, & ! IN - Total water distribution width + Model%sup, & ! IN - ??? Supersaturation? + Model%kdt, & ! IN - ??? + Model%me, & ! IN - ??? NOT USED IN PROGCLD3() + clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) + cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) + mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) + mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) + de_lgth) ! OUT - clouds decorrelation length (km) + ! *) GFDL cloud scheme + elseif (Model%imp_physics == 11) then + if (.not.Model%lgfdlmprad) then + call progcld4 ( & + p_lay/100., & ! IN - Pressure at model layer centers (mb) + p_lev/100., & ! IN - Pressure at model interfaces (mb) + t_lay, & ! IN - Temperature at layer centers (K) + tv_lay, & ! IN - Virtual temperature at layer centers (K) + q_lay, & ! IN - Specific humidity at layer center (kg/kg) + qs_lay, & ! IN - Saturation specific humidity at layer center (kg/kg) + relhum, & ! IN - Relative humidity at layer center (1) + cld_condensate(:,:,1),& ! IN - Cloud condensate amount (only h20) () + cnv_w, & ! IN - Layer convective cloud condensate + cnv_c, & ! IN - Layer convective cloud cover + Grid%xlat, & ! IN - Latitude (radians) + Grid%xlon, & ! IN - Longitude (radians) + Sfcprop%slmsk, & ! IN - Land/Sea mask () + cldcov, & ! IN - Layer cloud fraction (used if uni_cld=.true.) + deltaZ, & ! IN - Layer thickness (km) + deltaP/100., & ! IN - Layer thickness (hPa) + NCOL, & ! IN - Number of horizontal gridpoints + MODEL%LEVS, & ! IN - Number of model layers + MODEL%LEVS+1, & ! IN - Number of model levels + clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) + cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) + mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) + mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) + de_lgth) ! OUT - clouds decorrelation length (km) + else + call progclduni( & + p_lay/100., & ! IN - Pressure at model layer centers (mb) + p_lev/100., & ! IN - Pressure at model interfaces (mb) + t_lay, & ! IN - Temperature at layer centers (K) + tv_lay, & ! IN - Virtual temperature at layer centers (K) + cld_condensate, & ! IN - Cloud condensate amount (Model%ncnd types) () + Model%ncnd, & ! IN - Number of cloud condensate types () + Grid%xlat, & ! IN - Latitude (radians) + Grid%xlon, & ! IN - Longitude (radians) + Sfcprop%slmsk, & ! IN - Land/Sea mask () + deltaZ, & ! IN - Layer thickness (km) + deltaP/100., & ! IN - Layer thickness (hPa) + NCOL, & ! IN - Number of horizontal gridpoints + MODEL%LEVS, & ! IN - Number of model layers + MODEL%LEVS+1, & ! IN - Number of model levels + cldcov, & ! IN - Layer cloud fraction (used if uni_cld=.true.) + effr_l, & ! IN - Liquid-water effective radius (microns) + effr_i, & ! IN - Ice-water effective radius (microns) + effr_r, & ! IN - Rain-water effective radius (microns) + effr_s, & ! IN - Snow-water effective radius (microns) + Model%effr_in, & ! IN - Logical, if .true. use input effective radii + clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) + cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) + mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) + mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) + de_lgth) ! OUT - clouds decorrelation length (km) + endif + ! *) Thompson / WSM6 cloud micrphysics scheme + elseif(Model%imp_physics == 8 .or. Model%imp_physics == 6) then + + call progcld5 ( & ! IN + p_lay/100., & ! IN - Pressure at model layer centers (mb) + p_lev/100., & ! IN - Pressure at model interfaces (mb) + t_lay, & ! IN - Temperature at layer centers (K) + q_lay, & ! IN - Specific humidity at layer center (kg/kg) + qs_lay, & ! IN - Saturation specific humidity at layer center (kg/kg) + relhum, & ! IN - Relative humidity at layer center (1) + tracer, & ! IN - Cloud condensate amount in layer by type () + Grid%xlat, & ! IN - Latitude (radians) + Grid%xlon, & ! IN - Longitude (radians) + Sfcprop%slmsk, & ! IN - Land/Sea mask () + deltaZ, & ! IN - Layer thickness (km) + deltaP/100., & ! IN - Layer thickness (hPa) + Model%ntrac-1, & ! IN - Number of tracers + Model%ntcw-1, & ! IN - Tracer index for cloud condensate (or liquid water) + Model%ntiw-1, & ! IN - Tracer index for ice + Model%ntrw-1, & ! IN - Tracer index for rain + Model%ntsw-1, & ! IN - Tracer index for snow + Model%ntgl-1, & ! IN - Tracer index for groupel + NCOL, & ! IN - Number of horizontal gridpoints + MODEL%LEVS, & ! IN - Number of model layers + MODEL%LEVS+1, & ! IN - Number of model levels + Model%uni_cld, & ! IN - True for cloud fraction from shoc + Model%lmfshal, & ! IN - True for mass flux shallow convection + Model%lmfdeep2, & ! IN - True for mass flux deep convection + cldcov(:,1:Model%levs), & ! IN - Layer cloud fraction (used if uni_cld=.true.) + Tbd%phy_f3d(:,:,1), & ! IN - Liquid-water effective radius (microns) + Tbd%phy_f3d(:,:,2), & ! IN - Ice-water effective radius (microns) + Tbd%phy_f3d(:,:,3), & ! IN - LSnow-water effective radius (microns) + clouds, & ! OUT - Cloud properties (NCOL,Model%levs,NF_CLDS) + cldsa, & ! OUT - fraction of clouds for low, mid, hi, tot, bl (NCOL,5) + mtopa, & ! OUT - vertical indices for low, mid, hi cloud tops (NCOL,3) + mbota, & ! OUT - vertical indices for low, mid, hi cloud bases (NCOL,3) + de_lgth) ! OUT - clouds decorrelation length (km) + endif ! end if_imp_physics + end subroutine cloud_microphysics + ! +end module GFS_rrtmgp_pre diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta new file mode 100644 index 000000000..c80098709 --- /dev/null +++ b/physics/GFS_rrtmgp_pre.meta @@ -0,0 +1,375 @@ +[ccpp-arg-table] + name = GFS_rrtmgp_pre_init + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = instance of derived type GFS_control_type + units = DDT + dimensions = () + type = GFS_control_type + intent = inout + optional = F +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = instance of derived type GFS_radtend_type + units = DDT + dimensions = () + type = GFS_radtend_type + intent = inout + optional = F +[active_gases_array] + standard_name = list_of_active_gases_used_by_RRTMGP + long_name = list of active gases used by RRTMGP + units = none + dimensions = (number_of_active_gases_used_by_RRTMGP) + type = character + kind = len=* + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_rrtmgp_pre_run + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = instance of derived type GFS_control_type + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[Grid] + standard_name = GFS_grid_type_instance + long_name = instance of derived type GFS_grid_type + units = DDT + dimensions = () + type = GFS_grid_type + intent = in + optional = F +[Sfcprop] + standard_name = GFS_sfcprop_type_instance + long_name = instance of derived type GFS_sfcprop_type + units = DDT + dimensions = () + type = GFS_sfcprop_type + intent = in + optional = F +[Statein] + standard_name = GFS_statein_type_instance + long_name = instance of derived type GFS_statein_type + units = DDT + dimensions = () + type = GFS_statein_type + intent = in + optional = F +[Tbd] + standard_name = GFS_tbd_type_instance + long_name = instance of derived type GFS_tbd_type + units = DDT + dimensions = () + type = GFS_tbd_type + intent = in + optional = F +[Coupling] + standard_name = GFS_coupling_type_instance + long_name = instance of derived type GFS_coupling_type + units = DDT + dimensions = () + type = GFS_coupling_type + intent = in + optional = F +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = instance of derived type GFS_radtend_type + units = DDT + dimensions = () + type = GFS_radtend_type + intent = inout + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[lw_gas_props] + standard_name = coefficients_for_lw_gas_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[active_gases_array] + standard_name = list_of_active_gases_used_by_RRTMGP + long_name = list of active gases used by RRTMGP + units = none + dimensions = (number_of_active_gases_used_by_RRTMGP) + type = character + kind = len=* + intent = in + optional = F +[raddt] + standard_name = time_step_for_radiation + long_name = radiation time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[sec_diff_byband] + standard_name = secant_of_diffusivity_angle_each_RRTMGP_LW_band + long_name = secant of diffusivity angle in each RRTMGP LW band + units = none + dimensions = (number_of_lw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure at vertical layer for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure at vertical interface for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = out + optional = F +[t_lay] + standard_name = air_temperature_at_layer_for_RRTMGP + long_name = air temperature at vertical layer for radiation calculation + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[t_lev] + standard_name = air_temperature_at_interface_for_RRTMGP + long_name = air temperature at vertical interface for radiation calculation + units = K + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = out + optional = F +[tsfg] + standard_name = surface_ground_temperature_for_radiation + long_name = surface ground temperature for radiation + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[tsfa] + standard_name = surface_air_temperature_for_radiation + long_name = lowest model layer air temperature for radiation + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[tv_lay] + standard_name = virtual_temperature + long_name = layer virtual temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[relhum] + standard_name = relative_humidity + long_name = layer relative humidity + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[tracer] + standard_name = chemical_tracers + long_name = chemical tracers + units = g g-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = out + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_lwp] + standard_name = cloud_liquid_water_path + long_name = layer cloud liquid water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_reliq] + standard_name = mean_effective_radius_for_liquid_cloud + long_name = mean effective radius for liquid cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_iwp] + standard_name = cloud_ice_water_path + long_name = layer cloud ice water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_reice] + standard_name = mean_effective_radius_for_ice_cloud + long_name = mean effective radius for ice cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_swp] + standard_name = cloud_snow_water_path + long_name = layer cloud snow water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_resnow] + standard_name = mean_effective_radius_for_snow_flake + long_name = mean effective radius for snow cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_rwp] + standard_name = cloud_rain_water_path + long_name = layer cloud rain water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cld_rerain] + standard_name = mean_effective_radius_for_rain_drop + long_name = mean effective radius for rain cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[mtopa] + standard_name = model_layer_number_at_cloud_top + long_name = vertical indices for low, middle and high cloud tops + units = index + dimensions = (horizontal_dimension,3) + type = integer + intent = out + optional = F +[mbota] + standard_name = model_layer_number_at_cloud_base + long_name = vertical indices for low, middle and high cloud bases + units = index + dimensions = (horizontal_dimension,3) + type = integer + intent = out + optional = F +[de_lgth] + standard_name = cloud_decorrelation_length + long_name = cloud decorrelation length + units = km + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[cldsa] + standard_name = cloud_area_fraction_for_radiation + long_name = fraction of clouds for low, middle, high, total and BL + units = frac + dimensions = (horizontal_dimension,5) + type = real + kind = kind_phys + intent = out + optional = F +[gas_concentrations] + standard_name = Gas_concentrations_for_RRTMGP_suite + long_name = DDT containing gas concentrations for RRTMGP radiation scheme + units = DDT + dimensions = () + type = ty_gas_concs + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_rrtmgp_pre_finalize + type = scheme diff --git a/physics/GFS_rrtmgp_setup.F90 b/physics/GFS_rrtmgp_setup.F90 new file mode 100644 index 000000000..45bc4397b --- /dev/null +++ b/physics/GFS_rrtmgp_setup.F90 @@ -0,0 +1,610 @@ +!> \file GFS_rrtmgp_setup.f90 +!! This file contains +module GFS_rrtmgp_setup + + use physparam, only : & + isolar, ictmflg, ico2flg, ioznflg, iaerflg, iaermdl, icldflg, & + iovrsw, iovrlw, lcrick, lcnorm, lnoprec, ialbflg, iemsflg, & + isubcsw, isubclw, ivflip , ipsd0, iswcliq + use machine, only: & + kind_phys ! Working type + use GFS_typedefs, only: & + GFS_control_type ! Model control parameters + implicit none + + public GFS_rrtmgp_setup_init, GFS_rrtmgp_setup_run, GFS_rrtmgp_setup_finalize + + private + + logical :: is_initialized = .false. + + ! Version tag and last revision date + character(40), parameter :: & + VTAGRAD='NCEP-RRTMGP_driver v1.0 Sep 2019 ' + + ! Defaults + !> new data input control variables (set/reset in subroutines radinit/radupdate): + integer :: month0 = 0 + integer :: iyear0 = 0 + integer :: monthd = 0 + + !> control flag for the first time of reading climatological ozone data + !! (set/reset in subroutines radinit/radupdate, it is used only if the + !! control parameter ioznflg=0) + logical :: loz1st = .true. + + contains +!> \defgroup GFS_rrtmgp_setup GFS RRTMGP Scheme Setup +!! @{ +!! \section arg_table_GFS_rrtmgp_setup_init +!! \htmlinclude GFS_rrtmgp_setup_init.html +!! + subroutine GFS_rrtmgp_setup_init (Model, si, levr, ictm, isol, ico2, & + iaer, ialb, iems, ntcw, num_p3d, ntoz, iovr_sw, iovr_lw, & + isubc_sw, isubc_lw, icliq_sw, crick_proof, ccnorm, imp_physics, & + norad_precip, idate, iflip, me, & + errmsg, errflg) + implicit none + + ! Inputs + type(GFS_control_type), intent(in) :: & + Model ! DDT containing model control parameters + real(kind_phys), dimension(levr+1), intent(in) :: & + si + integer, intent(in) :: levr, ictm, isol, ico2, iaer, ialb, iems, & + ntcw, num_p3d, ntoz, iovr_sw, iovr_lw, isubc_sw, isubc_lw, & + icliq_sw, imp_physics, iflip, me + logical, intent(in) :: & + crick_proof, ccnorm, norad_precip + integer, intent(in), dimension(4) :: & + idate + ! Outputs + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize the CCPP error handling variables + errmsg = '' + errflg = 0 + if (is_initialized) return + + ! Set radiation parameters + isolar = isol ! solar constant control flag + ictmflg = ictm ! data ic time/date control flag + ico2flg = ico2 ! co2 data source control flag + ioznflg = ntoz ! ozone data source control flag + iswcliq = icliq_sw ! optical property for liquid clouds for sw + iovrsw = iovr_sw ! cloud overlapping control flag for sw + iovrlw = iovr_lw ! cloud overlapping control flag for lw + lcrick = crick_proof ! control flag for eliminating CRICK + lcnorm = ccnorm ! control flag for in-cld condensate + lnoprec = norad_precip ! precip effect on radiation flag (ferrier microphysics) + isubcsw = isubc_sw ! sub-column cloud approx flag in sw radiation + isubclw = isubc_lw ! sub-column cloud approx flag in lw radiation + ialbflg = ialb ! surface albedo control flag + iemsflg = iems ! surface emissivity control flag + ivflip = iflip ! vertical index direction control flag + + if ( ictm==0 .or. ictm==-2 ) then + iaerflg = mod(iaer, 100) ! no volcanic aerosols for clim hindcast + else + iaerflg = mod(iaer, 1000) + endif + iaermdl = iaer/1000 ! control flag for aerosol scheme selection + if ( iaermdl < 0 .or. (iaermdl>2 .and. iaermdl/=5) ) then + errmsg = trim(errmsg) // ' Error -- IAER flag is incorrect, Abort' + errflg = 1 + return + endif + + !if ( ntcw > 0 ) then + icldflg = 1 ! prognostic cloud optical prop scheme + !else + ! icldflg = 0 ! no support for diag cloud opt prop scheme + !endif + + ! Set initial permutation seed for mcica cloud-radiation + if ( isubc_sw>0 .or. isubc_lw>0 ) then + ipsd0 = 17*idate(1)+43*idate(2)+37*idate(3)+23*idate(4) + endif + + if ( me == 0 ) then + print *,' In rad_initialize (GFS_rrtmgp_setup_init), before calling radinit' + print *,' si =',si + print *,' levr=',levr,' ictm=',ictm,' isol=',isol,' ico2=',ico2,& + ' iaer=',iaer,' ialb=',ialb,' iems=',iems,' ntcw=',ntcw + print *,' np3d=',num_p3d,' ntoz=',ntoz,' iovr_sw=',iovr_sw, & + ' iovr_lw=',iovr_lw,' isubc_sw=',isubc_sw, & + ' isubc_lw=',isubc_lw,' icliq_sw=',icliq_sw, & + ' iflip=',iflip,' me=',me + print *,' crick_proof=',crick_proof, & + ' ccnorm=',ccnorm,' norad_precip=',norad_precip + endif + + ! Hack for using RRTMGP-Sw and RRTMG-LW + if (.not. Model%do_GPsw_Glw) then + call radinit( si, levr, imp_physics, me ) + endif + + if ( me == 0 ) then + print *,' Radiation sub-cloud initial seed =',ipsd0, & + ' IC-idate =',idate + print *,' return from rad_initialize (GFS_rrtmgp_setup_init) - after calling radinit' + endif + + is_initialized = .true. + return + end subroutine GFS_rrtmgp_setup_init + +!> \section arg_table_GFS_rrtmgp_setup_run +!! \htmlinclude GFS_rrtmgp_setup_run.html +!! + subroutine GFS_rrtmgp_setup_run (idate, jdate, deltsw, deltim, lsswr, me, & + slag, sdec, cdec, solcon, errmsg, errflg) + + implicit none + + ! interface variables + integer, intent(in) :: idate(:) + integer, intent(in) :: jdate(:) + real(kind=kind_phys), intent(in) :: deltsw + real(kind=kind_phys), intent(in) :: deltim + logical, intent(in) :: lsswr + integer, intent(in) :: me + real(kind=kind_phys), intent(out) :: slag + real(kind=kind_phys), intent(out) :: sdec + real(kind=kind_phys), intent(out) :: cdec + real(kind=kind_phys), intent(out) :: solcon + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Check initialization state + if (.not.is_initialized) then + write(errmsg, fmt='((a))') 'GFS_rrtmgp_setup_run called before GFS_rrtmgp_setup_init' + errflg = 1 + return + end if + + ! Initialize the CCPP error handling variables + errmsg = '' + errflg = 0 + + call radupdate(idate,jdate,deltsw,deltim,lsswr,me, & + slag,sdec,cdec,solcon) + + end subroutine GFS_rrtmgp_setup_run + +!> \section arg_table_GFS_rrtmgp_setup_finalize +!! \htmlinclude GFS_rrtmgp_setup_finalize.html +!! + subroutine GFS_rrtmgp_setup_finalize (errmsg, errflg) + + implicit none + + character(len=*), intent( out) :: errmsg + integer, intent( out) :: errflg + + ! Initialize the CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not.is_initialized) return + + ! do finalization stuff if needed + + is_initialized = .false. + + end subroutine GFS_rrtmgp_setup_finalize + + + ! Private functions + + + subroutine radinit( si, NLAY, imp_physics, me ) + !................................... + +! --- inputs: +! & ( si, NLAY, imp_physics, me ) +! --- outputs: +! ( none ) + +! ================= subprogram documentation block ================ ! +! ! +! subprogram: radinit initialization of radiation calculations ! +! ! +! usage: call radinit ! +! ! +! attributes: ! +! language: fortran 90 ! +! machine: wcoss ! +! ! +! ==================== definition of variables ==================== ! +! ! +! input parameters: ! +! si : model vertical sigma interface ! +! NLAY : number of model vertical layers ! +! imp_physics : MP identifier ! +! me : print control flag ! +! ! +! outputs: (none) ! +! ! +! external module variables: (in module physparam) ! +! isolar : solar constant cntrol flag ! +! = 0: use the old fixed solar constant in "physcon" ! +! =10: use the new fixed solar constant in "physcon" ! +! = 1: use noaa ann-mean tsi tbl abs-scale with cycle apprx! +! = 2: use noaa ann-mean tsi tbl tim-scale with cycle apprx! +! = 3: use cmip5 ann-mean tsi tbl tim-scale with cycl apprx! +! = 4: use cmip5 mon-mean tsi tbl tim-scale with cycl apprx! +! iaerflg : 3-digit aerosol flag (abc for volc, lw, sw) ! +! a:=0 use background stratospheric aerosol ! +! =1 include stratospheric vocanic aeros ! +! b:=0 no topospheric aerosol in lw radiation ! +! =1 compute tropspheric aero in 1 broad band for lw ! +! =2 compute tropspheric aero in multi bands for lw ! +! c:=0 no topospheric aerosol in sw radiation ! +! =1 include tropspheric aerosols for sw ! +! ico2flg : co2 data source control flag ! +! =0: use prescribed global mean co2 (old oper) ! +! =1: use observed co2 annual mean value only ! +! =2: use obs co2 monthly data with 2-d variation ! +! ictmflg : =yyyy#, external data ic time/date control flag ! +! = -2: same as 0, but superimpose seasonal cycle ! +! from climatology data set. ! +! = -1: use user provided external data for the ! +! forecast time, no extrapolation. ! +! = 0: use data at initial cond time, if not ! +! available, use latest, no extrapolation. ! +! = 1: use data at the forecast time, if not ! +! available, use latest and extrapolation. ! +! =yyyy0: use yyyy data for the forecast time, ! +! no further data extrapolation. ! +! =yyyy1: use yyyy data for the fcst. if needed, do ! +! extrapolation to match the fcst time. ! +! ioznflg : ozone data source control flag ! +! =0: use climatological ozone profile ! +! =1: use interactive ozone profile ! +! ialbflg : albedo scheme control flag ! +! =0: climatology, based on surface veg types ! +! =1: modis retrieval based surface albedo scheme ! +! iemsflg : emissivity scheme cntrl flag (ab 2-digit integer) ! +! a:=0 set sfc air/ground t same for lw radiation ! +! =1 set sfc air/ground t diff for lw radiation ! +! b:=0 use fixed sfc emissivity=1.0 (black-body) ! +! =1 use varying climtology sfc emiss (veg based) ! +! =2 future development (not yet) ! +! icldflg : cloud optical property scheme control flag ! +! =0: use diagnostic cloud scheme ! +! =1: use prognostic cloud scheme (default) ! +! imp_physics : cloud microphysics scheme control flag ! +! =99 zhao/carr/sundqvist microphysics scheme ! +! =98 zhao/carr/sundqvist microphysics+pdf cloud&cnvc,cnvw ! +! =11 GFDL cloud microphysics ! +! =8 Thompson microphysics scheme ! +! =6 WSM6 microphysics scheme ! +! =10 MG microphysics scheme ! +! iovrsw : control flag for cloud overlap in sw radiation ! +! iovrlw : control flag for cloud overlap in lw radiation ! +! =0: random overlapping clouds ! +! =1: max/ran overlapping clouds ! +! isubcsw : sub-column cloud approx control flag in sw radiation ! +! isubclw : sub-column cloud approx control flag in lw radiation ! +! =0: with out sub-column cloud approximation ! +! =1: mcica sub-col approx. prescribed random seed ! +! =2: mcica sub-col approx. provided random seed ! +! lcrick : control flag for eliminating CRICK ! +! =t: apply layer smoothing to eliminate CRICK ! +! =f: do not apply layer smoothing ! +! lcnorm : control flag for in-cld condensate ! +! =t: normalize cloud condensate ! +! =f: not normalize cloud condensate ! +! lnoprec : precip effect in radiation flag (ferrier microphysics) ! +! =t: snow/rain has no impact on radiation ! +! =f: snow/rain has impact on radiation ! +! ivflip : vertical index direction control flag ! +! =0: index from toa to surface ! +! =1: index from surface to toa ! +! ! +! subroutines called: sol_init, aer_init, gas_init, cld_init, ! +! sfc_init, rlwinit, rswinit ! +! ! +! usage: call radinit ! +! ! +! =================================================================== ! +! + + use module_radiation_astronomy, only : sol_init + use module_radiation_aerosols, only : aer_init + use module_radiation_gases, only : gas_init + use module_radiation_surface, only : sfc_init + use module_radiation_clouds, only : cld_init + + implicit none + +! --- inputs: + integer, intent(in) :: NLAY, me, imp_physics + + real (kind=kind_phys), intent(in) :: si(:) + +! --- outputs: (none, to module variables) + +! --- locals: + +! +!===> ... begin here +! +!> -# Set up control variables and external module variables in +!! module physparam +#if 0 + ! GFS_radiation_driver.F90 may in the future initialize air/ground + ! temperature differently; however, this is not used at the moment + ! and as such we avoid the difficulty of dealing with exchanging + ! itsfc between GFS_rrtmgp_setup and a yet-to-be-created/-used + ! interstitial routine (or GFS_radiation_driver.F90) + itsfc = iemsflg / 10 ! sfc air/ground temp control +#endif + loz1st = (ioznflg == 0) ! first-time clim ozone data read flag + month0 = 0 + iyear0 = 0 + monthd = 0 + + if (me == 0) then +! print *,' NEW RADIATION PROGRAM STRUCTURES -- SEP 01 2004' + print *,' NEW RADIATION PROGRAM STRUCTURES BECAME OPER. ', & + & ' May 01 2007' + print *, VTAGRAD !print out version tag + print *,' - Selected Control Flag settings: ICTMflg=',ictmflg, & + & ' ISOLar =',isolar, ' ICO2flg=',ico2flg,' IAERflg=',iaerflg, & + & ' IALBflg=',ialbflg,' IEMSflg=',iemsflg,' ICLDflg=',icldflg, & + & ' IMP_PHYSICS=',imp_physics,' IOZNflg=',ioznflg + print *,' IVFLIP=',ivflip,' IOVRSW=',iovrsw,' IOVRLW=',iovrlw, & + & ' ISUBCSW=',isubcsw,' ISUBCLW=',isubclw +! write(0,*)' IVFLIP=',ivflip,' IOVRSW=',iovrsw,' IOVRLW=',iovrlw,& +! & ' ISUBCSW=',isubcsw,' ISUBCLW=',isubclw + print *,' LCRICK=',lcrick,' LCNORM=',lcnorm,' LNOPREC=',lnoprec + + if ( ictmflg==0 .or. ictmflg==-2 ) then + print *,' Data usage is limited by initial condition!' + print *,' No volcanic aerosols' + endif + + if ( isubclw == 0 ) then + print *,' - ISUBCLW=',isubclw,' No McICA, use grid ', & + & 'averaged cloud in LW radiation' + elseif ( isubclw == 1 ) then + print *,' - ISUBCLW=',isubclw,' Use McICA with fixed ', & + & 'permutation seeds for LW random number generator' + elseif ( isubclw == 2 ) then + print *,' - ISUBCLW=',isubclw,' Use McICA with random ', & + & 'permutation seeds for LW random number generator' + else + print *,' - ERROR!!! ISUBCLW=',isubclw,' is not a ', & + & 'valid option ' + stop + endif + + if ( isubcsw == 0 ) then + print *,' - ISUBCSW=',isubcsw,' No McICA, use grid ', & + & 'averaged cloud in SW radiation' + elseif ( isubcsw == 1 ) then + print *,' - ISUBCSW=',isubcsw,' Use McICA with fixed ', & + & 'permutation seeds for SW random number generator' + elseif ( isubcsw == 2 ) then + print *,' - ISUBCSW=',isubcsw,' Use McICA with random ', & + & 'permutation seeds for SW random number generator' + else + print *,' - ERROR!!! ISUBCSW=',isubcsw,' is not a ', & + & 'valid option ' + stop + endif + + if ( isubcsw /= isubclw ) then + print *,' - *** Notice *** ISUBCSW /= ISUBCLW !!!', & + & isubcsw, isubclw + endif + endif + + ! Initialization + + call sol_init ( me ) ! --- ... astronomy initialization routine + call aer_init ( NLAY, me ) ! --- ... aerosols initialization routine + call gas_init ( me ) ! --- ... co2 and other gases initialization routine + call sfc_init ( me ) ! --- ... surface initialization routine + call cld_init ( si, NLAY, imp_physics, me) ! --- ... cloud initialization routine + + return + !................................... + end subroutine radinit + !----------------------------------- + +!> This subroutine checks and updates time sensitive data used by +!! radiation computations. This subroutine needs to be placed inside +!! the time advancement loop but outside of the horizontal grid loop. +!! It is invoked at radiation calling frequncy but before any actual +!! radiative transfer computations. +!! \param idate NCEP absolute date and time of intial condition +!! (year,month,day,time-zone,hour,minute,second, +!! mil-second) +!! \param jdate NCEP absolute date and time at forecast time +!! (year,month,day,time-zone,hour,minute,second, +!! mil-second) +!! \param deltsw SW radiation calling time interval in seconds +!! \param deltim model advancing time-step duration in seconds +!! \param lsswr logical control flag for SW radiation calculations +!! \param me print control flag +!! \param slag equation of time in radians +!! \param sdec,cdec sine and cosine of the solar declination angle +!! \param solcon solar constant adjusted by sun-earth distance \f$(W/m^2)\f$ +!> \section gen_radupdate General Algorithm +!> @{ +!----------------------------------- + subroutine radupdate( idate,jdate,deltsw,deltim,lsswr, me, & + & slag,sdec,cdec,solcon) +!................................... + +! ================= subprogram documentation block ================ ! +! ! +! subprogram: radupdate calls many update subroutines to check and ! +! update radiation required but time varying data sets and module ! +! variables. ! +! ! +! usage: call radupdate ! +! ! +! attributes: ! +! language: fortran 90 ! +! machine: ibm sp ! +! ! +! ==================== definition of variables ==================== ! +! ! +! input parameters: ! +! idate(8) : ncep absolute date and time of initial condition ! +! (yr, mon, day, t-zone, hr, min, sec, mil-sec) ! +! jdate(8) : ncep absolute date and time at fcst time ! +! (yr, mon, day, t-zone, hr, min, sec, mil-sec) ! +! deltsw : sw radiation calling frequency in seconds ! +! deltim : model timestep in seconds ! +! lsswr : logical flags for sw radiation calculations ! +! me : print control flag ! +! ! +! outputs: ! +! slag : equation of time in radians ! +! sdec, cdec : sin and cos of the solar declination angle ! +! solcon : sun-earth distance adjusted solar constant (w/m2) ! +! ! +! external module variables: ! +! isolar : solar constant cntrl (in module physparam) ! +! = 0: use the old fixed solar constant in "physcon" ! +! =10: use the new fixed solar constant in "physcon" ! +! = 1: use noaa ann-mean tsi tbl abs-scale with cycle apprx! +! = 2: use noaa ann-mean tsi tbl tim-scale with cycle apprx! +! = 3: use cmip5 ann-mean tsi tbl tim-scale with cycl apprx! +! = 4: use cmip5 mon-mean tsi tbl tim-scale with cycl apprx! +! ictmflg : =yyyy#, external data ic time/date control flag ! +! = -2: same as 0, but superimpose seasonal cycle ! +! from climatology data set. ! +! = -1: use user provided external data for the ! +! forecast time, no extrapolation. ! +! = 0: use data at initial cond time, if not ! +! available, use latest, no extrapolation. ! +! = 1: use data at the forecast time, if not ! +! available, use latest and extrapolation. ! +! =yyyy0: use yyyy data for the forecast time, ! +! no further data extrapolation. ! +! =yyyy1: use yyyy data for the fcst. if needed, do ! +! extrapolation to match the fcst time. ! +! ! +! module variables: ! +! loz1st : first-time clim ozone data read flag ! +! ! +! subroutines called: sol_update, aer_update, gas_update ! +! ! +! =================================================================== ! +! + use module_radiation_astronomy, only : sol_update + use module_radiation_aerosols, only : aer_update + use module_radiation_gases, only : gas_update + + implicit none + +! --- inputs: + integer, intent(in) :: idate(:), jdate(:), me + logical, intent(in) :: lsswr + + real (kind=kind_phys), intent(in) :: deltsw, deltim + +! --- outputs: + real (kind=kind_phys), intent(out) :: slag, sdec, cdec, solcon + +! --- locals: + integer :: iyear, imon, iday, ihour + integer :: kyear, kmon, kday, khour + + logical :: lmon_chg ! month change flag + logical :: lco2_chg ! cntrl flag for updating co2 data + logical :: lsol_chg ! cntrl flag for updating solar constant +! +!===> ... begin here +! +!> -# Set up time stamp at fcst time and that for green house gases +!! (currently co2 only) +! --- ... time stamp at fcst time + + iyear = jdate(1) + imon = jdate(2) + iday = jdate(3) + ihour = jdate(5) + +! --- ... set up time stamp used for green house gases (** currently co2 only) + + if ( ictmflg==0 .or. ictmflg==-2 ) then ! get external data at initial condition time + kyear = idate(1) + kmon = idate(2) + kday = idate(3) + khour = idate(5) + else ! get external data at fcst or specified time + kyear = iyear + kmon = imon + kday = iday + khour = ihour + endif ! end if_ictmflg_block + + if ( month0 /= imon ) then + lmon_chg = .true. + month0 = imon + else + lmon_chg = .false. + endif + +!> -# Call module_radiation_astronomy::sol_update(), yearly update, no +!! time interpolation. + if (lsswr) then + + if ( isolar == 0 .or. isolar == 10 ) then + lsol_chg = .false. + elseif ( iyear0 /= iyear ) then + lsol_chg = .true. + else + lsol_chg = ( isolar==4 .and. lmon_chg ) + endif + iyear0 = iyear + + call sol_update & +! --- inputs: + & ( jdate,kyear,deltsw,deltim,lsol_chg, me, & +! --- outputs: + & slag,sdec,cdec,solcon & + & ) + + endif ! end_if_lsswr_block + +!> -# Call module_radiation_aerosols::aer_update(), monthly update, no +!! time interpolation + if ( lmon_chg ) then + call aer_update ( iyear, imon, me ) + endif + +!> -# Call co2 and other gases update routine: +!! module_radiation_gases::gas_update() + if ( monthd /= kmon ) then + monthd = kmon + lco2_chg = .true. + else + lco2_chg = .false. + endif + + call gas_update ( kyear,kmon,kday,khour,loz1st,lco2_chg, me ) + + if ( loz1st ) loz1st = .false. + +!> -# Call surface update routine (currently not needed) +! call sfc_update ( iyear, imon, me ) + +!> -# Call clouds update routine (currently not needed) +! call cld_update ( iyear, imon, me ) +! + return +!................................... + end subroutine radupdate +!----------------------------------- + +!! @} +end module GFS_rrtmgp_setup diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/GFS_rrtmgp_setup.meta new file mode 100644 index 000000000..e40ad865a --- /dev/null +++ b/physics/GFS_rrtmgp_setup.meta @@ -0,0 +1,343 @@ +[ccpp-arg-table] + name = GFS_rrtmgp_setup_init + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = instance of derived type GFS_control_type + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[si] + standard_name = vertical_sigma_coordinate_for_radiation_initialization + long_name = vertical sigma coordinate for radiation initialization + units = none + dimensions = (number_of_vertical_layers_for_radiation_calculations_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[levr] + standard_name = number_of_vertical_layers_for_radiation_calculations + long_name = number of vertical levels for radiation calculations + units = count + dimensions = () + type = integer + intent = in + optional = F +[ictm] + standard_name = flag_for_initial_time_date_control + long_name = flag for initial conditions and forcing + units = flag + dimensions = () + type = integer + intent = in + optional = F +[isol] + standard_name = flag_for_solar_constant + long_name = use prescribed solar constant + units = flag + dimensions = () + type = integer + intent = in + optional = F +[ico2] + standard_name = flag_for_using_prescribed_global_mean_co2_value + long_name = prescribed global mean value (old opernl) + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iaer] + standard_name = flag_for_default_aerosol_effect_in_shortwave_radiation + long_name = default aerosol effect in sw only + units = flag + dimensions = () + type = integer + intent = in + optional = F +[ialb] + standard_name = flag_for_using_climatology_albedo + long_name = flag for using climatology alb, based on sfc type + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iems] + standard_name = flag_for_surface_emissivity_control + long_name = surface emissivity control flag, use fixed value of 1 + units = flag + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[num_p3d] + standard_name = array_dimension_of_3d_arrays_for_microphysics + long_name = number of 3D arrays needed for microphysics + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntoz] + standard_name = index_for_ozone + long_name = tracer index for ozone mixing ratio + units = index + dimensions = () + type = integer + intent = in + optional = F +[iovr_sw] + standard_name = flag_for_max_random_overlap_clouds_for_shortwave_radiation + long_name = sw: max-random overlap clouds + units = flag + dimensions = () + type = integer + intent = in + optional = F +[iovr_lw] + standard_name = flag_for_max_random_overlap_clouds_for_longwave_radiation + long_name = lw: max-random overlap clouds + units = flag + dimensions = () + type = integer + intent = in + optional = F +[isubc_sw] + standard_name = flag_for_sw_clouds_without_sub_grid_approximation + long_name = flag for sw clouds without sub-grid approximation + units = flag + dimensions = () + type = integer + intent = in + optional = F +[isubc_lw] + standard_name = flag_for_lw_clouds_without_sub_grid_approximation + long_name = flag for lw clouds without sub-grid approximation + units = flag + dimensions = () + type = integer + intent = in + optional = F +[icliq_sw] + standard_name = flag_for_optical_property_for_liquid_clouds_for_shortwave_radiation + long_name = sw optical property for liquid clouds + units = flag + dimensions = () + type = integer + intent = in + optional = F +[crick_proof] + standard_name = flag_for_CRICK_proof_cloud_water + long_name = flag for CRICK-Proof cloud water + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ccnorm] + standard_name = flag_for_cloud_condensate_normalized_by_cloud_cover + long_name = flag for cloud condensate normalized by cloud cover + units = flag + dimensions = () + type = logical + intent = in + optional = F +[imp_physics] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[norad_precip] + standard_name = flag_for_precipitation_effect_on_radiation + long_name = radiation precip flag for Ferrier/Moorthi + units = flag + dimensions = () + type = logical + intent = in + optional = F +[idate] + standard_name = date_and_time_at_model_initialization_reordered + long_name = initialization date and time + units = none + dimensions = (4) + type = integer + intent = in + optional = F +[iflip] + standard_name = flag_for_vertical_index_direction_control + long_name = flag for vertical index direction control + units = flag + dimensions = () + type = integer + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_rrtmgp_setup_run + type = scheme +[idate] + standard_name = date_and_time_at_model_initialization + long_name = initialization date and time + units = none + dimensions = (8) + type = integer + intent = in + optional = F +[jdate] + standard_name = forecast_date_and_time + long_name = current forecast date and time + units = none + dimensions = (8) + type = integer + intent = in + optional = F +[deltsw] + standard_name = frequency_for_shortwave_radiation + long_name = frequency for shortwave radiation + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[deltim] + standard_name = time_step_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[lsswr] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[slag] + standard_name = equation_of_time + long_name = equation of time (radian) + units = radians + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[sdec] + standard_name = sine_of_solar_declination_angle + long_name = sin of the solar declination angle + units = none + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[cdec] + standard_name = cosine_of_solar_declination_angle + long_name = cos of the solar declination angle + units = none + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[solcon] + standard_name = solar_constant + long_name = solar constant (sun-earth distant adjusted) + units = W m-2 + dimensions = () + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_rrtmgp_setup_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 new file mode 100644 index 000000000..4e9f8a33f --- /dev/null +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -0,0 +1,307 @@ +module GFS_rrtmgp_sw_post + use machine, only: kind_phys + use GFS_typedefs, only: GFS_coupling_type, GFS_control_type, GFS_grid_type, & + GFS_radtend_type, GFS_diag_type, GFS_statein_type + use module_radiation_aerosols, only: NSPC1 + use module_radsw_parameters, only: topfsw_type, sfcfsw_type, profsw_type, cmpfsw_type + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_fluxes_byband, only: ty_fluxes_byband + use mo_heating_rates, only: compute_heating_rate + use rrtmgp_aux, only: check_error_msg + implicit none + + public GFS_rrtmgp_sw_post_init,GFS_rrtmgp_sw_post_run,GFS_rrtmgp_sw_post_finalize + +contains + + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_sw_post_init + ! ######################################################################################### + subroutine GFS_rrtmgp_sw_post_init() + end subroutine GFS_rrtmgp_sw_post_init + + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_sw_post_run + ! ######################################################################################### +!> \section arg_table_GFS_rrtmgp_sw_post_run +!! \htmlinclude GFS_rrtmgp_sw_post_run.html +!! + subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein, scmpsw, & + nCol, p_lev, sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, & + sw_gas_props, nday, idxday, fluxswUP_allsky, fluxswDOWN_allsky, fluxswUP_clrsky, & + fluxswDOWN_clrsky, raddt, aerodp, cldsa, mbota, mtopa, cld_frac, cldtausw, flxprf_sw,& + errmsg, errflg) + + ! Inputs + type(GFS_control_type), intent(in) :: & + Model ! Fortran DDT: FV3-GFS model control parameters + type(GFS_grid_type), intent(in) :: & + Grid ! Fortran DDT: FV3-GFS grid and interpolation related data + type(GFS_coupling_type), intent(inout) :: & + Coupling ! Fortran DDT: FV3-GFS fields to/from coupling with other components + type(GFS_radtend_type), intent(inout) :: & + Radtend ! Fortran DDT: FV3-GFS radiation tendencies + type(GFS_diag_type), intent(inout) :: & + Diag ! Fortran DDT: FV3-GFS diagnotics data + type(GFS_statein_type), intent(in) :: & + Statein ! Fortran DDT: FV3-GFS prognostic state data in from dycore + integer, intent(in) :: & + nCol, & ! Horizontal loop extent + nDay ! Number of daylit columns + integer, intent(in), dimension(nday) :: & + idxday ! Index array for daytime points + type(ty_gas_optics_rrtmgp),intent(in) :: & + sw_gas_props ! DDT containing SW spectral information + real(kind_phys), dimension(nCol, Model%levs+1), intent(in) :: & + p_lev ! Pressure @ model layer-interfaces (hPa) + real(kind_phys), dimension(sw_gas_props%get_nband(),ncol), intent(in) :: & + sfc_alb_nir_dir, & ! Surface albedo (direct) + sfc_alb_nir_dif, & ! Surface albedo (diffuse) + sfc_alb_uvvis_dir, & ! Surface albedo (direct) + sfc_alb_uvvis_dif ! Surface albedo (diffuse) + real(kind_phys), dimension(nCol, Model%levs+1), intent(in) :: & + fluxswUP_allsky, & ! SW All-sky flux (W/m2) + fluxswDOWN_allsky, & ! SW All-sky flux (W/m2) + fluxswUP_clrsky, & ! SW Clear-sky flux (W/m2) + fluxswDOWN_clrsky ! SW All-sky flux (W/m2) + real(kind_phys), intent(in) :: & + raddt ! Radiation time step + real(kind_phys), dimension(nCol,NSPC1), intent(in) :: & + aerodp ! Vertical integrated optical depth for various aerosol species + real(kind_phys), dimension(nCol,5), intent(in) :: & + cldsa ! Fraction of clouds for low, middle, high, total and BL + integer, dimension(nCol,3), intent(in) ::& + mbota, & ! vertical indices for low, middle and high cloud tops + mtopa ! vertical indices for low, middle and high cloud bases + real(kind_phys), dimension(nCol,Model%levs), intent(in) :: & + cld_frac, & ! Total cloud fraction in each layer + cldtausw ! approx .55mu band layer cloud optical depth + real(kind_phys),dimension(nCol, Model%levs) :: & + hswc, & ! All-sky heating rate (K/s) + hsw0 ! Clear-sky heating rate (K/s) + + ! Outputs (mandatory) + character(len=*), intent(out) :: & + errmsg + integer, intent(out) :: & + errflg + + ! Outputs (optional) + type(profsw_type), dimension(nCol, Model%levs+1), intent(inout), optional :: & + flxprf_sw ! 2D radiative fluxes, components: + ! upfxc - total sky upward flux (W/m2) + ! dnfxc - total sky dnward flux (W/m2) + ! upfx0 - clear sky upward flux (W/m2) + ! dnfx0 - clear sky dnward flux (W/m2) + type(cmpfsw_type), dimension(nCol), intent(inout), optional :: & + scmpsw ! 2D surface fluxes, components: + ! uvbfc - total sky downward uv-b flux at (W/m2) + ! uvbf0 - clear sky downward uv-b flux at (W/m2) + ! nirbm - downward nir direct beam flux (W/m2) + ! nirdf - downward nir diffused flux (W/m2) + ! visbm - downward uv+vis direct beam flux (W/m2) + ! visdf - downward uv+vis diffused flux (W/m2) + ! Local variables + integer :: i, j, k, iSFC, iTOA, itop, ibtc + real(kind_phys) :: tem0d, tem1, tem2 + real(kind_phys), dimension(nDay, Model%levs) :: thetaTendClrSky, thetaTendAllSky + logical :: l_fluxessw2d, top_at_1, l_sfcFluxessw1D + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. Model%lsswr) return + if (nDay .gt. 0) then + + ! Are any optional outputs requested? + l_fluxessw2d = present(flxprf_sw) + l_sfcfluxessw1D = present(scmpsw) + + ! ####################################################################################### + ! What is vertical ordering? + ! ####################################################################################### + top_at_1 = (p_lev(1,1) .lt. p_lev(1, Model%levs)) + if (top_at_1) then + iSFC = Model%levs+1 + iTOA = 1 + else + iSFC = 1 + iTOA = Model%levs+1 + endif + + ! ####################################################################################### + ! Compute SW heating-rates + ! ####################################################################################### + ! Clear-sky heating-rate (optional) + if (Model%swhtr) then + hsw0(:,:) = 0._kind_phys + call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & + fluxswUP_clrsky(idxday(1:nDay),:), & ! IN - Shortwave upward clear-sky flux profiles (W/m2) + fluxswDOWN_clrsky(idxday(1:nDay),:), & ! IN - Shortwave downward clear-sky flux profiles (W/m2) + p_lev(idxday(1:nDay),:), & ! IN - Pressure at model-interface (Pa) + thetaTendClrSky)) ! OUT - Clear-sky heating-rate (K/sec) + hsw0(idxday(1:nDay),:)=thetaTendClrSky + endif + + ! All-sky heating-rate (mandatory) + hswc(:,:) = 0._kind_phys + call check_error_msg('GFS_rrtmgp_post',compute_heating_rate( & + fluxswUP_allsky(idxday(1:nDay),:), & ! IN - Shortwave upward all-sky flux profiles (W/m2) + fluxswDOWN_allsky(idxday(1:nDay),:), & ! IN - Shortwave downward all-sky flux profiles (W/m2) + p_lev(idxday(1:nDay),:), & ! IN - Pressure at model-interface (Pa) + thetaTendAllSky)) ! OUT - All-sky heating-rate (K/sec) + hswc(idxday(1:nDay),:) = thetaTendAllSky + + ! Copy fluxes from RRTGMP types into model radiation types. + ! Mandatory outputs + Diag%topfsw(:)%upfxc = fluxswUP_allsky(:,iTOA) + Diag%topfsw(:)%upfx0 = fluxswUP_clrsky(:,iTOA) + Diag%topfsw(:)%dnfxc = fluxswDOWN_allsky(:,iTOA) + Radtend%sfcfsw(:)%upfxc = fluxswUP_allsky(:,iSFC) + Radtend%sfcfsw(:)%upfx0 = fluxswUP_clrsky(:,iSFC) + Radtend%sfcfsw(:)%dnfxc = fluxswDOWN_allsky(:,iSFC) + Radtend%sfcfsw(:)%dnfx0 = fluxswDOWN_clrsky(:,iSFC) + + ! Optional output + if(l_fluxessw2D) then + flxprf_sw(:,:)%upfxc = fluxswUP_allsky(:,:) + flxprf_sw(:,:)%dnfxc = fluxswDOWN_allsky(:,:) + flxprf_sw(:,:)%upfx0 = fluxswUP_clrsky(:,:) + flxprf_sw(:,:)%dnfx0 = fluxswDOWN_clrsky(:,:) + endif + + ! ####################################################################################### + ! Save SW outputs + ! ####################################################################################### + ! All-sky heating rate + do k = 1, Model%levs + Radtend%htrsw(1:nCol,k) = hswc(1:nCol,k) + enddo + ! Clear-sky heating rate + if (Model%swhtr) then + do k = 1, Model%levs + Radtend%swhc(1:nCol,k) = hsw0(1:nCol,k) + enddo + endif + + ! Surface down and up spectral component fluxes + ! - Save two spectral bands' surface downward and upward fluxes for output. + do i=1,nCol + Coupling%nirbmdi(i) = scmpsw(i)%nirbm + Coupling%nirdfdi(i) = scmpsw(i)%nirdf + Coupling%visbmdi(i) = scmpsw(i)%visbm + Coupling%visdfdi(i) = scmpsw(i)%visdf + + Coupling%nirbmui(i) = scmpsw(i)%nirbm * sfc_alb_nir_dir(1,i) + Coupling%nirdfui(i) = scmpsw(i)%nirdf * sfc_alb_nir_dif(1,i) + Coupling%visbmui(i) = scmpsw(i)%visbm * sfc_alb_uvvis_dir(1,i) + Coupling%visdfui(i) = scmpsw(i)%visdf * sfc_alb_uvvis_dif(1,i) + enddo + else ! if_nday_block + ! ####################################################################################### + ! Save SW outputs + ! ####################################################################################### + Radtend%htrsw(:,:) = 0.0 + Radtend%sfcfsw = sfcfsw_type( 0.0, 0.0, 0.0, 0.0 ) + Diag%topfsw = topfsw_type( 0.0, 0.0, 0.0 ) + scmpsw = cmpfsw_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) + + do i=1,nCol + Coupling%nirbmdi(i) = 0.0 + Coupling%nirdfdi(i) = 0.0 + Coupling%visbmdi(i) = 0.0 + Coupling%visdfdi(i) = 0.0 + + Coupling%nirbmui(i) = 0.0 + Coupling%nirdfui(i) = 0.0 + Coupling%visbmui(i) = 0.0 + Coupling%visdfui(i) = 0.0 + enddo + + if (Model%swhtr) then + Radtend%swhc(:,:) = 0 + endif + endif ! end_if_nday + + ! Radiation fluxes for other physics processes + do i=1,nCol + Coupling%sfcnsw(i) = Radtend%sfcfsw(i)%dnfxc - Radtend%sfcfsw(i)%upfxc + Coupling%sfcdsw(i) = Radtend%sfcfsw(i)%dnfxc + enddo + + ! ####################################################################################### + ! Save SW diagnostics + ! - For time averaged output quantities (including total-sky and clear-sky SW and LW + ! fluxes at TOA and surface; conventional 3-domain cloud amount, cloud top and base + ! pressure, and cloud top temperature; aerosols AOD, etc.), store computed results in + ! corresponding slots of array fluxr with appropriate time weights. + ! - Collect the fluxr data for wrtsfc + ! ####################################################################################### + if (Model%lssav) then + do i=1,nCol + Diag%fluxr(i,34) = Diag%fluxr(i,34) + Model%fhswr*aerodp(i,1) ! total aod at 550nm + Diag%fluxr(i,35) = Diag%fluxr(i,35) + Model%fhswr*aerodp(i,2) ! DU aod at 550nm + Diag%fluxr(i,36) = Diag%fluxr(i,36) + Model%fhswr*aerodp(i,3) ! BC aod at 550nm + Diag%fluxr(i,37) = Diag%fluxr(i,37) + Model%fhswr*aerodp(i,4) ! OC aod at 550nm + Diag%fluxr(i,38) = Diag%fluxr(i,38) + Model%fhswr*aerodp(i,5) ! SU aod at 550nm + Diag%fluxr(i,39) = Diag%fluxr(i,39) + Model%fhswr*aerodp(i,6) ! SS aod at 550nm + if (Radtend%coszen(i) > 0.) then + ! SW all-sky fluxes + tem0d = Model%fhswr * Radtend%coszdg(i) / Radtend%coszen(i) + Diag%fluxr(i,2 ) = Diag%fluxr(i,2) + Diag%topfsw(i)%upfxc * tem0d ! total sky top sw up + Diag%fluxr(i,3 ) = Diag%fluxr(i,3) + Radtend%sfcfsw(i)%upfxc * tem0d + Diag%fluxr(i,4 ) = Diag%fluxr(i,4) + Radtend%sfcfsw(i)%dnfxc * tem0d ! total sky sfc sw dn + ! SW uv-b fluxes + Diag%fluxr(i,21) = Diag%fluxr(i,21) + scmpsw(i)%uvbfc * tem0d ! total sky uv-b sw dn + Diag%fluxr(i,22) = Diag%fluxr(i,22) + scmpsw(i)%uvbf0 * tem0d ! clear sky uv-b sw dn + ! SW TOA incoming fluxes + Diag%fluxr(i,23) = Diag%fluxr(i,23) + Diag%topfsw(i)%dnfxc * tem0d ! top sw dn + ! SW SFC flux components + Diag%fluxr(i,24) = Diag%fluxr(i,24) + scmpsw(i)%visbm * tem0d ! uv/vis beam sw dn + Diag%fluxr(i,25) = Diag%fluxr(i,25) + scmpsw(i)%visdf * tem0d ! uv/vis diff sw dn + Diag%fluxr(i,26) = Diag%fluxr(i,26) + scmpsw(i)%nirbm * tem0d ! nir beam sw dn + Diag%fluxr(i,27) = Diag%fluxr(i,27) + scmpsw(i)%nirdf * tem0d ! nir diff sw dn + ! SW clear-sky fluxes + Diag%fluxr(i,29) = Diag%fluxr(i,29) + Diag%topfsw(i)%upfx0 * tem0d + Diag%fluxr(i,31) = Diag%fluxr(i,31) + Radtend%sfcfsw(i)%upfx0 * tem0d + Diag%fluxr(i,32) = Diag%fluxr(i,32) + Radtend%sfcfsw(i)%dnfx0 * tem0d + endif + enddo + + ! Save total and boundary-layer clouds + do i=1,nCol + Diag%fluxr(i,17) = Diag%fluxr(i,17) + raddt * cldsa(i,4) + Diag%fluxr(i,18) = Diag%fluxr(i,18) + raddt * cldsa(i,5) + enddo + + ! Save cld frac,toplyr,botlyr and top temp, note that the order of h,m,l cloud + ! is reversed for the fluxr output. save interface pressure (pa) of top/bot + do j = 1, 3 + do i = 1, nCol + tem0d = raddt * cldsa(i,j) + itop = mtopa(i,j) + ibtc = mbota(i,j) + Diag%fluxr(i, 8-j) = Diag%fluxr(i, 8-j) + tem0d + Diag%fluxr(i,11-j) = Diag%fluxr(i,11-j) + tem0d * Statein%prsi(i,itop) + Diag%fluxr(i,14-j) = Diag%fluxr(i,14-j) + tem0d * Statein%prsi(i,ibtc) + Diag%fluxr(i,17-j) = Diag%fluxr(i,17-j) + tem0d * Statein%tgrs(i,itop) + + ! Add optical depth and emissivity output + tem1 = 0. + do k=ibtc,itop + tem1 = tem1 + cldtausw(i,k) ! approx .55 mu channel + enddo + Diag%fluxr(i,43-j) = Diag%fluxr(i,43-j) + tem0d * tem1 + enddo + enddo + endif + end subroutine GFS_rrtmgp_sw_post_run + + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_sw_post_finalize + ! ######################################################################################### + subroutine GFS_rrtmgp_sw_post_finalize () + end subroutine GFS_rrtmgp_sw_post_finalize + +end module GFS_rrtmgp_sw_post diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta new file mode 100644 index 000000000..a817d9332 --- /dev/null +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -0,0 +1,258 @@ +[ccpp-arg-table] + name = GFS_rrtmgp_sw_post_run + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = instance of derived type GFS_control_type + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[Grid] + standard_name = GFS_grid_type_instance + long_name = instance of derived type GFS_grid_type + units = DDT + dimensions = () + type = GFS_grid_type + intent = in + optional = F +[Diag] + standard_name = GFS_diag_type_instance + long_name = instance of derived type GFS_diag_type + units = DDT + dimensions = () + type = GFS_diag_type + intent = inout + optional = F +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = instance of derived type GFS_radtend_type + units = DDT + dimensions = () + type = GFS_radtend_type + intent = inout + optional = F +[Coupling] + standard_name = GFS_coupling_type_instance + long_name = instance of derived type GFS_coupling_type + units = DDT + dimensions = () + type = GFS_coupling_type + intent = inout + optional = F +[Statein] + standard_name = GFS_statein_type_instance + long_name = instance of derived type GFS_statein_type + units = DDT + dimensions = () + type = GFS_statein_type + intent = in + optional = F +[scmpsw] + standard_name = components_of_surface_downward_shortwave_fluxes + long_name = derived type for special components of surface downward shortwave fluxes + units = W m-2 + dimensions = (horizontal_dimension) + type = cmpfsw_type + intent = inout + optional = T +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure level + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[sfc_alb_nir_dir] + standard_name = surface_albedo_nearIR_direct + long_name = near-IR (direct) surface albedo (sfc_alb_nir_dir) + units = none + dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfc_alb_nir_dif] + standard_name = surface_albedo_nearIR_diffuse + long_name = near-IR (diffuse) surface albedo (sfc_alb_nir_dif) + units = none + dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfc_alb_uvvis_dir] + standard_name = surface_albedo_uvvis_dir + long_name = UVVIS (direct) surface albedo (sfc_alb_uvvis_dir) + units = none + dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfc_alb_uvvis_dif] + standard_name = surface_albedo_uvvis_dif + long_name = UVVIS (diffuse) surface albedo (sfc_alb_uvvis_dif) + units = none + dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[idxday] + standard_name = daytime_points + long_name = daytime points + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[fluxswUP_allsky] + standard_name = RRTMGP_sw_flux_profile_upward_allsky + long_name = RRTMGP upward shortwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[fluxswDOWN_allsky] + standard_name = RRTMGP_sw_flux_profile_downward_allsky + long_name = RRTMGP downward shortwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[fluxswUP_clrsky] + standard_name = RRTMGP_sw_flux_profile_upward_clrsky + long_name = RRTMGP upward shortwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[fluxswDOWN_clrsky] + standard_name = RRTMGP_sw_flux_profile_downward_clrsky + long_name = RRTMGP downward shortwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[raddt] + standard_name = time_step_for_radiation + long_name = radiation time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[aerodp] + standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles + long_name = vertical integrated optical depth for various aerosol species + units = none + dimensions = (horizontal_dimension,number_of_species_for_aerosol_optical_depth) + type = real + kind = kind_phys + intent = in + optional = F +[cldsa] + standard_name = cloud_area_fraction_for_radiation + long_name = fraction of clouds for low, middle, high, total and BL + units = frac + dimensions = (horizontal_dimension,5) + type = real + kind = kind_phys + intent = in + optional = F +[mtopa] + standard_name = model_layer_number_at_cloud_top + long_name = vertical indices for low, middle and high cloud tops + units = index + dimensions = (horizontal_dimension,3) + type = integer + intent = in + optional = F +[mbota] + standard_name = model_layer_number_at_cloud_base + long_name = vertical indices for low, middle and high cloud bases + units = index + dimensions = (horizontal_dimension,3) + type = integer + intent = in + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cldtausw] + standard_name = RRTMGP_cloud_optical_depth_layers_at_0_55mu_band + long_name = approx .55mu band layer cloud optical depth + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sw_gas_props] + standard_name = coefficients_for_sw_gas_optics + long_name = DDT containing spectral information for RRTMGP SW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[flxprf_sw] + standard_name = RRTMGP_sw_fluxes + long_name = sw fluxes total sky / csk and up / down at levels + units = W m-2 + dimensions = (horizontal_dimension,adjusted_vertical_level_dimension_plus_one) + type = profsw_type + intent = inout + optional = T +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 new file mode 100644 index 000000000..6987c3e4a --- /dev/null +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -0,0 +1,155 @@ +module GFS_rrtmgp_sw_pre + use physparam + use machine, only: & + kind_phys ! Working type + use GFS_typedefs, only: & + GFS_sfcprop_type, & ! Surface fields + GFS_control_type, & ! Model control parameters + GFS_grid_type, & ! Grid and interpolation related data + GFS_coupling_type, & ! + GFS_statein_type, & ! + GFS_radtend_type, & ! Radiation tendencies needed in physics + GFS_interstitial_type + use module_radiation_astronomy,only: & + coszmn ! Function to compute cos(SZA) + use module_radiation_surface, only: & + NF_ALBD, & ! Number of surface albedo categories (4; nir-direct, nir-diffuse, uvvis-direct, uvvis-diffuse) + setalb ! Routine to compute surface albedo + use surface_perturbation, only: & + cdfnor ! Routine to compute CDF (used to compute percentiles) + use mo_gas_optics_rrtmgp, only: & + ty_gas_optics_rrtmgp + public GFS_rrtmgp_sw_pre_run,GFS_rrtmgp_sw_pre_init,GFS_rrtmgp_sw_pre_finalize + +contains + + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_sw_pre_init + ! ######################################################################################### + subroutine GFS_rrtmgp_sw_pre_init () + end subroutine GFS_rrtmgp_sw_pre_init + + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_sw_pre_run + ! ######################################################################################### +!> \section arg_table_GFS_rrtmgp_sw_pre_run +!! \htmlinclude GFS_rrtmgp_sw_pre.html +!! + subroutine GFS_rrtmgp_sw_pre_run(Model, Grid, Sfcprop, Statein, ncol, p_lay, p_lev, & + tv_lay, relhum, tracer, sw_gas_props, nday, idxday, alb1d, sfc_alb_nir_dir, & + sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, RadTend, Coupling, & + errmsg, errflg) + + ! Inputs + type(GFS_control_type), intent(in) :: & + Model ! DDT: FV3-GFS model control parameters + type(GFS_grid_type), intent(in) :: & + Grid ! DDT: FV3-GFS grid and interpolation related data + type(GFS_sfcprop_type), intent(in) :: & + Sfcprop ! DDT: FV3-GFS surface fields + type(GFS_statein_type), intent(in) :: & + Statein ! DDT: FV3-GFS prognostic state data in from dycore + integer, intent(in) :: & + ncol ! Number of horizontal grid points + real(kind_phys), dimension(ncol,Model%levs),intent(in) :: & + p_lay, & ! Layer pressure + tv_lay, & ! Layer virtual-temperature + relhum ! Layer relative-humidity + real(kind_phys), dimension(ncol, Model%levs, 2:Model%ntrac),intent(in) :: & + tracer + real(kind_phys), dimension(ncol,Model%levs+1),intent(in) :: & + p_lev ! Pressure @ layer interfaces (Pa) + type(ty_gas_optics_rrtmgp),intent(in) :: & + sw_gas_props ! RRTMGP DDT: spectral information for SW calculation + + ! Outputs + integer, intent(out) :: & + nday ! Number of daylit points + integer, dimension(ncol), intent(out) :: & + idxday ! Indices for daylit points + real(kind_phys), dimension(ncol), intent(out) :: & + alb1d ! Surface albedo pertubation + real(kind_phys), dimension(sw_gas_props%get_nband(),ncol), intent(out) :: & + sfc_alb_nir_dir, & ! Surface albedo (direct) + sfc_alb_nir_dif, & ! Surface albedo (diffuse) + sfc_alb_uvvis_dir, & ! Surface albedo (direct) + sfc_alb_uvvis_dif ! Surface albedo (diffuse) + type(GFS_radtend_type), intent(inout) :: & + Radtend ! DDT: FV3-GFS radiation tendencies + type(GFS_coupling_type), intent(inout) :: & + Coupling ! DDT: FV3-GFS coupling arrays + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error flag + + ! Local variables + integer :: i, j, iCol, iBand, iLay + real(kind_phys), dimension(ncol, NF_ALBD) :: sfcalb + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. Model%lsswr) return + + ! ####################################################################################### + ! Compute cosine of zenith angle (only when SW is called) + ! ####################################################################################### + call coszmn (Grid%xlon, Grid%sinlat, Grid%coslat, Model%solhr, NCOL, Model%me, & + Radtend%coszen, Radtend%coszdg) + + ! ####################################################################################### + ! For SW gather daylit points + ! ####################################################################################### + nday = 0 + idxday = 0 + do i = 1, NCOL + if (Radtend%coszen(i) >= 0.0001) then + nday = nday + 1 + idxday(nday) = i + endif + enddo + + ! ####################################################################################### + ! mg, sfc-perts + ! --- scale random patterns for surface perturbations with perturbation size + ! --- turn vegetation fraction pattern into percentile pattern + ! ####################################################################################### + alb1d(:) = 0. + if (Model%do_sfcperts) then + if (Model%pertalb(1) > 0.) then + do i=1,ncol + call cdfnor(Coupling%sfc_wts(i,5),alb1d(i)) + enddo + endif + endif + + ! ####################################################################################### + ! Call module_radiation_surface::setalb() to setup surface albedo. + ! ####################################################################################### + call setalb (Sfcprop%slmsk, Sfcprop%snowd, Sfcprop%sncovr, Sfcprop%snoalb, Sfcprop%zorl, & + Radtend%coszen, Sfcprop%tsfc, Sfcprop%tsfc, Sfcprop%hprime(:,1), Sfcprop%alvsf, & + Sfcprop%alnsf, Sfcprop%alvwf, Sfcprop%alnwf, Sfcprop%facsf, Sfcprop%facwf, & + Sfcprop%fice, Sfcprop%tisfc, NCOL, alb1d, Model%pertalb, sfcalb) + + ! Approximate mean surface albedo from vis- and nir- diffuse values. + Radtend%sfalb(:) = max(0.01, 0.5 * (sfcalb(:,2) + sfcalb(:,4))) + + ! Spread across all SW bands + do iBand=1,sw_gas_props%get_nband() + sfc_alb_nir_dir(iBand,1:NCOL) = sfcalb(1:NCOL,1) + sfc_alb_nir_dif(iBand,1:NCOL) = sfcalb(1:NCOL,2) + sfc_alb_uvvis_dir(iBand,1:NCOL) = sfcalb(1:NCOL,3) + sfc_alb_uvvis_dif(iBand,1:NCOL) = sfcalb(1:NCOL,4) + enddo + + end subroutine GFS_rrtmgp_sw_pre_run + + ! ######################################################################################### + ! SUBROUTINE GFS_rrtmgp_sw_pre_finalize + ! ######################################################################################### + subroutine GFS_rrtmgp_sw_pre_finalize () + end subroutine GFS_rrtmgp_sw_pre_finalize + +end module GFS_rrtmgp_sw_pre diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta new file mode 100644 index 000000000..73df740e1 --- /dev/null +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -0,0 +1,194 @@ +[ccpp-arg-table] + name = GFS_rrtmgp_sw_pre_run + type = scheme +[Model] + standard_name = GFS_control_type_instance + long_name = instance of derived type GFS_control_type + units = DDT + dimensions = () + type = GFS_control_type + intent = in + optional = F +[Grid] + standard_name = GFS_grid_type_instance + long_name = instance of derived type GFS_grid_type + units = DDT + dimensions = () + type = GFS_grid_type + intent = in + optional = F +[Sfcprop] + standard_name = GFS_sfcprop_type_instance + long_name = instance of derived type GFS_sfcprop_type + units = DDT + dimensions = () + type = GFS_sfcprop_type + intent = in + optional = F +[Statein] + standard_name = GFS_statein_type_instance + long_name = instance of derived type GFS_statein_type + units = DDT + dimensions = () + type = GFS_statein_type + intent = in + optional = F +[Radtend] + standard_name = GFS_radtend_type_instance + long_name = instance of derived type GFS_radtend_type + units = DDT + dimensions = () + type = GFS_radtend_type + intent = inout + optional = F +[Coupling] + standard_name = GFS_coupling_type_instance + long_name = Fortran DDT containing FV3-GFS fields to/from coupling with other components + units = DDT + dimensions = () + type = GFS_coupling_type + intent = inout + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[tv_lay] + standard_name = virtual_temperature + long_name = layer virtual temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[relhum] + standard_name = relative_humidity + long_name = layer relative humidity + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure at vertical layer for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure at vertical interface for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[tracer] + standard_name = chemical_tracers + long_name = chemical tracers + units = g g-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[sw_gas_props] + standard_name = coefficients_for_sw_gas_optics + long_name = DDT containing spectral information for RRTMGP SW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[alb1d] + standard_name = surface_albedo_perturbation + long_name = surface albedo perturbation + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sfc_alb_nir_dir] + standard_name = surface_albedo_nearIR_direct + long_name = near-IR (direct) surface albedo (sfc_alb_nir_dir) + units = none + dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sfc_alb_nir_dif] + standard_name = surface_albedo_nearIR_diffuse + long_name = near-IR (diffuse) surface albedo (sfc_alb_nir_dif) + units = none + dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sfc_alb_uvvis_dir] + standard_name = surface_albedo_uvvis_dir + long_name = UVVIS (direct) surface albedo (sfc_alb_uvvis_dir) + units = none + dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sfc_alb_uvvis_dif] + standard_name = surface_albedo_uvvis_dif + long_name = UVVIS (diffuse) surface albedo (sfc_alb_uvvis_dif) + units = none + dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer + intent = out + optional = F +[idxday] + standard_name = daytime_points + long_name = daytime points + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F +######################################################################## +[ccpp-arg-table] + name = GFS_rrtmgp_sw_pre_finalize + type = scheme \ No newline at end of file diff --git a/physics/GFS_stochastics.F90 b/physics/GFS_stochastics.F90 index c35de0954..9b4533cf9 100644 --- a/physics/GFS_stochastics.F90 +++ b/physics/GFS_stochastics.F90 @@ -26,7 +26,8 @@ end subroutine GFS_stochastics_finalize !! -# defines random seed indices for radiation (in a reproducible way) !! -# interpolates coefficients for prognostic ozone calculation !! -# performs surface data cycling via the GFS gcycle routine - subroutine GFS_stochastics_run (im, km, do_sppt, use_zmtnblck, do_shum, do_skeb, & + subroutine GFS_stochastics_run (im, km, kdt, do_sppt, use_zmtnblck, do_shum, & + do_skeb, do_ca,ca_global,ca1,si,vfact_ca, & zmtnblck, sppt_wts, skebu_wts, skebv_wts, shum_wts,& sppt_wts_inv, skebu_wts_inv, skebv_wts_inv, & shum_wts_inv, diss_est, & @@ -42,11 +43,13 @@ subroutine GFS_stochastics_run (im, km, do_sppt, use_zmtnblck, do_shum, do_skeb, integer, intent(in) :: im integer, intent(in) :: km + integer, intent(in) :: kdt logical, intent(in) :: do_sppt + logical, intent(in) :: do_ca + logical, intent(in) :: ca_global logical, intent(in) :: use_zmtnblck logical, intent(in) :: do_shum logical, intent(in) :: do_skeb - !logical, intent(in) :: isppt_deep real(kind_phys), dimension(1:im), intent(in) :: zmtnblck ! sppt_wts only allocated if do_sppt == .true. real(kind_phys), dimension(:,:), intent(inout) :: sppt_wts @@ -79,23 +82,22 @@ subroutine GFS_stochastics_run (im, km, do_sppt, use_zmtnblck, do_shum, do_skeb, real(kind_phys), dimension(1:im), intent(inout) :: totprcpb real(kind_phys), dimension(1:im), intent(inout) :: cnvprcpb logical, intent(in) :: cplflx - ! rain_cpl, snow_cpl only allocated if cplflx == .true. or do_sppt == .true. + ! rain_cpl, snow_cpl only allocated if cplflx == .true. or cplchm == .true. real(kind_phys), dimension(:), intent(inout) :: rain_cpl real(kind_phys), dimension(:), intent(inout) :: snow_cpl - ! drain_cpl, dsnow_cpl only allocated if do_sppt == .true. + ! drain_cpl, dsnow_cpl only allocated if cplflx == .true. or cplchm == .true. real(kind_phys), dimension(:), intent(in) :: drain_cpl real(kind_phys), dimension(:), intent(in) :: dsnow_cpl - ! tconvtend ... vconvtend only allocated if isppt_deep == .true. - !real(kind_phys), dimension(:,:), intent(in) :: tconvtend - !real(kind_phys), dimension(:,:), intent(in) :: qconvtend - !real(kind_phys), dimension(:,:), intent(in) :: uconvtend - !real(kind_phys), dimension(:,:), intent(in) :: vconvtend + real(kind_phys), dimension(1:km), intent(in) :: si + real(kind_phys), dimension(1:km), intent(inout) :: vfact_ca + real(kind_phys), dimension(1:im), intent(in) :: ca1 character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg !--- local variables integer :: k, i real(kind=kind_phys) :: upert, vpert, tpert, qpert, qnew, sppt_vwt + real(kind=kind_phys), dimension(1:im,1:km) :: ca ! Initialize CCPP error handling variables errmsg = '' @@ -124,24 +126,13 @@ subroutine GFS_stochastics_run (im, km, do_sppt, use_zmtnblck, do_shum, do_skeb, if (use_zmtnblck)then sppt_wts(i,k)=(sppt_wts(i,k)-1)*sppt_vwt+1.0 endif - sppt_wts_inv(i,km-k+1)=sppt_wts(i,k) - - !if(isppt_deep)then - - ! upert = (gu0(i,k) - ugrs(i,k) - uconvtend(i,k)) + uconvtend(i,k) * sppt_wts(i,k) - ! vpert = (gv0(i,k) - vgrs(i,k) - vconvtend(i,k)) + vconvtend(i,k) * sppt_wts(i,k) - ! tpert = (gt0(i,k) - tgrs(i,k) - dtdtr(i,k) - tconvtend(i,k)) + tconvtend(i,k) * sppt_wts(i,k) - ! qpert = (gq0(i,k) - qgrs(i,k) - qconvtend(i,k)) + qconvtend(i,k) * sppt_wts(i,k) - - !else + sppt_wts_inv(i,k)=sppt_wts(i,k) upert = (gu0(i,k) - ugrs(i,k)) * sppt_wts(i,k) vpert = (gv0(i,k) - vgrs(i,k)) * sppt_wts(i,k) tpert = (gt0(i,k) - tgrs(i,k) - dtdtr(i,k)) * sppt_wts(i,k) qpert = (gq0(i,k) - qgrs(i,k)) * sppt_wts(i,k) - !endif - gu0(i,k) = ugrs(i,k)+upert gv0(i,k) = vgrs(i,k)+vpert @@ -154,21 +145,6 @@ subroutine GFS_stochastics_run (im, km, do_sppt, use_zmtnblck, do_shum, do_skeb, enddo enddo - !if(isppt_deep)then - ! tprcp(:) = tprcp(:) + (sppt_wts(:,15) - 1 )*rainc(:) - ! totprcp(:) = totprcp(:) + (sppt_wts(:,15) - 1 )*rainc(:) - ! cnvprcp(:) = cnvprcp(:) + (sppt_wts(:,15) - 1 )*rainc(:) - !! ! bucket precipitation adjustment due to sppt - ! totprcpb(:) = totprcpb(:) + (sppt_wts(:,15) - 1 )*rainc(:) - ! cnvprcpb(:) = cnvprcpb(:) + (sppt_wts(:,15) - 1 )*rainc(:) - - ! if (cplflx) then !Need to make proper adjustments for deep convection only perturbations - ! rain_cpl(:) = rain_cpl(:) + (sppt_wts(:,15) - 1.0)*drain_cpl(:) - ! snow_cpl(:) = snow_cpl(:) + (sppt_wts(:,15) - 1.0)*dsnow_cpl(:) - ! endif - - !else - ! instantaneous precip rate going into land model at the next time step tprcp(:) = sppt_wts(:,15)*tprcp(:) totprcp(:) = totprcp(:) + (sppt_wts(:,15) - 1 )*rain(:) @@ -183,14 +159,82 @@ subroutine GFS_stochastics_run (im, km, do_sppt, use_zmtnblck, do_shum, do_skeb, snow_cpl(:) = snow_cpl(:) + (sppt_wts(:,15) - 1.0)*dsnow_cpl(:) endif - !endif + endif + + if (do_ca .and. ca_global) then + + if(kdt == 1)then + do k=1,km + if (si(k) .lt. 0.1 .and. si(k) .gt. 0.025) then + vfact_ca(k) = (si(k)-0.025)/(0.1-0.025) + else if (si(k) .lt. 0.025) then + vfact_ca(k) = 0.0 + else + vfact_ca(k) = 1.0 + endif + enddo + vfact_ca(2)=vfact_ca(3)*0.5 + vfact_ca(1)=0.0 + endif + + do k = 1,km + do i = 1,im + sppt_vwt=1.0 + if (zmtnblck(i).EQ.0.0) then + sppt_vwt=1.0 + else + if (k.GT.zmtnblck(i)+2) then + sppt_vwt=1.0 + endif + if (k.LE.zmtnblck(i)) then + sppt_vwt=0.0 + endif + if (k.EQ.zmtnblck(i)+1) then + sppt_vwt=0.333333 + endif + if (k.EQ.zmtnblck(i)+2) then + sppt_vwt=0.666667 + endif + endif + + ca(i,k)=((ca1(i)-1.)*sppt_vwt*vfact_ca(k))+1.0 + + upert = (gu0(i,k) - ugrs(i,k)) * ca(i,k) + vpert = (gv0(i,k) - vgrs(i,k)) * ca(i,k) + tpert = (gt0(i,k) - tgrs(i,k) - dtdtr(i,k)) * ca(i,k) + qpert = (gq0(i,k) - qgrs(i,k)) * ca(i,k) + gu0(i,k) = ugrs(i,k)+upert + gv0(i,k) = vgrs(i,k)+vpert + !negative humidity check + qnew = qgrs(i,k)+qpert + if (qnew >= 1.0e-10) then + gq0(i,k) = qnew + gt0(i,k) = tgrs(i,k) + tpert + dtdtr(i,k) + endif + enddo + enddo + + ! instantaneous precip rate going into land model at the next time step + tprcp(:) = ca(:,15)*tprcp(:) + totprcp(:) = totprcp(:) + (ca(:,15) - 1 )*rain(:) + ! acccumulated total and convective preciptiation + cnvprcp(:) = cnvprcp(:) + (ca(:,15) - 1 )*rainc(:) + ! bucket precipitation adjustment due to sppt + totprcpb(:) = totprcpb(:) + (ca(:,15) - 1 )*rain(:) + cnvprcpb(:) = cnvprcpb(:) + (ca(:,15) - 1 )*rainc(:) + + if (cplflx) then + rain_cpl(:) = rain_cpl(:) + (ca(:,15) - 1.0)*drain_cpl(:) + snow_cpl(:) = snow_cpl(:) + (ca(:,15) - 1.0)*dsnow_cpl(:) + endif + endif if (do_shum) then do k=1,km gq0(:,k) = gq0(:,k)*(1.0 + shum_wts(:,k)) - shum_wts_inv(:,km-k+1) = shum_wts(:,k) + shum_wts_inv(:,k) = shum_wts(:,k) end do endif @@ -198,8 +242,8 @@ subroutine GFS_stochastics_run (im, km, do_sppt, use_zmtnblck, do_shum, do_skeb, do k=1,km gu0(:,k) = gu0(:,k)+skebu_wts(:,k)*(diss_est(:,k)) gv0(:,k) = gv0(:,k)+skebv_wts(:,k)*(diss_est(:,k)) - skebu_wts_inv(:,km-k+1) = skebu_wts(:,k) - skebv_wts_inv(:,km-k+1) = skebv_wts(:,k) + skebu_wts_inv(:,k) = skebu_wts(:,k) + skebv_wts_inv(:,k) = skebv_wts(:,k) enddo endif diff --git a/physics/GFS_stochastics.meta b/physics/GFS_stochastics.meta index 9232c8d6a..c4fad912e 100644 --- a/physics/GFS_stochastics.meta +++ b/physics/GFS_stochastics.meta @@ -17,6 +17,14 @@ type = integer intent = in optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F [do_sppt] standard_name = flag_for_stochastic_surface_physics_perturbations long_name = flag for stochastic surface physics perturbations @@ -67,6 +75,49 @@ kind = kind_phys intent = inout optional = F +[do_ca] + standard_name = flag_for_cellular_automata + long_name = cellular automata main switch + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ca_global] + standard_name = flag_for_global_cellular_automata + long_name = switch for global ca + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ca1] + standard_name = cellular_automata_global_pattern + long_name = cellular automata global pattern + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[vfact_ca] + standard_name = vertical_weight_for_ca + long_name = vertical weight for ca + units = frac + dimensions = (vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[si] + standard_name = vertical_sigma_coordinate_for_radiation_initialization + long_name = vertical sigma coordinate for radiation initialization + units = none + dimensions = (number_of_vertical_layers_for_radiation_calculations_plus_one) + type = real + kind = kind_phys + intent = in + optional = F [skebu_wts] standard_name = weights_for_stochastic_skeb_perturbation_of_x_wind long_name = weights for stochastic skeb perturbation of x wind diff --git a/physics/GFS_suite_interstitial.F90 b/physics/GFS_suite_interstitial.F90 index e4026a75d..3d22cf33b 100644 --- a/physics/GFS_suite_interstitial.F90 +++ b/physics/GFS_suite_interstitial.F90 @@ -228,15 +228,15 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl if (frac_grid) then do i=1,im - tem = one - cice(i) - frland(i) + tem = (one - frland(i)) * cice(i) ! tem = ice fraction wrt whole cell if (flag_cice(i)) then - adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & - + ulwsfc_cice(i) * cice(i) & - + adjsfculw_ocn(i) * tem + adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & + + ulwsfc_cice(i) * tem & + + adjsfculw_ocn(i) * (one - frland(i) - tem) else - adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & - + adjsfculw_ice(i) * cice(i) & - + adjsfculw_ocn(i) * tem + adjsfculw(i) = adjsfculw_lnd(i) * frland(i) & + + adjsfculw_ice(i) * tem & + + adjsfculw_ocn(i) * (one - frland(i) - tem) endif enddo else @@ -265,23 +265,23 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl endif do i=1,im - dlwsfc(i) = dlwsfc(i) + adjsfcdlw(i)*dtf - ulwsfc(i) = ulwsfc(i) + adjsfculw(i)*dtf - psmean(i) = psmean(i) + pgr(i)*dtf ! mean surface pressure + dlwsfc(i) = dlwsfc(i) + adjsfcdlw(i)*dtf + ulwsfc(i) = ulwsfc(i) + adjsfculw(i)*dtf + psmean(i) = psmean(i) + pgr(i)*dtf ! mean surface pressure end do if (ldiag3d) then if (lsidea) then do k=1,levs do i=1,im - dt3dt_lw(i,k) = dt3dt_lw(i,k) + lwhd(i,k,1)*dtf - dt3dt_sw(i,k) = dt3dt_sw(i,k) + lwhd(i,k,2)*dtf - dt3dt_pbl(i,k) = dt3dt_pbl(i,k) + lwhd(i,k,3)*dtf + dt3dt_lw(i,k) = dt3dt_lw(i,k) + lwhd(i,k,1)*dtf + dt3dt_sw(i,k) = dt3dt_sw(i,k) + lwhd(i,k,2)*dtf + dt3dt_pbl(i,k) = dt3dt_pbl(i,k) + lwhd(i,k,3)*dtf dt3dt_dcnv(i,k) = dt3dt_dcnv(i,k) + lwhd(i,k,4)*dtf dt3dt_scnv(i,k) = dt3dt_scnv(i,k) + lwhd(i,k,5)*dtf - dt3dt_mp(i,k) = dt3dt_mp(i,k) + lwhd(i,k,6)*dtf - end do - end do + dt3dt_mp(i,k) = dt3dt_mp(i,k) + lwhd(i,k,6)*dtf + enddo + enddo else do k=1,levs do i=1,im @@ -298,7 +298,7 @@ subroutine GFS_suite_interstitial_2_run (im, levs, lssav, ldiag3d, lsidea, cplfl tx1(i) = 0.0 tx2(i) = 10.0 ctei_r(i) = 10.0 - end do + enddo if ((((imfshalcnv == 0 .and. shal_cnv) .or. old_monin) .and. mstrat) & .or. do_shoc) then @@ -463,30 +463,30 @@ end subroutine GFS_suite_interstitial_3_finalize subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & satmedmf, trans_trac, do_shoc, ltaerosol, ntrac, ntcw, & ntiw, ntclamt, ntrw, ntsw, ntrnc, ntsnc, ntgl, ntgnc, & - xlat, gt0, gq0, imp_physics, imp_physics_mg, & + xlon, xlat, gt0, gq0, imp_physics, imp_physics_mg, & imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, & imp_physics_gfdl, imp_physics_thompson, & imp_physics_wsm6, imp_physics_fer_hires, prsi, & prsl, prslk, rhcbot,rhcpbl, rhctop, rhcmax, islmsk, & - work1, work2, kpbl, kinver,clw, rhc, save_qc, save_qi, & - save_tcp, errmsg, errflg) + work1, work2, kpbl, kinver, ras, me, & + clw, rhc, save_qc, save_qi, save_tcp, errmsg, errflg) use machine, only: kind_phys implicit none ! interface variables - integer, intent(in) :: im, levs, nn, ntrac, ntcw, ntiw, ntclamt, ntrw, & - ntsw, ntrnc, ntsnc, ntgl, ntgnc, imp_physics, imp_physics_mg, imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, & - imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6,imp_physics_fer_hires + integer, intent(in) :: im, levs, nn, ntrac, ntcw, ntiw, ntclamt, ntrw, & + ntsw, ntrnc, ntsnc, ntgl, ntgnc, imp_physics, imp_physics_mg, imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, & + imp_physics_gfdl, imp_physics_thompson, imp_physics_wsm6,imp_physics_fer_hires, me integer, dimension(im), intent(in) :: islmsk, kpbl, kinver - logical, intent(in) :: cscnv, satmedmf, trans_trac, do_shoc, ltaerosol + logical, intent(in) :: cscnv, satmedmf, trans_trac, do_shoc, ltaerosol, ras real(kind=kind_phys), intent(in) :: rhcbot, rhcmax, rhcpbl, rhctop real(kind=kind_phys), dimension(im), intent(in) :: work1, work2 real(kind=kind_phys), dimension(im, levs), intent(in) :: prsl, prslk real(kind=kind_phys), dimension(im, levs+1), intent(in) :: prsi - real(kind=kind_phys), dimension(im), intent(in) :: xlat + real(kind=kind_phys), dimension(im), intent(in) :: xlon, xlat real(kind=kind_phys), dimension(im, levs), intent(in) :: gt0 real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: gq0 @@ -497,7 +497,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & real(kind=kind_phys), dimension(im, levs, nn), intent(inout) :: clw character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + integer, intent(out) :: errflg ! local variables integer :: i,k,n,tracers,kk @@ -514,7 +514,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & errmsg = '' errflg = 0 - if (cscnv .or. satmedmf .or. trans_trac ) then + if (cscnv .or. satmedmf .or. trans_trac .or. ras) then tracers = 2 do n=2,ntrac if ( n /= ntcw .and. n /= ntiw .and. n /= ntclamt .and. & @@ -599,7 +599,7 @@ subroutine GFS_suite_interstitial_3_run (im, levs, nn, cscnv, & enddo if(ltaerosol) then save_qi(:,:) = clw(:,:,1) - save_qc(:,:) = clw(:,:,2) + save_qc(:,:) = clw(:,:,2) else save_qi(:,:) = clw(:,:,1) endif @@ -773,3 +773,51 @@ subroutine GFS_suite_interstitial_4_run (im, levs, ltaerosol, cplchm, tracers_to end subroutine GFS_suite_interstitial_4_run end module GFS_suite_interstitial_4 + + module GFS_suite_interstitial_5 + + contains + + subroutine GFS_suite_interstitial_5_init () + end subroutine GFS_suite_interstitial_5_init + + subroutine GFS_suite_interstitial_5_finalize() + end subroutine GFS_suite_interstitial_5_finalize + +!> \section arg_table_GFS_suite_interstitial_5_run Argument Table +!! \htmlinclude GFS_suite_interstitial_5_run.html +!! + subroutine GFS_suite_interstitial_5_run (im, levs, ntrac, ntcw, ntiw, nn, gq0, clw, errmsg, errflg) + + use machine, only: kind_phys + + implicit none + + ! interface variables + integer, intent(in) :: im, levs, ntrac, ntcw, ntiw, nn + + real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: gq0 + + real(kind=kind_phys), dimension(im, levs, nn), intent(out) :: clw + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! local variables + integer :: i,k + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + do k=1,levs + do i=1,im + clw(i,k,1) = gq0(i,k,ntiw) ! ice + clw(i,k,2) = gq0(i,k,ntcw) ! water + enddo + enddo + + end subroutine GFS_suite_interstitial_5_run + + end module GFS_suite_interstitial_5 + diff --git a/physics/GFS_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 27af68a90..d05d7335c 100644 --- a/physics/GFS_suite_interstitial.meta +++ b/physics/GFS_suite_interstitial.meta @@ -443,7 +443,7 @@ intent = in optional = F [htrsw] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky sw heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -452,7 +452,7 @@ intent = in optional = F [htrlw] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky lw heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -534,7 +534,7 @@ optional = F [qgrs_cloud_water] standard_name = cloud_condensed_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -1209,6 +1209,15 @@ type = integer intent = in optional = F +[xlon] + standard_name = longitude + long_name = longitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F [xlat] standard_name = latitude long_name = latitude @@ -1405,6 +1414,22 @@ type = integer intent = in optional = F +[ras] + standard_name = flag_for_ras_deep_convection + long_name = flag for ras convection scheme + units = flag + dimensions = () + type = logical + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F [clw] standard_name = convective_transportable_tracers long_name = array to contain cloud water and other convective trans. tracers @@ -1425,7 +1450,7 @@ optional = F [save_qc] standard_name = cloud_condensed_water_mixing_ratio_save - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) before entering a physics scheme + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -1667,7 +1692,7 @@ optional = F [save_qc] standard_name = cloud_condensed_water_mixing_ratio_save - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) before entering a physics scheme + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -1781,3 +1806,91 @@ type = integer intent = out optional = F + +######################################################################## +[ccpp-arg-table] + name = GFS_suite_interstitial_5_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[levs] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntiw] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in + optional = F +[nn] + standard_name = number_of_tracers_for_convective_transport + long_name = number of tracers for convective transport + units = count + dimensions = () + type = integer + intent = in + optional = F +[gq0] + standard_name = tracer_concentration_updated_by_physics + long_name = tracer concentration updated by physics + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[clw] + standard_name = convective_transportable_tracers + long_name = array to contain cloud water and other convective trans. tracers + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers_for_convective_transport) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index 0060e1a7b..c1ef98ab6 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -11,8 +11,7 @@ module GFS_surface_composites_pre public GFS_surface_composites_pre_init, GFS_surface_composites_pre_finalize, GFS_surface_composites_pre_run - real(kind=kind_phys), parameter :: one = 1.0d0 - real(kind=kind_phys), parameter :: zero = 0.0d0 + real(kind=kind_phys), parameter :: zero = 0.0d0, one = 1.0d0, epsln = 1.0d-10 contains @@ -25,7 +24,8 @@ end subroutine GFS_surface_composites_pre_finalize !> \section arg_table_GFS_surface_composites_pre_run Argument Table !! \htmlinclude GFS_surface_composites_pre_run.html !! - subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, landfrac, lakefrac, oceanfrac, & + subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cplwav2atm, & + landfrac, lakefrac, oceanfrac, & frland, dry, icy, lake, ocean, wet, cice, cimin, zorl, zorlo, zorll, zorl_ocn, & zorl_lnd, zorl_ice, snowd, snowd_ocn, snowd_lnd, snowd_ice, tprcp, tprcp_ocn, & tprcp_lnd, tprcp_ice, uustar, uustar_ocn, uustar_lnd, uustar_ice, & @@ -39,7 +39,7 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, lan ! Interface variables integer, intent(in ) :: im - logical, intent(in ) :: frac_grid, cplflx + logical, intent(in ) :: frac_grid, cplflx, cplwav2atm logical, dimension(im), intent(in ) :: flag_cice logical, dimension(im), intent(inout) :: dry, icy, lake, ocean, wet real(kind=kind_phys), intent(in ) :: cimin @@ -65,45 +65,36 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, lan integer, intent(out) :: errflg ! Local variables - real(kind=kind_phys) :: tem integer :: i ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - if (frac_grid) then ! here cice is fraction of the whole grid that is ice + if (frac_grid) then ! cice is ice fraction wrt water area do i=1,im frland(i) = landfrac(i) if (frland(i) > zero) dry(i) = .true. - tem = one - frland(i) - if (tem > zero) then + if (frland(i) < one) then if (flag_cice(i)) then - if (cice(i) >= min_seaice*tem) then + if (cice(i) >= min_seaice) then icy(i) = .true. else cice(i) = zero endif else - if (cice(i) >= min_lakeice*tem) then + if (cice(i) >= min_lakeice) then icy(i) = .true. - cice(i) = cice(i)/tem ! cice is fraction of ocean/lake else cice(i) = zero endif endif - if (icy(i)) tsfco(i) = max(tsfco(i), tisfc(i), tgice) + if (cice(i) < one ) then + wet(i)=.true. ! some open ocean/lake water exists + if (.not. cplflx) tsfco(i) = max(tsfco(i), tisfc(i), tgice) + end if else cice(i) = zero - endif - - ! ocean/lake area that is not frozen - tem = max(zero, tem - cice(i)) - - if (tem > zero) then - wet(i) = .true. ! there is some open water! -! if (icy(i)) tsfco(i) = max(tsfco(i), tgice) - if (icy(i)) tsfco(i) = max(tisfc(i), tgice) endif enddo @@ -126,6 +117,7 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, lan wet(i) = .true. ! tsfco(i) = tgice if (.not. cplflx) tsfco(i) = max(tisfc(i), tgice) + ! if (.not. cplflx .or. lakefrac(i) > zero) tsfco(i) = max(tsfco(i), tisfc(i), tgice) ! tsfco(i) = max((tsfc(i) - cice(i)*tisfc(i)) & ! / (one - cice(i)), tgice) endif @@ -135,11 +127,16 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, lan endif if (.not. cplflx .or. .not. frac_grid) then - do i=1,im - zorll(i) = zorl(i) - zorlo(i) = zorl(i) - !tisfc(i) = tsfc(i) - enddo + if (cplwav2atm) then + do i=1,im + zorll(i) = zorl(i) + enddo + else + do i=1,im + zorll(i) = zorl(i) + zorlo(i) = zorl(i) + enddo + endif endif do i=1,im @@ -151,8 +148,8 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, lan zorl_ocn(i) = zorlo(i) tsfc_ocn(i) = tsfco(i) tsurf_ocn(i) = tsfco(i) -! weasd_ocn(i) = weasd(i) -! snowd_ocn(i) = snowd(i) +! weasd_ocn(i) = weasd(i) +! snowd_ocn(i) = snowd(i) weasd_ocn(i) = zero snowd_ocn(i) = zero semis_ocn(i) = 0.984d0 @@ -182,13 +179,13 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, lan semis_ice(i) = 0.95d0 qss_ice(i) = qss(i) hflx_ice(i) = hflx(i) - end if + endif enddo ! Assign sea ice temperature to interstitial variable do i = 1, im tice(i) = tisfc(i) - end do + enddo end subroutine GFS_surface_composites_pre_run @@ -217,15 +214,18 @@ end subroutine GFS_surface_composites_inter_finalize !! \htmlinclude GFS_surface_composites_inter_run.html !! subroutine GFS_surface_composites_inter_run (im, dry, icy, wet, semis_ocn, semis_lnd, semis_ice, adjsfcdlw, & - gabsbdlw_lnd, gabsbdlw_ice, gabsbdlw_ocn, errmsg, errflg) + gabsbdlw_lnd, gabsbdlw_ice, gabsbdlw_ocn, & + adjsfcusw, adjsfcdsw, adjsfcnsw, errmsg, errflg) implicit none ! Interface variables integer, intent(in ) :: im logical, dimension(im), intent(in ) :: dry, icy, wet - real(kind=kind_phys), dimension(im), intent(in ) :: semis_ocn, semis_lnd, semis_ice, adjsfcdlw + real(kind=kind_phys), dimension(im), intent(in ) :: semis_ocn, semis_lnd, semis_ice, adjsfcdlw, & + adjsfcdsw, adjsfcnsw real(kind=kind_phys), dimension(im), intent(inout) :: gabsbdlw_lnd, gabsbdlw_ice, gabsbdlw_ocn + real(kind=kind_phys), dimension(im), intent(out) :: adjsfcusw ! CCPP error handling character(len=*), intent(out) :: errmsg @@ -253,12 +253,14 @@ subroutine GFS_surface_composites_inter_run (im, dry, icy, wet, semis_ocn, semis ! - flux below the interface used by lnd/oc/ice models: ! down: sfcemis*adjsfcdlw; up: sfcemis*sigma*T**4 ! net = up - down = sfcemis * (sigma*T**4 - adjsfcdlw) + ! surface upwelling shortwave flux at current time is in adjsfcusw ! --- ... define the downward lw flux absorbed by ground do i=1,im if (dry(i)) gabsbdlw_lnd(i) = semis_lnd(i) * adjsfcdlw(i) if (icy(i)) gabsbdlw_ice(i) = semis_ice(i) * adjsfcdlw(i) if (wet(i)) gabsbdlw_ocn(i) = semis_ocn(i) * adjsfcdlw(i) + adjsfcusw(i) = adjsfcdsw(i) - adjsfcnsw(i) enddo end subroutine GFS_surface_composites_inter_run @@ -276,8 +278,7 @@ module GFS_surface_composites_post public GFS_surface_composites_post_init, GFS_surface_composites_post_finalize, GFS_surface_composites_post_run - real(kind=kind_phys), parameter :: one = 1.0d0 - real(kind=kind_phys), parameter :: zero = 0.0d0 + real(kind=kind_phys), parameter :: zero = 0.0d0, one = 1.0d0 contains @@ -293,7 +294,7 @@ end subroutine GFS_surface_composites_post_finalize !! #endif subroutine GFS_surface_composites_post_run ( & - im, cplflx, frac_grid, flag_cice, islmsk, dry, wet, icy, landfrac, lakefrac, oceanfrac, & + im, cplflx, cplwav2atm, frac_grid, flag_cice, islmsk, dry, wet, icy, landfrac, lakefrac, oceanfrac, & zorl, zorlo, zorll, zorl_ocn, zorl_lnd, zorl_ice, & cd, cd_ocn, cd_lnd, cd_ice, cdq, cdq_ocn, cdq_lnd, cdq_ice, rb, rb_ocn, rb_lnd, rb_ice, stress, stress_ocn, stress_lnd, & stress_ice, ffmm, ffmm_ocn, ffmm_lnd, ffmm_ice, ffhh, ffhh_ocn, ffhh_lnd, ffhh_ice, uustar, uustar_ocn, uustar_lnd, & @@ -306,7 +307,7 @@ subroutine GFS_surface_composites_post_run ( implicit none integer, intent(in) :: im - logical, intent(in) :: cplflx, frac_grid + logical, intent(in) :: cplflx, frac_grid, cplwav2atm logical, dimension(im), intent(in) :: flag_cice, dry, wet, icy integer, dimension(im), intent(in) :: islmsk real(kind=kind_phys), dimension(im), intent(in) :: landfrac, lakefrac, oceanfrac, & @@ -329,8 +330,6 @@ subroutine GFS_surface_composites_post_run ( ! Local variables integer :: i real(kind=kind_phys) :: txl, txi, txo, tem - real(kind=kind_phys), parameter :: one = 1.0d0 - real(kind=kind_phys), parameter :: zero = 0.0d0 ! Initialize CCPP error handling variables errmsg = '' @@ -344,8 +343,8 @@ subroutine GFS_surface_composites_post_run ( ! Three-way composites (fields from sfc_diff) txl = landfrac(i) - txi = cice(i) ! here cice is grid fraction that is ice - txo = one - txl - txi + txi = cice(i)*(one - txl) ! txi = ice fraction wrt whole cell + txo = max(zero, one - txl - txi) zorl(i) = txl*zorl_lnd(i) + txi*zorl_ice(i) + txo*zorl_ocn(i) cd(i) = txl*cd_lnd(i) + txi*cd_ice(i) + txo*cd_ocn(i) @@ -357,17 +356,17 @@ subroutine GFS_surface_composites_post_run ( uustar(i) = txl*uustar_lnd(i) + txi*uustar_ice(i) + txo*uustar_ocn(i) fm10(i) = txl*fm10_lnd(i) + txi*fm10_ice(i) + txo*fm10_ocn(i) fh2(i) = txl*fh2_lnd(i) + txi*fh2_ice(i) + txo*fh2_ocn(i) - !tsurf(i) = txl*tsurf_lnd(i) + txi*tice(i) + txo*tsurf_ocn(i) - !tsurf(i) = txl*tsurf_lnd(i) + txi*tsurf_ice(i) + txo*tsurf_ocn(i) ! not used again! Moorthi + !tsurf(i) = txl*tsurf_lnd(i) + txi*tice(i) + txo*tsurf_ocn(i) + !tsurf(i) = txl*tsurf_lnd(i) + txi*tsurf_ice(i) + txo*tsurf_ocn(i) ! not used again! Moorthi cmm(i) = txl*cmm_lnd(i) + txi*cmm_ice(i) + txo*cmm_ocn(i) chh(i) = txl*chh_lnd(i) + txi*chh_ice(i) + txo*chh_ocn(i) - !gflx(i) = txl*gflx_lnd(i) + txi*gflx_ice(i) + txo*gflx_ocn(i) + !gflx(i) = txl*gflx_lnd(i) + txi*gflx_ice(i) + txo*gflx_ocn(i) ep1d(i) = txl*ep1d_lnd(i) + txi*ep1d_ice(i) + txo*ep1d_ocn(i) - !weasd(i) = txl*weasd_lnd(i) + txi*weasd_ice(i) + txo*weasd_ocn(i) - !snowd(i) = txl*snowd_lnd(i) + txi*snowd_ice(i) + txo*snowd_ocn(i) + !weasd(i) = txl*weasd_lnd(i) + txi*weasd_ice(i) + txo*weasd_ocn(i) + !snowd(i) = txl*snowd_lnd(i) + txi*snowd_ice(i) + txo*snowd_ocn(i) weasd(i) = txl*weasd_lnd(i) + txi*weasd_ice(i) snowd(i) = txl*snowd_lnd(i) + txi*snowd_ice(i) - !tprcp(i) = txl*tprcp_lnd(i) + txi*tprcp_ice(i) + txo*tprcp_ocn(i) + !tprcp(i) = txl*tprcp_lnd(i) + txi*tprcp_ice(i) + txo*tprcp_ocn(i) if (.not. flag_cice(i) .and. islmsk(i) == 2) then tem = one - txl @@ -376,16 +375,12 @@ subroutine GFS_surface_composites_post_run ( qss(i) = txl*qss_lnd(i) + tem*qss_ice(i) gflx(i) = txl*gflx_lnd(i) + tem*gflx_ice(i) else - evap(i) = txl*evap_lnd(i) + tem*evap_ice(i) + txo*evap_ocn(i) - hflx(i) = txl*hflx_lnd(i) + tem*hflx_ice(i) + txo*hflx_ocn(i) - qss(i) = txl*qss_lnd(i) + tem*qss_ice(i) + txo*qss_ocn(i) - gflx(i) = txl*gflx_lnd(i) + tem*gflx_ice(i) + txo*gflx_ocn(i) + evap(i) = txl*evap_lnd(i) + txi*evap_ice(i) + txo*evap_ocn(i) + hflx(i) = txl*hflx_lnd(i) + txi*hflx_ice(i) + txo*hflx_ocn(i) + qss(i) = txl*qss_lnd(i) + txi*qss_ice(i) + txo*qss_ocn(i) + gflx(i) = txl*gflx_lnd(i) + txi*gflx_ice(i) + txo*gflx_ocn(i) endif tsfc(i) = txl*tsfc_lnd(i) + txi*tice(i) + txo*tsfc_ocn(i) - !tsfc(i) = txl*tsfc_lnd(i) + txi*tsfc_ice(i) + txo*tsfc_ocn(i) - - ! DH* NOTE THIS IS UNNECESSARY BECAUSE DONE BEFORE? Diag%cmm(i) = txl*cmm3(i,1) + txi*cmm3(i,2) + txo*cmm3(i,3) - ! DH* NOTE THIS IS UNNECESSARY BECAUSE DONE BEFORE? Diag%chh(i) = txl*chh3(i,1) + txi*chh3(i,2) + txo*chh3(i,3) zorll(i) = zorl_lnd(i) zorlo(i) = zorl_ocn(i) @@ -403,12 +398,6 @@ subroutine GFS_surface_composites_post_run ( if (.not. flag_cice(i)) then if (islmsk(i) == 2) then ! return updated lake ice thickness & concentration to global array - ! DH* NOT NEEDED? Sfcprop%hice(i) = zice(i) -! DH* is this correct? can we update cice in place or do we need separate variables as for IPD? -!! Sfcprop%fice(i) = fice(i) * Sfcprop%lakefrac(i) ! fice is fraction of lake area that is frozen -! Sfcprop%fice(i) = fice(i) * (one-Sfcprop%landfrac(i)) ! fice is fraction of wet area that is frozen - cice(i) = cice(i) * (1.0-landfrac(i)) ! cice is fraction of wet area that is frozen -! *DH tisfc(i) = tice(i) else ! this would be over open ocean or land (no ice fraction) hice(i) = zero @@ -432,21 +421,22 @@ subroutine GFS_surface_composites_post_run ( uustar(i) = uustar_lnd(i) fm10(i) = fm10_lnd(i) fh2(i) = fh2_lnd(i) - !tsurf(i) = tsurf_lnd(i) - tsfcl(i) = tsfc_lnd(i) + !tsurf(i) = tsurf_lnd(i) + tsfcl(i) = tsfc_lnd(i) ! over land cmm(i) = cmm_lnd(i) chh(i) = chh_lnd(i) gflx(i) = gflx_lnd(i) ep1d(i) = ep1d_lnd(i) weasd(i) = weasd_lnd(i) snowd(i) = snowd_lnd(i) - !tprcp(i) = tprcp_lnd(i) + !tprcp(i) = tprcp_lnd(i) evap(i) = evap_lnd(i) hflx(i) = hflx_lnd(i) qss(i) = qss_lnd(i) tsfc(i) = tsfc_lnd(i) - cmm(i) = cmm_lnd(i) - chh(i) = chh_lnd(i) + !hice(i) = zero + !cice(i) = zero + !tisfc(i) = tsfc(i) elseif (islmsk(i) == 0) then zorl(i) = zorl_ocn(i) cd(i) = cd_ocn(i) @@ -458,22 +448,24 @@ subroutine GFS_surface_composites_post_run ( uustar(i) = uustar_ocn(i) fm10(i) = fm10_ocn(i) fh2(i) = fh2_ocn(i) - !tsurf(i) = tsurf_ocn(i) - tsfco(i) = tsfc_ocn(i) + !tsurf(i) = tsurf_ocn(i) + tsfco(i) = tsfc_ocn(i) ! over lake (and ocean when uncoupled) + if( cplflx ) tsfcl(i) = tsfc_ocn(i) ! for restart repro comparisons cmm(i) = cmm_ocn(i) chh(i) = chh_ocn(i) gflx(i) = gflx_ocn(i) ep1d(i) = ep1d_ocn(i) weasd(i) = weasd_ocn(i) snowd(i) = snowd_ocn(i) - !tprcp(i) = tprcp_ocn(i) + !tprcp(i) = tprcp_ocn(i) evap(i) = evap_ocn(i) hflx(i) = hflx_ocn(i) qss(i) = qss_ocn(i) tsfc(i) = tsfc_ocn(i) - cmm(i) = cmm_ocn(i) - chh(i) = chh_ocn(i) - else + !hice(i) = zero + !cice(i) = zero + !tisfc(i) = tsfc(i) + else ! islmsk(i) == 2 zorl(i) = zorl_ice(i) cd(i) = cd_ice(i) cdq(i) = cdq_ice(i) @@ -484,9 +476,9 @@ subroutine GFS_surface_composites_post_run ( uustar(i) = uustar_ice(i) fm10(i) = fm10_ice(i) fh2(i) = fh2_ice(i) - !tsurf(i) = tsurf_ice(i) + !tsurf(i) = tsurf_ice(i) if (.not. flag_cice(i)) then - tisfc(i) = tice(i) + tisfc(i) = tice(i) ! over lake ice (and sea ice when uncoupled) endif cmm(i) = cmm_ice(i) chh(i) = chh_ice(i) @@ -494,39 +486,37 @@ subroutine GFS_surface_composites_post_run ( ep1d(i) = ep1d_ice(i) weasd(i) = weasd_ice(i) snowd(i) = snowd_ice(i) - !tprcp(i) = cice(i)*tprcp_ice(i) + (one-cice(i))*tprcp_ocn(i) + !tprcp(i) = cice(i)*tprcp_ice(i) + (one-cice(i))*tprcp_ocn(i) + qss(i) = qss_ice(i) evap(i) = evap_ice(i) hflx(i) = hflx_ice(i) qss(i) = qss_ice(i) tsfc(i) = tsfc_ice(i) - cmm(i) = cmm_ice(i) - chh(i) = chh_ice(i) + if( cplflx ) tsfcl(i) = tsfc_ice(i) endif zorll(i) = zorl_lnd(i) zorlo(i) = zorl_ocn(i) - if (flag_cice(i)) then ! this was already done for lake ice in sfc_sice + if (flag_cice(i) .and. wet(i)) then ! this was already done for lake ice in sfc_sice txi = cice(i) txo = one - txi evap(i) = txi * evap_ice(i) + txo * evap_ocn(i) hflx(i) = txi * hflx_ice(i) + txo * hflx_ocn(i) -! tsfc(i) = txi * tice(i) + txo * tsfc_ocn(i) tsfc(i) = txi * tsfc_ice(i) + txo * tsfc_ocn(i) - else ! return updated lake ice thickness & concentration to global array + else if (islmsk(i) == 2) then - ! DH* NOT NEEDED ???? Sfcprop%hice(i) = zice(i) - ! DH* NOT NEEDED ???? cice(i) = fice(i) ! fice is fraction of lake area that is frozen tisfc(i) = tice(i) - else ! this would be over open ocean or land (no ice fraction) + else ! over open ocean or land (no ice fraction) hice(i) = zero cice(i) = zero tisfc(i) = tsfc(i) endif endif - end do - end if ! if (frac_grid) + enddo + + endif ! if (frac_grid) ! --- compositing done diff --git a/physics/GFS_surface_composites.meta b/physics/GFS_surface_composites.meta index bf613e160..d21747122 100644 --- a/physics/GFS_surface_composites.meta +++ b/physics/GFS_surface_composites.meta @@ -33,6 +33,14 @@ type = logical intent = in optional = F +[cplwav2atm] + standard_name = flag_for_wave_coupling_to_atm + long_name = flag controlling ocean wave coupling to the atmosphere (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F [landfrac] standard_name = land_area_fraction long_name = fraction of horizontal grid area occupied by land @@ -711,6 +719,33 @@ kind = kind_phys intent = inout optional = F +[adjsfcdsw] + standard_name = surface_downwelling_shortwave_flux + long_name = surface downwelling shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[adjsfcnsw] + standard_name = surface_net_downwelling_shortwave_flux + long_name = surface net downwelling shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[adjsfcusw] + standard_name = surface_upwelling_shortwave_flux + long_name = surface upwelling shortwave flux at current time + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -749,6 +784,14 @@ type = logical intent = in optional = F +[cplwav2atm] + standard_name = flag_for_wave_coupling_to_atm + long_name = flag controlling ocean wave coupling to the atmosphere (default off) + units = flag + dimensions = () + type = logical + intent = in + optional = F [frac_grid] standard_name = flag_for_fractional_grid long_name = flag for fractional grid diff --git a/physics/GFS_surface_generic.F90 b/physics/GFS_surface_generic.F90 index 104d57f07..30a29d393 100644 --- a/physics/GFS_surface_generic.F90 +++ b/physics/GFS_surface_generic.F90 @@ -27,13 +27,11 @@ end subroutine GFS_surface_generic_pre_finalize !! subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, stype, vtype, slope, & prsik_1, prslk_1, tsfc, phil, con_g, & - sigmaf, soiltyp, vegtype, slopetyp, work3, tsurf, zlvl, do_sppt, dtdtr, & + sigmaf, soiltyp, vegtype, slopetyp, work3, tsurf, zlvl, do_sppt, ca_global,dtdtr,& drain_cpl, dsnow_cpl, rain_cpl, snow_cpl, do_sfcperts, nsfcpert, sfc_wts, & pertz0, pertzt, pertshc, pertlai, pertvegf, z01d, zt1d, bexp1d, xlai1d, vegf1d, & - cplflx, flag_cice, islmsk_cice,slimskin_cpl, dusfcin_cpl, dvsfcin_cpl, & - dtsfcin_cpl, dqsfcin_cpl, ulwsfcin_cpl, ulwsfc_cice, dusfc_cice, dvsfc_cice, & - dtsfc_cice, dqsfc_cice, tisfc, tsfco, fice, hice, dry, icy, wet, & - wind, u1, v1, cnvwind, errmsg, errflg) + cplflx, flag_cice, islmsk_cice, slimskin_cpl, tisfc, tsfco, fice, hice, & + wind, u1, v1, cnvwind, smcwlt2, smcref2, errmsg, errflg) use surface_perturbation, only: cdfnor @@ -43,7 +41,6 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, integer, intent(in) :: im, levs, isot, ivegsrc integer, dimension(im), intent(in) :: islmsk integer, dimension(im), intent(inout) :: soiltyp, vegtype, slopetyp - logical, dimension(im), intent(in) :: dry, icy, wet real(kind=kind_phys), intent(in) :: con_g real(kind=kind_phys), dimension(im), intent(in) :: vfrac, stype, vtype, slope, prsik_1, prslk_1 @@ -54,7 +51,7 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, real(kind=kind_phys), dimension(im), intent(inout) :: sigmaf, work3, tsurf, zlvl ! Stochastic physics / surface perturbations - logical, intent(in) :: do_sppt + logical, intent(in) :: do_sppt, ca_global real(kind=kind_phys), dimension(im,levs), intent(out) :: dtdtr real(kind=kind_phys), dimension(im), intent(out) :: drain_cpl real(kind=kind_phys), dimension(im), intent(out) :: dsnow_cpl @@ -77,17 +74,16 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, logical, intent(in) :: cplflx real(kind=kind_phys), dimension(im), intent(in) :: slimskin_cpl logical, dimension(im), intent(inout) :: flag_cice - integer, dimension(im), intent(out) :: islmsk_cice - real(kind=kind_phys), dimension(im), intent(in) ::ulwsfcin_cpl, & - dusfcin_cpl, dvsfcin_cpl, dtsfcin_cpl, dqsfcin_cpl, & + integer, dimension(im), intent(out) :: islmsk_cice + real(kind=kind_phys), dimension(im), intent(in) :: & tisfc, tsfco, fice, hice - real(kind=kind_phys), dimension(im), intent(out) ::ulwsfc_cice, & - dusfc_cice, dvsfc_cice, dtsfc_cice, dqsfc_cice real(kind=kind_phys), dimension(im), intent(out) :: wind real(kind=kind_phys), dimension(im), intent(in ) :: u1, v1 ! surface wind enhancement due to convection - real(kind=kind_phys), dimension(im), intent(in ) :: cnvwind + real(kind=kind_phys), dimension(im), intent(inout ) :: cnvwind + ! + real(kind=kind_phys), dimension(im), intent(out) :: smcwlt2, smcref2 ! CCPP error handling character(len=*), intent(out) :: errmsg @@ -106,12 +102,8 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, errflg = 0 ! Set initial quantities for stochastic physics deltas - if (do_sppt) then + if (do_sppt .or. ca_global) then dtdtr = 0.0 - do i=1,im - drain_cpl(i) = rain_cpl (i) - dsnow_cpl(i) = snow_cpl (i) - enddo endif ! Scale random patterns for surface perturbations with perturbation size @@ -119,8 +111,8 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, if (do_sfcperts) then if (pertz0(1) > 0.) then z01d(:) = pertz0(1) * sfc_wts(:,1) - ! if (me == 0) print*,'sfc_wts(:,1) min and max',minval(sfc_wts(:,1)),maxval(sfc_wts(:,1)) - ! if (me == 0) print*,'z01d min and max ',minval(z01d),maxval(z01d) +! if (me == 0) print*,'sfc_wts(:,1) min and max',minval(sfc_wts(:,1)),maxval(sfc_wts(:,1)) +! if (me == 0) print*,'z01d min and max ',minval(z01d),maxval(z01d) endif if (pertzt(1) > 0.) then zt1d(:) = pertzt(1) * sfc_wts(:,2) @@ -131,13 +123,13 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, if (pertlai(1) > 0.) then xlai1d(:) = pertlai(1) * sfc_wts(:,4) endif - ! --- do the albedo percentile calculation in GFS_radiation_driver instead --- ! - ! if (pertalb(1) > 0.) then - ! do i=1,im - ! call cdfnor(sfc_wts(i,5),cdfz) - ! alb1d(i) = cdfz - ! enddo - ! endif +! --- do the albedo percentile calculation in GFS_radiation_driver instead --- ! +! if (pertalb(1) > 0.) then +! do i=1,im +! call cdfnor(sfc_wts(i,5),cdfz) +! alb1d(i) = cdfz +! enddo +! endif if (pertvegf(1) > 0.) then do i=1,im call cdfnor(sfc_wts(i,6),cdfz) @@ -172,31 +164,25 @@ subroutine GFS_surface_generic_pre_run (im, levs, vfrac, islmsk, isot, ivegsrc, endif work3(i) = prsik_1(i) / prslk_1(i) - end do - do i=1,im !tsurf(i) = tsfc(i) - zlvl(i) = phil(i,1) * onebg + zlvl(i) = phil(i,1) * onebg + smcwlt2(i) = zero + smcref2(i) = zero + wind(i) = max(sqrt(u1(i)*u1(i) + v1(i)*v1(i)) & + max(zero, min(cnvwind(i), 30.0)), one) !wind(i) = max(sqrt(Statein%ugrs(i,1)*Statein%ugrs(i,1) + & ! Statein%vgrs(i,1)*Statein%vgrs(i,1)) & ! + max(zero, min(Tbd%phy_f2d(i,Model%num_p2d), 30.0)), one) - end do + cnvwind(i) = zero + enddo if (cplflx) then do i=1,im islmsk_cice(i) = nint(slimskin_cpl(i)) flag_cice(i) = (islmsk_cice(i) == 4) - - if (flag_cice(i)) then -! ulwsfc_cice(i) = ulwsfcin_cpl(i) - dusfc_cice(i) = dusfcin_cpl(i) - dvsfc_cice(i) = dvsfcin_cpl(i) - dtsfc_cice(i) = dtsfcin_cpl(i) - dqsfc_cice(i) = dqsfcin_cpl(i) - endif enddo endif @@ -215,8 +201,7 @@ module GFS_surface_generic_post public GFS_surface_generic_post_init, GFS_surface_generic_post_finalize, GFS_surface_generic_post_run - real(kind=kind_phys), parameter :: one = 1.0d0 - real(kind=kind_phys), parameter :: zero = 0.0d0 + real(kind=kind_phys), parameter :: zero = 0.0, one = 1.0d0 contains @@ -236,7 +221,8 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dt dvisdfi_cpl, dnirbm_cpl, dnirdf_cpl, dvisbm_cpl, dvisdf_cpl, nlwsfci_cpl, nlwsfc_cpl, t2mi_cpl, q2mi_cpl, u10mi_cpl, & v10mi_cpl, tsfci_cpl, psurfi_cpl, nnirbmi_cpl, nnirdfi_cpl, nvisbmi_cpl, nvisdfi_cpl, nswsfci_cpl, nswsfc_cpl, nnirbm_cpl, & nnirdf_cpl, nvisbm_cpl, nvisdf_cpl, gflux, evbsa, evcwa, transa, sbsnoa, snowca, snohfa, ep, & - runoff, srunoff, runof, drain, errmsg, errflg) + runoff, srunoff, runof, drain, lheatstrg, z0fac, e0fac, zorl, hflx, evap, hflxq, evapq, hffac, hefac, & + errmsg, errflg) implicit none @@ -258,31 +244,47 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dt real(kind=kind_phys), dimension(im), intent(inout) :: runoff, srunoff real(kind=kind_phys), dimension(im), intent(in) :: drain, runof + ! For canopy heat storage + logical, intent(in) :: lheatstrg + real(kind=kind_phys), intent(in) :: z0fac, e0fac + real(kind=kind_phys), dimension(im), intent(in) :: zorl + real(kind=kind_phys), dimension(im), intent(in) :: hflx, evap + real(kind=kind_phys), dimension(im), intent(out) :: hflxq, evapq + real(kind=kind_phys), dimension(im), intent(out) :: hffac, hefac + + ! CCPP error handling variables character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg + ! Local variables + real(kind=kind_phys), parameter :: albdf = 0.06d0 + ! Parameters for canopy heat storage parametrization + real(kind=kind_phys), parameter :: z0min=0.2, z0max=1.0 + real(kind=kind_phys), parameter :: u10min=2.5, u10max=7.5 + integer :: i real(kind=kind_phys) :: xcosz_loc, ocalnirdf_cpl, ocalnirbm_cpl, ocalvisdf_cpl, ocalvisbm_cpl + real(kind=kind_phys) :: tem, tem1, tem2 ! Initialize CCPP error handling variables errmsg = '' errflg = 0 do i=1,im - epi(i) = ep1d(i) - gfluxi(i) = gflx(i) - t1(i) = tgrs_1(i) - q1(i) = qgrs_1(i) - u1(i) = ugrs_1(i) - v1(i) = vgrs_1(i) + epi(i) = ep1d(i) + gfluxi(i) = gflx(i) + t1(i) = tgrs_1(i) + q1(i) = qgrs_1(i) + u1(i) = ugrs_1(i) + v1(i) = vgrs_1(i) enddo if (cplflx .or. cplwav) then do i=1,im - u10mi_cpl (i) = u10m(i) - v10mi_cpl (i) = v10m(i) + u10mi_cpl(i) = u10m(i) + v10mi_cpl(i) = v10m(i) enddo endif @@ -307,8 +309,8 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dt nlwsfc_cpl (i) = nlwsfc_cpl(i) + nlwsfci_cpl(i)*dtf t2mi_cpl (i) = t2m(i) q2mi_cpl (i) = q2m(i) -! tsfci_cpl (i) = tsfc(i) - tsfci_cpl (i) = tsfc_ocn(i) + tsfci_cpl (i) = tsfc(i) +! tsfci_cpl (i) = tsfc_ocn(i) psurfi_cpl (i) = pgr(i) enddo @@ -369,6 +371,35 @@ subroutine GFS_surface_generic_post_run (im, cplflx, cplwav, lssav, icy, wet, dt enddo endif +! --- ... Boundary Layer and Free atmospheic turbulence parameterization +! +! in order to achieve heat storage within canopy layer, in the canopy heat +! storage parameterization the kinematic sensible and latent heat fluxes +! (hflx & evap) as surface boundary forcings to the pbl scheme are +! reduced as a function of surface roughness +! + do i=1,im + hflxq(i) = hflx(i) + evapq(i) = evap(i) + hffac(i) = 1.0 + hefac(i) = 1.0 + enddo + if (lheatstrg) then + do i=1,im + tem = 0.01 * zorl(i) ! change unit from cm to m + tem1 = (tem - z0min) / (z0max - z0min) + hffac(i) = z0fac * min(max(tem1, 0.0), 1.0) + tem = sqrt(u10m(i)**2+v10m(i)**2) + tem1 = (tem - u10min) / (u10max - u10min) + tem2 = 1.0 - min(max(tem1, 0.0), 1.0) + hffac(i) = tem2 * hffac(i) + hefac(i) = 1. + e0fac * hffac(i) + hffac(i) = 1. + hffac(i) + hflxq(i) = hflx(i) / hffac(i) + evapq(i) = evap(i) / hefac(i) + enddo + endif + end subroutine GFS_surface_generic_post_run end module GFS_surface_generic_post diff --git a/physics/GFS_surface_generic.meta b/physics/GFS_surface_generic.meta index bccfa4e38..10a060bc3 100644 --- a/physics/GFS_surface_generic.meta +++ b/physics/GFS_surface_generic.meta @@ -190,6 +190,14 @@ type = logical intent = in optional = F +[ca_global] + standard_name = flag_for_global_cellular_automata + long_name = switch for global ca + units = flag + dimensions = () + type = logical + intent = in + optional = F [dtdtr] standard_name = tendency_of_air_temperature_due_to_radiative_heating_on_physics_time_step long_name = temp. change due to radiative heating per time step @@ -383,96 +391,6 @@ kind = kind_phys intent = in optional = F -[dusfcin_cpl] - standard_name = surface_x_momentum_flux_for_coupling - long_name = sfc x momentum flux for coupling - units = Pa - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dvsfcin_cpl] - standard_name = surface_y_momentum_flux_for_coupling - long_name = sfc y momentum flux for coupling - units = Pa - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dtsfcin_cpl] - standard_name = surface_upward_sensible_heat_flux_for_coupling - long_name = sfc sensible heat flux input - units = W m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[dqsfcin_cpl] - standard_name = surface_upward_latent_heat_flux_for_coupling - long_name = sfc latent heat flux input for coupling - units = W m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[ulwsfcin_cpl] - standard_name = surface_upwelling_longwave_flux_for_coupling - long_name = surface upwelling LW flux for coupling - units = W m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[ulwsfc_cice] - standard_name = surface_upwelling_longwave_flux_for_coupling_interstitial - long_name = surface upwelling longwave flux for coupling interstitial - units = W m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[dusfc_cice] - standard_name = surface_x_momentum_flux_for_coupling_interstitial - long_name = sfc x momentum flux for coupling interstitial - units = Pa - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[dvsfc_cice] - standard_name = surface_y_momentum_flux_for_coupling_interstitial - long_name = sfc y momentum flux for coupling interstitial - units = Pa - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[dtsfc_cice] - standard_name = surface_upward_sensible_heat_flux_for_coupling_interstitial - long_name = sfc sensible heat flux for coupling interstitial - units = W m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[dqsfc_cice] - standard_name = surface_upward_latent_heat_flux_for_coupling_interstitial - long_name = sfc latent heat flux for coupling interstitial - units = W m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F [tisfc] standard_name = sea_ice_temperature long_name = sea-ice surface temperature @@ -509,30 +427,6 @@ kind = kind_phys intent = in optional = F -[dry] - standard_name = flag_nonzero_land_surface_fraction - long_name = flag indicating presence of some land surface area fraction - units = flag - dimensions = (horizontal_dimension) - type = logical - intent = in - optional = F -[icy] - standard_name = flag_nonzero_sea_ice_surface_fraction - long_name = flag indicating presence of some sea ice surface area fraction - units = flag - dimensions = (horizontal_dimension) - type = logical - intent = in - optional = F -[wet] - standard_name = flag_nonzero_wet_surface_fraction - long_name = flag indicating presence of some ocean or lake surface area fraction - units = flag - dimensions = (horizontal_dimension) - type = logical - intent = in - optional = F [wind] standard_name = wind_speed_at_lowest_model_layer long_name = wind speed at lowest model level @@ -567,7 +461,25 @@ dimensions = (horizontal_dimension) type = real kind = kind_phys - intent = in + intent = inout + optional = F +[smcwlt2] + standard_name = volume_fraction_of_condensed_water_in_soil_at_wilting_point + long_name = wilting point (volumetric) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[smcref2] + standard_name = threshold_volume_fraction_of_condensed_water_in_soil + long_name = soil moisture threshold (volumetric) + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out optional = F [errmsg] standard_name = ccpp_error_message @@ -1368,6 +1280,95 @@ kind = kind_phys intent = in optional = F +[lheatstrg] + standard_name = flag_for_canopy_heat_storage + long_name = flag for canopy heat storage parameterization + units = flag + dimensions = () + type = logical + intent = in + optional = F +[z0fac] + standard_name = surface_roughness_fraction_factor + long_name = surface roughness fraction factor for canopy heat storage parameterization + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[e0fac] + standard_name = latent_heat_flux_fraction_factor_relative_to_sensible_heat_flux + long_name = latent heat flux fraction factor relative to sensible heat flux for canopy heat storage parameterization + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hflx] + standard_name = kinematic_surface_upward_sensible_heat_flux + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hflxq] + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward sensible heat flux reduced by surface roughness + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[evapq] + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward latent heat flux reduced by surface roughness + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[hefac] + standard_name = surface_upward_latent_heat_flux_reduction_factor + long_name = surface upward latent heat flux reduction factor from canopy heat storage + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[hffac] + standard_name = surface_upward_sensible_heat_flux_reduction_factor + long_name = surface upward sensible heat flux reduction factor from canopy heat storage + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/aerclm_def.F b/physics/aerclm_def.F index ec2366b43..84852a1de 100644 --- a/physics/aerclm_def.F +++ b/physics/aerclm_def.F @@ -1,28 +1,23 @@ -!>\file aerclm_def.F -!! This file contains aerosol climatology definition in MG microphysics - -!>\ingroup mod_GFS_phys_time_vary -!! This module defines aerosol arrays in MG microphysics. module aerclm_def use machine , only : kind_phys implicit none -! only read monthly merra2 data for m-1, m, m+1 - integer, parameter :: levsaer=45, latsaer=91, lonsaer=144 - integer, parameter :: lmerra=72, ntrcaerm=15, timeaer=12 + integer, parameter :: levsaer=50, ntrcaerm=15, timeaer=12 + integer :: latsaer, lonsaer, ntrcaer - integer :: ntrcaer character*10 :: specname(ntrcaerm) - real (kind=kind_phys):: aer_lat(latsaer), aer_lon(lonsaer) - & ,aer_time(13) - real (kind=4), allocatable, dimension(:,:,:,:,:) :: aerin + real (kind=kind_phys):: aer_time(13) + + real (kind=kind_phys), allocatable, dimension(:) :: aer_lat + real (kind=kind_phys), allocatable, dimension(:) :: aer_lon real (kind=kind_phys), allocatable, dimension(:,:,:,:) :: aer_pres + real (kind=kind_phys), allocatable, dimension(:,:,:,:,:) :: aerin data aer_time/15.5, 45., 74.5, 105., 135.5, 166., 196.5, & 227.5, 258., 288.5, 319., 349.5, 380.5/ data specname /'DU001','DU002','DU003','DU004','DU005', & 'SS001','SS002','SS003','SS004','SS005','SO4', - & 'BCPHOBIC','BCPHILIC','OCPHILIC','OCPHOBIC'/ + & 'BCPHOBIC','BCPHILIC','OCPHOBIC','OCPHILIC'/ end module aerclm_def diff --git a/physics/aerinterp.F90 b/physics/aerinterp.F90 index d47baacc9..e7cd6ca20 100644 --- a/physics/aerinterp.F90 +++ b/physics/aerinterp.F90 @@ -3,7 +3,7 @@ !! aerosol data for MG microphysics. !>\ingroup mod_GFS_phys_time_vary -!! This module contain subroutines of reading and interpolating +!! This module contain subroutines of reading and interpolating !! aerosol data for MG microphysics. module aerinterp @@ -15,168 +15,189 @@ module aerinterp contains - SUBROUTINE read_aerdata (me, master, iflip, idate ) - - use machine, only: kind_phys + SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) + use machine, only: kind_phys, kind_io4, kind_io8 use aerclm_def use netcdf !--- in/out integer, intent(in) :: me, master, iflip, idate(4) + character(len=*), intent(inout) :: errmsg + integer, intent(inout) :: errflg !--- locals - integer :: ncid, varid - integer :: i, j, k, n, ii, ijk, imon, klev - character :: fname*50, mn*2, fldname*10 + integer :: ncid, varid, ndims, dim1, dim2, dim3, hmx + integer :: i, j, k, n, ii, imon, klev + character :: fname*50, mn*2, vname*10 logical :: file_exist - real(kind=4), allocatable, dimension(:,:,:) :: ps_clm - real(kind=4), allocatable, dimension(:,:,:,:) :: delp_clm - real(kind=4), allocatable, dimension(:,:,:,:) :: aer_clm - real(kind=4), allocatable, dimension(:,:,:,:) :: airden_clm - real(kind=4), allocatable, dimension(:) :: pres_tmp - - allocate (delp_clm(lonsaer,latsaer,lmerra,1)) - allocate (aer_clm(lonsaer,latsaer,lmerra,1)) - allocate (airden_clm(lonsaer,latsaer,lmerra,1)) - allocate (ps_clm(lonsaer,latsaer,1)) - allocate (pres_tmp(lmerra)) - -! allocate aerclm_def arrays: aerin and aer_pres - allocate (aerin(lonsaer,latsaer,levsaer,ntrcaer,timeaer)) - allocate (aer_pres(lonsaer,latsaer,levsaer,timeaer)) + integer, allocatable :: invardims(:) + real(kind=kind_io4),allocatable,dimension(:,:,:) :: buff + real(kind=kind_io4),allocatable,dimension(:,:,:,:):: buffx + real(kind=kind_io4),allocatable,dimension(:,:) :: pres_tmp + real(kind=kind_io8),allocatable,dimension(:) :: aer_lati + real(kind=kind_io8),allocatable,dimension(:) :: aer_loni +! +!! =================================================================== if (me == master) then if ( iflip == 0 ) then ! data from toa to sfc - print *, "EJ, GFS is top-down" + print *, "GFS is top-down" else - print *, "EJ, GFS is bottom-up" + print *, "GFS is bottom-up" endif endif +! +!! =================================================================== +!! fetch dim spec and lat/lon from m01 data set +!! =================================================================== + fname=trim("aeroclim.m"//'01'//".nc") + inquire (file = fname, exist = file_exist) + if (.not. file_exist) then + errmsg = 'Error in read_aerdata: file ' // trim(fname) // ' not found' + errflg = 1 + return + endif + call nf_open(fname , nf90_NOWRITE, ncid) - do imon = 1, timeaer - !ijk = imon + idate(2)+int(idate(3)/16)-2 - !if ( ijk .le. 0 ) ijk = 12 - !if ( ijk .eq. 13 ) ijk = 1 - !if ( ijk .eq. 14 ) ijk = 2 - write(mn,'(i2.2)') imon - fname=trim("merra2C.aerclim.2003-2014.m"//mn//".nc") - if (me == master) print *, "EJ,aerosol climo:", fname, & - "for imon:",imon,idate + vname = trim(specname(1)) + call nf_inq_varid(ncid, vname, varid) + call nf_inq_varndims(ncid, varid, ndims) - inquire (file = fname, exist = file_exist) - if ( file_exist ) then - if (me == master) print *, & - "EJ, aerosol climo found; proceed the run" - else - print *,"EJ, Error! aerosol climo not found; abort the run" - stop 555 - endif + if(.not. allocated(invardims)) allocate(invardims(3)) + call nf_inq_vardimid(ncid,varid,invardims) + call nf_inq_dimlen(ncid, invardims(1), dim1) + call nf_inq_dimlen(ncid, invardims(2), dim2) + call nf_inq_dimlen(ncid, invardims(3), dim3) - call nf_open(fname, NF90_NOWRITE, ncid) +! specify latsaer, lonsaer, hmx + lonsaer = dim1 + latsaer = dim2 + hmx = int(dim1/2) ! to swap long from W-E to E-W -! merra2 data is top down -! for GFS, iflip 0: toa to sfc; 1: sfc to toa + if(me==master) then + print *, 'MERRA2 dim: ',dim1, dim2, dim3 + endif -! read aerosol mixing ratio arrays (kg/kg) -! construct 4-d aerosol mass concentration (kg/m3) - call nf_inq_varid(ncid, 'AIRDENS', varid) - call nf_get_var(ncid, varid, airden_clm) -! if(me==master) print *, "EJ, read airdens", airden_clm(1,1,:,1) - - do ii = 1, ntrcaer - fldname=specname(ii) - call nf_inq_varid(ncid, fldname, varid) - call nf_get_var(ncid, varid, aer_clm) -! if(me==master) print *, "EJ, read ", fldname, aer_clm(1,1,:,1) - do i = 1, lonsaer - do j = 1, latsaer - do k = 1, levsaer -! input is from toa to sfc - if ( iflip == 0 ) then ! data from toa to sfc - klev = k - else ! data from sfc to top - klev = ( lmerra - k ) + 1 - endif - aerin(i,j,k,ii,imon) = aer_clm(i,j,klev,1)*airden_clm(i,j,klev,1) - enddo !k-loop (lev) - enddo !j-loop (lat) - enddo !i-loop (lon) - enddo !ii-loop (ntrac) +! allocate arrays + if (.not. allocated(aer_loni)) then + allocate (aer_loni(lonsaer)) + allocate (aer_lati(latsaer)) + endif -! aer_clm is top-down (following MERRA2) -! aerin is bottom-up (following GFS) + if (.not. allocated(aer_lat)) then + allocate(aer_lat(latsaer)) + allocate(aer_lon(lonsaer)) + allocate(aerin(lonsaer,latsaer,levsaer,ntrcaerm,timeaer)) + allocate(aer_pres(lonsaer,latsaer,levsaer,timeaer)) + endif -! if ( imon == 1 .and. me == master ) then -! print *, 'EJ, du1(1,1) :', aerin(1,1,:,1,imon) -! endif +! construct lat/lon array + call nf_inq_varid(ncid, 'lat', varid) + call nf_get_var(ncid, varid, aer_lati) + call nf_inq_varid(ncid, 'lon', varid) + call nf_get_var(ncid, varid, aer_loni) + + do i = 1, hmx ! flip from (-180,180) to (0,360) + if(aer_loni(i)<0.) aer_loni(i)=aer_loni(i)+360. + aer_lon(i+hmx) = aer_loni(i) + aer_lon(i) = aer_loni(i+hmx) + enddo -! construct 3-d pressure array (Pa) - call nf_inq_varid(ncid, "PS", varid) - call nf_get_var(ncid, varid, ps_clm) - call nf_inq_varid(ncid, "DELP", varid) - call nf_get_var(ncid, varid, delp_clm) + do i = 1, latsaer + aer_lat(i) = aer_lati(i) + enddo -! if ( imon == 1 .and. me == master ) then -! print *, 'EJ, ps_clm:', ps_clm(1,1,1) -! print *, 'EJ, delp_clm:', delp_clm(1,1,:,1) -! endif + call nf_close(ncid) - do i = 1, lonsaer - do j = 1, latsaer +! allocate local working arrays + if (.not. allocated(buff)) then + allocate (buff(lonsaer, latsaer, dim3)) + allocate (pres_tmp(lonsaer,dim3)) + endif + if (.not. allocated(buffx)) then + allocate (buffx(lonsaer, latsaer, dim3,1)) + endif -! constract pres_tmp (top-down) - pres_tmp(1) = 0. - do k=2, lmerra - pres_tmp(k) = pres_tmp(k-1) + delp_clm(i,j,k,1) - enddo -! if (imon==1 .and. me==master .and. i==1 .and. j==1 ) then -! print *, 'EJ, pres_tmp:', pres_tmp(:) -! endif +!! =================================================================== +!! loop thru m01 - m12 for aer/pres array +!! =================================================================== + do imon = 1, timeaer + write(mn,'(i2.2)') imon + fname=trim("aeroclim.m"//mn//".nc") + inquire (file = fname, exist = file_exist) + if (.not. file_exist) then + errmsg = 'Error in read_aerdata: file ' // trim(fname) // ' not found' + errflg = 1 + return + endif + + call nf_open(fname , nf90_NOWRITE, ncid) + +! ====> construct 3-d pressure array (Pa) + call nf_inq_varid(ncid, "DELP", varid) + call nf_get_var(ncid, varid, buff) + + do j = 1, latsaer + do i = 1, lonsaer +! constract pres_tmp (top-down), note input is top-down + pres_tmp(i,1) = 0. + do k=2, dim3 + pres_tmp(i,k) = pres_tmp(i,k-1)+buff(i,j,k) + enddo !k-loop + enddo !i-loop (lon) -! extract pres_tmp to fill aer_pres +! extract pres_tmp to fill aer_pres (in Pa) do k = 1, levsaer if ( iflip == 0 ) then ! data from toa to sfc klev = k else ! data from sfc to top - klev = ( lmerra - k ) + 1 - endif - aer_pres(i,j,k,imon)= pres_tmp(klev) + klev = ( dim3 - k ) + 1 + endif + do i = 1, hmx + aer_pres(i+hmx,j,k,imon)= 1.d0*pres_tmp(i,klev) + aer_pres(i,j,k,imon) = 1.d0*pres_tmp(i+hmx,klev) + enddo !i-loop (lon) enddo !k-loop (lev) -! if (imon==1 .and. me==master .and. i==1 .and. j==1 ) then -! print *, 'EJ, aer_pres:', aer_pres(i,j,:,imon) -! endif - enddo !j-loop (lat) - enddo !i-loop (lon) -! if (imon==1 .and. me==master ) then -! print *, 'EJx, aer_pres_i1:',(aer_pres(1,1:180,levsaer,imon) ) -! endif +! ====> construct 4-d aerosol array (kg/kg) +! merra2 data is top down +! for GFS, iflip 0: toa to sfc; 1: sfc to toa + DO ii = 1, ntrcaerm + vname=trim(specname(ii)) + call nf_inq_varid(ncid, vname, varid) + call nf_get_var(ncid, varid, buffx) -! construct lat/lon array - if (imon == 1 ) then - call nf_inq_varid(ncid, "lat", varid) - call nf_get_var(ncid, varid, aer_lat) - call nf_inq_varid(ncid, "lon", varid) - call nf_get_var(ncid, varid, aer_lon) - do i = 1, lonsaer - if(aer_lon(i) < 0.) aer_lon(i) = aer_lon(i) + 360. - enddo -! if (imon==1 .and. me == master) then -! print *, "EJ, lat:", aer_lat(:) -! print *, "EJ, lon:", aer_lon(:) -! endif - endif + do j = 1, latsaer + do k = 1, levsaer +! input is from toa to sfc + if ( iflip == 0 ) then ! data from toa to sfc + klev = k + else ! data from sfc to top + klev = ( dim3 - k ) + 1 + endif + do i = 1, hmx + aerin(i+hmx,j,k,ii,imon) = 1.d0*buffx(i,j,klev,1) + if(aerin(i+hmx,j,k,ii,imon)<0.or.aerin(i+hmx,j,k,ii,imon)>1.) then + aerin(i+hmx,j,k,ii,imon) = 0. + end if + aerin(i,j,k,ii,imon) = 1.d0*buffx(i+hmx,j,klev,1) + if(aerin(i,j,k,ii,imon)<0.or.aerin(i,j,k,ii,imon)>1.) then + aerin(i,j,k,ii,imon) = 0. + end if + enddo !i-loop (lon) + enddo !k-loop (lev) + enddo !j-loop (lat) + + ENDDO ! ii-loop (ntracaerm) ! close the file call nf_close(ncid) enddo !imon-loop - !--- - deallocate (ps_clm, delp_clm, pres_tmp, aer_clm, airden_clm ) - if (me == master) then - write(*,*) 'Reading in GOCART aerosols data' - endif + deallocate (aer_loni, aer_lati) + deallocate (buff, pres_tmp) + deallocate (buffx) END SUBROUTINE read_aerdata ! @@ -213,12 +234,7 @@ SUBROUTINE setindxaer(npts,dlat,jindx1,jindx2,ddy,dlon, & else ddy(j) = 1.0 endif - -! if (me == master .and. j<= 3) then -! print *,'EJj,',j,' dlat=',dlat(j),' jindx12=',jindx1(j),& -! jindx2(j),' aer_lat=',aer_lat(jindx1(j)), & -! aer_lat(jindx2(j)),' ddy=',ddy(j) -! endif + ENDDO DO J=1,npts @@ -237,13 +253,8 @@ SUBROUTINE setindxaer(npts,dlat,jindx1,jindx2,ddy,dlon, & else ddx(j) = 1.0 endif -! if (me == master .and. j<= 3) then -! print *,'EJi,',j,' dlon=',dlon(j),' iindx12=',iindx1(j),& -! iindx2(j),' aer_lon=',aer_lon(iindx1(j)), & -! aer_lon(iindx2(j)),' ddx=',ddx(j) -! endif ENDDO - + RETURN END SUBROUTINE setindxaer ! @@ -259,13 +270,14 @@ SUBROUTINE aerinterpol(me,master,npts,IDATE,FHOUR,jindx1,jindx2, & integer i1,i2, iday,j,j1,j2,l,npts,nc,n1,n2,lev,k,i,ii real(kind=kind_phys) fhour,temj, tx1, tx2,temi ! - + integer JINDX1(npts), JINDX2(npts),iINDX1(npts),iINDX2(npts) integer me,idate(4), master integer IDAT(8),JDAT(8) ! real(kind=kind_phys) DDY(npts), ddx(npts),ttt - real(kind=kind_phys) aerout(npts,lev,ntrcaer),aerpm(npts,levsaer,ntrcaer) + real(kind=kind_phys) aerout(npts,lev,ntrcaer) + real(kind=kind_phys) aerpm(npts,levsaer,ntrcaer) real(kind=kind_phys) prsl(npts,lev), aerpres(npts,levsaer) real(kind=kind_phys) RINC(5), rjday integer jdow, jdoy, jday @@ -286,7 +298,6 @@ SUBROUTINE aerinterpol(me,master,npts,IDATE,FHOUR,jindx1,jindx2, & else CALL W3MOVDAT(RINC,IDAT,JDAT) endif -! if(me==master) print *,'EJ, IDAT ',IDAT(1:3), IDAT(5) ! jdow = 0 jdoy = 0 @@ -306,16 +317,9 @@ SUBROUTINE aerinterpol(me,master,npts,IDATE,FHOUR,jindx1,jindx2, & ! tx1 = (aer_time(n2) - rjday) / (aer_time(n2) - aer_time(n1)) tx2 = 1.0 - tx1 - if (n2 > 12) n2 = n2 -12 -! if(me==master)print *,'EJ,rjday=',rjday, ';aer_time,tx1,tx=' & -! , aer_time(n1),aer_time(n2),tx1,tx2,n1,n2 -! -! if(me==master) then -! DO L=1,levsaer -! print *,'EJ,aerin(n1,n2)=',L,aerin(1,1,L,1,n1),aerin(1,1,L,1,n2) -! ENDDO -! endif + if (n2 > 12) n2 = n2 -12 +! DO L=1,levsaer DO J=1,npts J1 = JINDX1(J) @@ -325,64 +329,54 @@ SUBROUTINE aerinterpol(me,master,npts,IDATE,FHOUR,jindx1,jindx2, & I2 = IINDX2(J) TEMI = 1.0 - DDX(J) DO ii=1,ntrcaer - aerpm(j,L,ii) = & + aerpm(j,L,ii) = & tx1*(TEMI*TEMJ*aerin(I1,J1,L,ii,n1)+DDX(j)*DDY(J)*aerin(I2,J2,L,ii,n1)& - +TEMI*DDY(j)*aerin(I1,J2,L,ii,n1)+DDX(j)*TEMJ*aerin(I2,J1,L,ii,n1))& + +TEMI*DDY(j)*aerin(I1,J2,L,ii,n1)+DDX(j)*TEMJ*aerin(I2,J1,L,ii,n1))& +tx2*(TEMI*TEMJ*aerin(I1,J1,L,ii,n2)+DDX(j)*DDY(J)*aerin(I2,J2,L,ii,n2) & - +TEMI*DDY(j)*aerin(I1,J2,L,ii,n2)+DDX(j)*TEMJ*aerin(I2,J1,L,ii,n2)) + +TEMI*DDY(j)*aerin(I1,J2,L,ii,n2)+DDX(j)*TEMJ*aerin(I2,J1,L,ii,n2)) ENDDO - aerpres(j,L) = & + aerpres(j,L) = & tx1*(TEMI*TEMJ*aer_pres(I1,J1,L,n1)+DDX(j)*DDY(J)*aer_pres(I2,J2,L,n1)& - +TEMI*DDY(j)*aer_pres(I1,J2,L,n1)+DDX(j)*TEMJ*aer_pres(I2,J1,L,n1))& + +TEMI*DDY(j)*aer_pres(I1,J2,L,n1)+DDX(j)*TEMJ*aer_pres(I2,J1,L,n1))& +tx2*(TEMI*TEMJ*aer_pres(I1,J1,L,n2)+DDX(j)*DDY(J)*aer_pres(I2,J2,L,n2) & - +TEMI*DDY(j)*aer_pres(I1,J2,L,n2)+DDX(j)*TEMJ*aer_pres(I2,J1,L,n2)) - -! IF(me==master .and. j==1) THEN -! print *, 'EJ,aer/ps:',L,aerpm(j,L,1),aerpres(j,L) -! if(L==1) then -! print *, 'EJ, wgt:',TEMI*TEMJ,DDX(j)*DDY(J),TEMI*DDY(j),DDX(j)*TEMJ -! print *, 'EJ, aerx:',aerin(I1,J1,L,ii,n1), & -! aerin(I2,J2,L,ii,n1), aerin(I1,J2,L,ii,n1), aerin(I2,J1,L,ii,n1) -! print *, 'EJ, aery:',aerin(I1,J1,L,ii,n2), & -! aerin(I2,J2,L,ii,n2), aerin(I1,J2,L,ii,n2), aerin(I2,J1,L,ii,n2) -! endif -! ENDIF + +TEMI*DDY(j)*aer_pres(I1,J2,L,n2)+DDX(j)*TEMJ*aer_pres(I2,J1,L,n2)) + ENDDO ENDDO -! note: input is set to be same as GFS +! don't flip, input is the same direction as GFS (bottom-up) DO J=1,npts DO L=1,lev - if(prsl(j,l).ge.aerpres(j,levsaer)) then + if(prsl(j,L).ge.aerpres(j,1)) then DO ii=1, ntrcaer - aerout(j,l,ii)=aerpm(j,levsaer,ii) + aerout(j,L,ii)=aerpm(j,1,ii) !! sfc level ENDDO - else if(prsl(j,l).le.aerpres(j,1)) then + else if(prsl(j,L).le.aerpres(j,levsaer)) then DO ii=1, ntrcaer - aerout(j,l,ii)=aerpm(j,1,ii) + aerout(j,L,ii)=aerpm(j,levsaer,ii) !! toa top ENDDO else - DO k=levsaer-1,1,-1 - IF(prsl(j,l)>aerpres(j,k)) then + DO k=1, levsaer-1 !! from sfc to toa + IF(prsl(j,L)aerpres(j,k+1)) then i1=k i2=min(k+1,levsaer) exit - end if - end do + ENDIF + ENDDO + temi = prsl(j,L)-aerpres(j,i2) + temj = aerpres(j,i1) - prsl(j,L) + tx1 = temi/(aerpres(j,i1) - aerpres(j,i2)) + tx2 = temj/(aerpres(j,i1) - aerpres(j,i2)) DO ii = 1, ntrcaer - aerout(j,l,ii)=aerpm(j,i1,ii)+(aerpm(j,i2,ii)-aerpm(j,i1,ii))& - /(aerpres(j,i2)-aerpres(j,i1))*(prsl(j,l)-aerpres(j,i1)) -! IF(me==master .and. j==1 .and. ii==1) then -! print *, 'EJ, aerout:',aerout(j,l,ii), aerpm(j,i1,ii), & -! aerpm(j,i2,ii), aerpres(j,i2), aerpres(j,i1), prsl(j,l) -! ENDIF + aerout(j,L,ii)= aerpm(j,i1,ii)*tx1 + aerpm(j,i2,ii)*tx2 ENDDO endif - ENDDO - ENDDO + ENDDO !L-loop + ENDDO !J-loop ! RETURN END SUBROUTINE aerinterpol end module aerinterp + diff --git a/physics/cires_ugwp.F90 b/physics/cires_ugwp.F90 index 0c019abb8..bf2825104 100644 --- a/physics/cires_ugwp.F90 +++ b/physics/cires_ugwp.F90 @@ -6,8 +6,8 @@ !! "Unified": a) all GW effects due to both dissipation/breaking; b) identical GW solvers for all GW sources; c) ability to replace solvers. !! Unified Formalism: !! 1. GW Sources: Stochastic and physics based mechanisms for GW-excitations in the lower atmosphere, calibrated by the high-res analyses/forecasts, and observations (3 types of GW sources: orography, convection, fronts/jets). -!! 2. GW Propagation: Unified solver for “propagation, dissipation and breaking” excited from all type of GW sources. -!! 3. GW Effects: Unified representation of GW impacts on the ‘resolved’ flow for all sources (energy-balanced schemes for momentum, heat and mixing). +!! 2. GW Propagation: Unified solver for "propagation, dissipation and breaking" excited from all type of GW sources. +!! 3. GW Effects: Unified representation of GW impacts on the "resolved" flow for all sources (energy-balanced schemes for momentum, heat and mixing). !! https://www.weather.gov/media/sti/nggps/Presentations%202017/02%20NGGPS_VYUDIN_2017_.pdf module cires_ugwp @@ -145,8 +145,8 @@ end subroutine cires_ugwp_finalize !> \section arg_table_cires_ugwp_run Argument Table !! \htmlinclude cires_ugwp_run.html !! - -! subroutines original +!> \section gen_cires_ugwp CIRES UGWP Scheme General Algorithm +!! @{ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr, & oro, oro_uf, hprime, nmtvr, oc, theta, sigma, gamma, elvmax, clx, oa4, & do_tofd, ldiag_ugwp, cdmbgwd, xlat, xlat_d, sinlat, coslat, area, & @@ -397,5 +397,6 @@ subroutine cires_ugwp_run(do_ugwp, me, master, im, levs, ntrac, dtp, kdt, lonr endif end subroutine cires_ugwp_run - +!! @} +!>@} end module cires_ugwp diff --git a/physics/cires_ugwp_post.F90 b/physics/cires_ugwp_post.F90 index 2fe6ca04d..612db2c0e 100755 --- a/physics/cires_ugwp_post.F90 +++ b/physics/cires_ugwp_post.F90 @@ -25,8 +25,7 @@ subroutine cires_ugwp_post_run (ldiag_ugwp, dtf, im, levs, & tot_zmtb, tot_zlwb, tot_zogw, & tot_tofd, tot_mtb, tot_ogw, tot_ngw, & du3dt_mtb,du3dt_ogw, du3dt_tms, du3dt_ngw, dv3dt_ngw, & - dtdt, dudt, dvdt, & - errmsg, errflg) + dtdt, dudt, dvdt, errmsg, errflg) use machine, only: kind_phys diff --git a/physics/cs_conv.F90 b/physics/cs_conv.F90 index 956d5a1d0..29044e4ec 100644 --- a/physics/cs_conv.F90 +++ b/physics/cs_conv.F90 @@ -1401,9 +1401,11 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions gcht(i,ctp) = tem * gcht(i,ctp) gcqt(i,ctp) = tem * gcqt(i,ctp) gcit(i,ctp) = tem * gcit(i,ctp) - do n = ntrq,ntr - gctrt(i,n,ctp) = tem * gctrt(i,n,ctp) - enddo + if (.not. flx_form) then + do n = ntrq,ntr + gctrt(i,n,ctp) = tem * gctrt(i,n,ctp) + enddo + end if gcut(i,ctp) = tem * gcut(i,ctp) gcvt(i,ctp) = tem * gcvt(i,ctp) do k=1,kmax diff --git a/physics/cs_conv.meta b/physics/cs_conv.meta index e1d6c3538..d499885c7 100644 --- a/physics/cs_conv.meta +++ b/physics/cs_conv.meta @@ -54,7 +54,7 @@ optional = F [clw1] standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -63,7 +63,7 @@ optional = F [clw2] standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) in the convectively transported tracer array + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -144,7 +144,7 @@ optional = F [save_q2] standard_name = cloud_condensed_water_mixing_ratio_save - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) before entering a physics scheme + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/cu_gf_driver.meta b/physics/cu_gf_driver.meta index 99e6ca650..d89450273 100644 --- a/physics/cu_gf_driver.meta +++ b/physics/cu_gf_driver.meta @@ -261,8 +261,8 @@ intent = in optional = F [hfx2] - standard_name = kinematic_surface_upward_sensible_heat_flux - long_name = kinematic surface upward sensible heat flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward sensible heat flux reduced by surface roughness units = K m s-1 dimensions = (horizontal_dimension) type = real @@ -270,8 +270,8 @@ intent = in optional = F [qfx2] - standard_name = kinematic_surface_upward_latent_heat_flux - long_name = kinematic surface upward latent heat flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward latent heat flux reduced by surface roughness units = kg kg-1 m s-1 dimensions = (horizontal_dimension) type = real @@ -280,7 +280,7 @@ optional = F [cliw] standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -289,7 +289,7 @@ optional = F [clcw] standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water in the convectively transported tracer array + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/cu_ntiedtke.F90 b/physics/cu_ntiedtke.F90 index 8e42ebdd4..156e75c70 100644 --- a/physics/cu_ntiedtke.F90 +++ b/physics/cu_ntiedtke.F90 @@ -148,7 +148,7 @@ end subroutine cu_ntiedtke_finalize !----------------------------------------------------------------------- ! level 1 subroutine 'tiecnvn' !----------------------------------------------------------------- - subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & + subroutine cu_ntiedtke_run(pu,pv,pt,pqv,tdi,qvdi,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & evap,hfx,zprecc,lmask,lq,ix,km,dt,dx,kbot,ktop,kcnv,& ktrac,ud_mf,dd_mf,dt_mf,cnvw,cnvc,errmsg,errflg) !----------------------------------------------------------------- @@ -162,13 +162,9 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & integer, dimension( lq ), intent(in) :: lmask real(kind=kind_phys), dimension( lq ), intent(in ) :: evap, hfx, dx real(kind=kind_phys), dimension( ix , km ), intent(inout) :: pu, pv, pt, pqv - real(kind=kind_phys), dimension( ix , km ), intent(in ) :: poz, prsl, pomg, pqvf, ptf + real(kind=kind_phys), dimension( ix , km ), intent(in ) :: tdi, qvdi, poz, prsl, pomg, pqvf, ptf real(kind=kind_phys), dimension( ix , km+1 ), intent(in ) :: pzz, prsi - ! DH* TODO - check dimensions of clw, ktrac+2 seems to be smaller - ! than the actual dimensions (ok as long as only indices 1 and 2 - ! are accessed here, and as long as these contain what is expected); - ! better to expand into the cloud-ice and cloud-water components *DH - real(kind=kind_phys), dimension( ix , km, ktrac+2 ), intent(inout ) :: clw + real(kind=kind_phys), dimension( ix , km, ktrac ), intent(inout ) :: clw integer, dimension( lq ), intent(out) :: kbot, ktop, kcnv real(kind=kind_phys), dimension( lq ), intent(out) :: zprecc @@ -188,13 +184,13 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & real(kind=kind_phys) ztp1(lq,km), zqp1(lq,km), ztu(lq,km), zqu(lq,km),& & zlu(lq,km), zlude(lq,km), zmfu(lq,km), zmfd(lq,km), zmfude_rate(lq,km),& & zqsat(lq,km), zrain(lq) - real(kind=kind_phys) pcen(lq,km,ktrac),ptenc(lq,km,ktrac) + real(kind=kind_phys),allocatable :: pcen(:,:,:),ptenc(:,:,:) integer icbot(lq), ictop(lq), ktype(lq), lndj(lq) logical locum(lq) ! real(kind=kind_phys) ztmst,fliq,fice,ztc,zalf,tt - integer i,j,k,k1,n,km1 + integer i,j,k,k1,n,km1,ktracer real(kind=kind_phys) ztpp1 real(kind=kind_phys) zew,zqs,zcor ! @@ -246,9 +242,9 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & zqs = min(0.5,zqs) zcor = 1./(1.-vtmpc1*zqs) zqsat(j,k1)=zqs*zcor - pqte(j,k1)=pqvf(j,k) + pqte(j,k1)=pqvf(j,k)+(pqv(j,k)-qvdi(j,k))/ztmst zqq(j,k1) =pqte(j,k1) - ptte(j,k1)=ptf(j,k) + ptte(j,k1)=ptf(j,k)+(pt(j,k)-tdi(j,k))/ztmst ztt(j,k1) =ptte(j,k1) ud_mf(j,k1)=0. dd_mf(j,k1)=0. @@ -258,16 +254,33 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & end do end do - do n=1,ktrac - do k=1,km - k1=km-k+1 - do j=1,lq - pcen(j,k1,n) = clw(j,k,n+2) - ptenc(j,k1,n)= 0. + if(ktrac > 2) then + ktracer = ktrac - 2 + allocate(pcen(lq,km,ktracer)) + allocate(ptenc(lq,km,ktracer)) + do n=1,ktracer + do k=1,km + k1=km-k+1 + do j=1,lq + pcen(j,k1,n) = clw(j,k,n+2) + ptenc(j,k1,n)= 0. + end do end do end do - end do - + else + ktracer = 2 + allocate(pcen(lq,km,ktracer)) + allocate(ptenc(lq,km,ktracer)) + do n=1,ktracer + do k=1,km + do j=1,lq + pcen(j,k,n) = 0. + ptenc(j,k,n)= 0. + end do + end do + end do + end if + ! print *, "pgeo=",pgeo(1,:) ! print *, "pgeoh=",pgeoh(1,:) ! print *, "pap=",pap(1,:) @@ -289,7 +302,7 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & & zqp1, pum1, pvm1, pverv, zqsat,& & pqhfl, ztmst, pap, paph, pgeo, & & ptte, pqte, pvom, pvol, prsfc,& - & pssfc, locum, ktrac, pcen, ptenc,& + & pssfc, locum, ktracer, pcen, ptenc,& & ktype, icbot, ictop, ztu, zqu, & & zlu, zlude, zmfu, zmfd, zrain,& & pcte, phhfl, lndj, pgeoh, zmfude_rate, dx) @@ -314,7 +327,7 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & pt(j,k) = ztp1(j,k1)+(ptte(j,k1)-ztt(j,k1))*ztmst pqv(j,k)= zqp1(j,k1)+(pqte(j,k1)-zqq(j,k1))*ztmst ud_mf(j,k)= zmfu(j,k1)*ztmst - dd_mf(j,k)= zmfd(j,k1)*ztmst + dd_mf(j,k)= -zmfd(j,k1)*ztmst dt_mf(j,k)= zmfude_rate(j,k1)*ztmst cnvw(j,k) = zlude(j,k1)*ztmst*g/(prsi(j,k)-prsi(j,k+1)) cnvc(j,k) = 0.04 * log(1. + 675. * ud_mf(j,k)) @@ -343,17 +356,21 @@ subroutine cu_ntiedtke_run(pu,pv,pt,pqv,pqvf,ptf,clw,poz,pzz,prsl,prsi,pomg, & end do end do endif + ! - if (ktrac > 0) then - do n=1,ktrac - do k=1,km - k1=km-k+1 - do j=1,lq - clw(j,k,n+2)=pcen(j,k,n)+ptenc(j,k1,n)*ztmst - end do - end do - end do - end if +! Currently, vertical mixing of tracers are turned off +! if(ktrac > 2) then +! do n=1,ktrac-2 +! do k=1,km +! k1=km-k+1 +! do j=1,lq +! clw(j,k,n+2)=pcen(j,k,n)+ptenc(j,k1,n)*ztmst +! end do +! end do +! end do +! end if + deallocate(pcen) + deallocate(ptenc) ! return end subroutine cu_ntiedtke_run diff --git a/physics/cu_ntiedtke.meta b/physics/cu_ntiedtke.meta index da9219c10..6dcc54a15 100644 --- a/physics/cu_ntiedtke.meta +++ b/physics/cu_ntiedtke.meta @@ -80,6 +80,24 @@ kind = kind_phys intent = inout optional = F +[tdi] + standard_name = air_temperature + long_name = mid-layer temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[qvdi] + standard_name = water_vapor_specific_humidity + long_name = water vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [pqvf] standard_name = moisture_tendency_due_to_dynamics long_name = moisture tendency due to dynamics only @@ -153,8 +171,8 @@ intent = in optional = F [evap] - standard_name = kinematic_surface_upward_latent_heat_flux - long_name = kinematic surface upward latent heat flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward latent heat flux reduced by surface roughness units = kg kg-1 m s-1 dimensions = (horizontal_dimension) type = real @@ -162,8 +180,8 @@ intent = in optional = F [hfx] - standard_name = kinematic_surface_upward_sensible_heat_flux - long_name = kinematic surface upward sensible heat flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward sensible heat flux reduced by surface roughness units = K m s-1 dimensions = (horizontal_dimension) type = real @@ -254,8 +272,8 @@ intent = out optional = F [ktrac] - standard_name = number_of_total_tracers - long_name = number of total tracers + standard_name = number_of_tracers_for_convective_transport + long_name = number of tracers for convective transport units = count dimensions = () type = integer diff --git a/physics/dcyc2.f b/physics/dcyc2.f index 92369d712..c7a1ddd59 100644 --- a/physics/dcyc2.f +++ b/physics/dcyc2.f @@ -313,17 +313,17 @@ subroutine dcyc2t3_run & if (dry(i)) then tem2 = tsfc_lnd(i) * tsfc_lnd(i) adjsfculw_lnd(i) = sfcemis_lnd(i) * con_sbc * tem2 * tem2 - & + (one - sfcemis_lnd(i)) * adjsfcdlw(i) + & + (one - sfcemis_lnd(i)) * adjsfcdlw(i) endif if (icy(i)) then tem2 = tsfc_ice(i) * tsfc_ice(i) adjsfculw_ice(i) = sfcemis_ice(i) * con_sbc * tem2 * tem2 - & + (one - sfcemis_ice(i)) * adjsfcdlw(i) + & + (one - sfcemis_ice(i)) * adjsfcdlw(i) endif if (wet(i)) then tem2 = tsfc_ocn(i) * tsfc_ocn(i) adjsfculw_ocn(i) = sfcemis_ocn(i) * con_sbc * tem2 * tem2 - & + (one - sfcemis_ocn(i)) * adjsfcdlw(i) + & + (one - sfcemis_ocn(i)) * adjsfcdlw(i) endif ! if (lprnt .and. i == ipr) write(0,*)' in dcyc3: dry==',dry(i) ! &,' wet=',wet(i),' icy=',icy(i),' tsfc3=',tsfc3(i,:) @@ -370,60 +370,3 @@ end subroutine dcyc2t3_run !> @} !----------------------------------- end module dcyc2t3 - - - - module dcyc2t3_post - - implicit none - - private - - public :: dcyc2t3_post_init,dcyc2t3_post_run,dcyc2t3_post_finalize - - contains - -!! \section arg_table_dcyc2t3_post_init Argument Table -!! - subroutine dcyc2t3_post_init() - end subroutine dcyc2t3_post_init - -!! \section arg_table_dcyc2t3_post_finalize Argument Table -!! - subroutine dcyc2t3_post_finalize() - end subroutine dcyc2t3_post_finalize - - -!> This subroutine contains CCPP-compliant dcyc2t3 that calulates -!! surface upwelling shortwave flux at current time. -!! -!! \section arg_table_dcyc2t3_post_run Argument Table -!! \htmlinclude dcyc2t3_post_run.html -!! - subroutine dcyc2t3_post_run( & - & im, adjsfcdsw, adjsfcnsw, adjsfcusw, & - & errmsg, errflg) - - use GFS_typedefs, only: GFS_diag_type - use machine, only: kind_phys - - implicit none - - integer, intent(in) :: im - real(kind=kind_phys), dimension(im), intent(in) :: adjsfcdsw - real(kind=kind_phys), dimension(im), intent(in) :: adjsfcnsw - real(kind=kind_phys), dimension(im), intent(out) :: adjsfcusw - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg - - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 - - adjsfcusw(:) = adjsfcdsw(:) - adjsfcnsw(:) - - return - end subroutine dcyc2t3_post_run - - end module dcyc2t3_post - diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index c4a8d9051..9a5687bf5 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -186,7 +186,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky shortwave heating rate on radiation time step units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in @@ -195,7 +195,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step long_name = clear sky shortwave heating rate on radiation time step units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in @@ -204,7 +204,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky longwave heating rate on radiation time step units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in @@ -213,7 +213,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step long_name = clear sky longwave heating rate on radiation time step units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in @@ -535,70 +535,3 @@ type = integer intent = out optional = F - -######################################################################## -[ccpp-arg-table] - name = dcyc2t3_post_init - type = scheme - -######################################################################## -[ccpp-arg-table] - name = dcyc2t3_post_finalize - type = scheme - -######################################################################## -[ccpp-arg-table] - name = dcyc2t3_post_run - type = scheme -[im] - standard_name = horizontal_loop_extent - long_name = horizontal loop extent - units = count - dimensions = () - type = integer - intent = in - optional = F -[adjsfcdsw] - standard_name = surface_downwelling_shortwave_flux - long_name = surface downwelling shortwave flux at current time - units = W m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[adjsfcnsw] - standard_name = surface_net_downwelling_shortwave_flux - long_name = surface net downwelling shortwave flux at current time - units = W m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[adjsfcusw] - standard_name = surface_upwelling_shortwave_flux - long_name = surface upwelling shortwave flux at current time - units = W m-2 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = out - optional = F -[errmsg] - standard_name = ccpp_error_message - long_name = error message for error handling in CCPP - units = none - dimensions = () - type = character - kind = len=* - intent = out - optional = F -[errflg] - standard_name = ccpp_error_flag - long_name = error flag for error handling in CCPP - units = flag - dimensions = () - type = integer - intent = out - optional = F diff --git a/physics/docs/ccpp_doxyfile b/physics/docs/ccpp_doxyfile index e4b2e0501..339ddb3f8 100644 --- a/physics/docs/ccpp_doxyfile +++ b/physics/docs/ccpp_doxyfile @@ -113,6 +113,7 @@ INPUT = pdftxt/mainpage.txt \ pdftxt/GFS_SFCSICE.txt \ pdftxt/GFS_HEDMF.txt \ pdftxt/GFS_SATMEDMF.txt \ + pdftxt/GFS_SATMEDMFVDIFQ.txt \ pdftxt/GFS_GWDPS.txt \ pdftxt/GFS_OZPHYS.txt \ pdftxt/GFS_H2OPHYS.txt \ @@ -189,6 +190,11 @@ INPUT = pdftxt/mainpage.txt \ ../mfpblt.f \ ../mfscu.f \ ../tridi.f \ +### satmedmfvdifq + ../satmedmfvdifq.F \ + ../mfpbltq.f \ + ../mfscuq.f \ + ../tridi.f \ ### Orographic Gravity Wave ../gwdps.f \ ### Rayleigh Dampling diff --git a/physics/docs/ccppv4_doxyfile b/physics/docs/ccppv4_doxyfile new file mode 100644 index 000000000..e80b27eb9 --- /dev/null +++ b/physics/docs/ccppv4_doxyfile @@ -0,0 +1,467 @@ +# Doxyfile 1.8.11 +DOXYFILE_ENCODING = UTF-8 +PROJECT_NAME = "CCPP Scientific Documentation" +PROJECT_NUMBER = "" +PROJECT_BRIEF = "v4.0" +PROJECT_LOGO = img/dtc_logo.png +OUTPUT_DIRECTORY = doc +CREATE_SUBDIRS = NO +ALLOW_UNICODE_NAMES = NO +OUTPUT_LANGUAGE = English +BRIEF_MEMBER_DESC = YES +REPEAT_BRIEF = NO +ABBREVIATE_BRIEF = +ALWAYS_DETAILED_SEC = NO +INLINE_INHERITED_MEMB = NO +FULL_PATH_NAMES = NO +STRIP_FROM_PATH = +STRIP_FROM_INC_PATH = +SHORT_NAMES = NO +JAVADOC_AUTOBRIEF = NO +QT_AUTOBRIEF = NO +MULTILINE_CPP_IS_BRIEF = NO +INHERIT_DOCS = YES +SEPARATE_MEMBER_PAGES = YES +TAB_SIZE = 4 +ALIASES = +TCL_SUBST = +OPTIMIZE_OUTPUT_FOR_C = NO +OPTIMIZE_OUTPUT_JAVA = NO +OPTIMIZE_FOR_FORTRAN = YES +OPTIMIZE_OUTPUT_VHDL = NO +EXTENSION_MAPPING = .f=FortranFree \ + .F=FortranFree \ + .F90=FortranFree \ + .f90=FortranFree +MARKDOWN_SUPPORT = YES +AUTOLINK_SUPPORT = YES +BUILTIN_STL_SUPPORT = NO +CPP_CLI_SUPPORT = NO +SIP_SUPPORT = NO +IDL_PROPERTY_SUPPORT = YES +DISTRIBUTE_GROUP_DOC = YES +GROUP_NESTED_COMPOUNDS = NO +SUBGROUPING = YES +INLINE_GROUPED_CLASSES = NO +INLINE_SIMPLE_STRUCTS = NO +TYPEDEF_HIDES_STRUCT = YES +LOOKUP_CACHE_SIZE = 0 +EXTRACT_ALL = YES +EXTRACT_PRIVATE = YES +EXTRACT_PACKAGE = YES +EXTRACT_STATIC = YES +EXTRACT_LOCAL_CLASSES = YES +EXTRACT_LOCAL_METHODS = YES +EXTRACT_ANON_NSPACES = YES +HIDE_UNDOC_MEMBERS = NO +HIDE_UNDOC_CLASSES = NO +HIDE_FRIEND_COMPOUNDS = NO +HIDE_IN_BODY_DOCS = NO +INTERNAL_DOCS = YES + +CASE_SENSE_NAMES = NO + +HIDE_SCOPE_NAMES = NO + +HIDE_COMPOUND_REFERENCE= NO + +SHOW_INCLUDE_FILES = NO + +SHOW_GROUPED_MEMB_INC = NO + +FORCE_LOCAL_INCLUDES = NO + +INLINE_INFO = YES + +SORT_MEMBER_DOCS = NO + +SORT_BRIEF_DOCS = NO +SORT_MEMBERS_CTORS_1ST = NO +SORT_GROUP_NAMES = NO +SORT_BY_SCOPE_NAME = NO +STRICT_PROTO_MATCHING = NO +GENERATE_TODOLIST = YES +GENERATE_TESTLIST = YES +GENERATE_BUGLIST = YES +GENERATE_DEPRECATEDLIST= YES +ENABLED_SECTIONS = YES +MAX_INITIALIZER_LINES = 30 +SHOW_USED_FILES = YES +SHOW_FILES = YES +SHOW_NAMESPACES = YES +FILE_VERSION_FILTER = +LAYOUT_FILE = ccpp_dox_layout.xml +CITE_BIB_FILES = library.bib +QUIET = NO +WARNINGS = YES +WARN_IF_UNDOCUMENTED = NO +WARN_IF_DOC_ERROR = YES +WARN_NO_PARAMDOC = NO +WARN_AS_ERROR = NO +WARN_FORMAT = +WARN_LOGFILE = +INPUT = pdftxt/mainpage.txt \ + pdftxt/all_shemes_list.txt \ + pdftxt/GFSv15p2_suite.txt \ + pdftxt/GFSv15p2_no_nsst_suite.txt \ + pdftxt/suite_FV3_GFS_v15p2.xml.txt \ + pdftxt/suite_FV3_GFS_v15p2_no_nsst.xml.txt \ + pdftxt/GFSv16beta_suite.txt \ + pdftxt/GFSv16beta_no_nsst_suite.txt \ + pdftxt/suite_FV3_GFS_v16beta.xml.txt \ + pdftxt/suite_FV3_GFS_v16beta_no_nsst.xml.txt \ + pdftxt/GSD_adv_suite.txt \ + pdftxt/CPT_adv_suite.txt \ + pdftxt/GFS_RRTMG.txt \ + pdftxt/GFS_SFCLYR.txt \ + pdftxt/GFS_NSST.txt \ + pdftxt/GFS_OCEAN.txt \ + pdftxt/GFS_NOAH.txt \ + pdftxt/GFS_SFCSICE.txt \ + pdftxt/GFS_HEDMF.txt \ + pdftxt/GFS_SATMEDMFVDIFQ.txt \ +## pdftxt/GFS_NoahMP.txt \ + pdftxt/GFS_UGWPv0.txt \ + pdftxt/GFS_GWDPS.txt \ + pdftxt/GFS_OZPHYS.txt \ + pdftxt/GFS_H2OPHYS.txt \ + pdftxt/GFS_RAYLEIGH.txt \ + pdftxt/GFS_SAMF.txt \ + pdftxt/GFS_SAMFdeep.txt \ + pdftxt/GFS_SAMFshal.txt \ + pdftxt/GFDL_cloud.txt \ + pdftxt/GFS_CALPRECIPTYPE.txt \ +### pdftxt/rad_cld.txt \ + pdftxt/CPT_CSAW.txt \ + pdftxt/CPT_MG3.txt \ + pdftxt/GSD_MYNN_EDMF.txt \ + pdftxt/GSD_CU_GF_deep.txt \ + pdftxt/GSD_RUCLSM.txt \ + pdftxt/GSD_THOMPSON.txt \ +### pdftxt/GFSphys_namelist.txt \ +### pdftxt/GFS_STOCHY_PHYS.txt \ + pdftxt/suite_input.nml.txt \ +### in-core MP + ../gfdl_fv_sat_adj.F90 \ +### time_vary + ../GFS_time_vary_pre.fv3.F90 \ + ../GFS_rad_time_vary.fv3.F90 \ + ../GFS_phys_time_vary.fv3.F90 \ + ../ozne_def.f \ + ../ozinterp.f90 \ + ../h2o_def.f \ + ../h2ointerp.f90 \ + ../aerclm_def.F \ + ../aerinterp.F90 \ + ../iccn_def.F \ + ../iccninterp.F90 \ + ../sfcsub.F \ + ../gcycle.F90 \ +### Radiation +### ../GFS_rrtmg_pre.F90 \ +### ../rrtmg_sw_pre.F90 \ + ../radsw_main.f \ +### ../rrtmg_sw_post.F90 \ +### ../rrtmg_lw_pre.F90 \ + ../radlw_main.f \ +### ../rrtmg_lw_post.F90 \ + ../radiation_aerosols.f \ + ../radiation_astronomy.f \ + ../radiation_clouds.f \ + ../radiation_gases.f \ + ../radiation_surface.f \ + ../radlw_param.f \ + ../radlw_datatb.f \ + ../radsw_param.f \ + ../radsw_datatb.f \ + ../dcyc2.f \ +### Land Surface + ../sfc_diff.f \ + ../sfc_nst.f \ + ../sfc_ocean.F \ + ../module_nst_model.f90 \ + ../module_nst_parameters.f90 \ + ../module_nst_water_prop.f90 \ + ../sfc_drv.f \ + ../sflx.f \ + ../namelist_soilveg.f \ + ../set_soilveg.f \ +### Sea Ice Surface + ../sfc_sice.f \ +### PBL + ../moninedmf.f \ + ../mfpbl.f \ + ../tridi.f \ +### satmedmf +## ../satmedmfvdif.F \ + ../satmedmfvdifq.F \ + ../mfpbltq.f \ + ../mfscuq.f \ + ../tridi.f \ +### Orographic Gravity Wave + ../GFS_GWD_generic.F90 \ + ../cires_ugwp.F90 \ + ../gwdps.f \ + ../ugwp_driver_v0.F \ + ../cires_ugwp_triggers.F90 \ + ../cires_ugwp_module.F90 \ + ../cires_ugwp_utils.F90 \ + ../cires_ugwp_solvers.F90 \ +### ../cires_ugwp_post.F90 \ +### ../cires_ugwp_initialize.F90 \ + ../cires_vert_wmsdis.F90 \ + ../cires_vert_orodis.F90 \ + ../cires_vert_lsatdis.F90 \ +### Rayleigh Dampling + ../rayleigh_damp.f \ +### Prognostic Ozone + ../ozphys_2015.f \ +### ../ozphys.f \ +### stratospheric h2o + ../h2ophys.f \ +### Deep Convection + ../samfdeepcnv.f \ +### Convective Gravity Wave +### ../gwdc.f \ +### Shallow Convection + ../samfshalcnv.f \ + ../cnvc90.f \ +### Microphysics +### ../gscond.f \ +### ../precpd.f \ + ../module_bfmicrophysics.f \ +### GFDL cloud MP + ../gfdl_cloud_microphys.F90 \ + ../module_gfdl_cloud_microphys.F90 \ +### + ../GFS_MP_generic.F90 \ + ../calpreciptype.f90 \ +### stochy + ../GFS_stochastics.F90 \ +### ../surface_perturbation.F90 \ +### ../../stochastic_physics/stochastic_physics.F90 \ +### CPT + ../m_micro.F90 \ +### ../micro_mg2_0.F90 \ + ../micro_mg3_0.F90 \ + ../micro_mg_utils.F90 \ + ../cldmacro.F \ + ../aer_cloud.F \ + ../cldwat2m_micro.F \ + ../wv_saturation.F \ + ../cs_conv_aw_adj.F90 \ + ../cs_conv.F90 \ +### GSD + ../cu_gf_driver.F90 \ + ../cu_gf_deep.F90 \ + ../cu_gf_sh.F90 \ + ../module_MYNNrad_pre.F90 \ + ../module_MYNNrad_post.F90 \ + ../module_MYNNPBL_wrapper.F90 \ + ../module_bl_mynn.F90 \ +### ../module_MYNNSFC_wrapper.F90 \ +### ../module_sf_mynn.F90 \ + ../sfc_drv_ruc.F90 \ + ../module_sf_ruclsm.F90 \ + ../namelist_soilveg_ruc.F90 \ + ../set_soilveg_ruc.F90 \ + ../module_soil_pre.F90 \ + ../mp_thompson_pre.F90 \ + ../module_mp_thompson_make_number_concentrations.F90 \ + ../mp_thompson.F90 \ + ../module_mp_thompson.F90 \ + ../module_mp_radar.F90 \ + ../mp_thompson_post.F90 \ +### utils + ../funcphys.f90 \ + ../physparam.f \ + ../physcons.F90 \ + ../radcons.f90 \ + ../mersenne_twister.f +INPUT_ENCODING = UTF-8 +FILE_PATTERNS = *.f \ + *.F \ + *.F90 \ + *.f90 \ + *.nml \ + *.txt +RECURSIVE = YES +EXCLUDE = +EXCLUDE_SYMLINKS = NO +EXCLUDE_PATTERNS = +EXCLUDE_SYMBOLS = +EXAMPLE_PATH = ./ +EXAMPLE_PATTERNS = +EXAMPLE_RECURSIVE = NO +IMAGE_PATH = img +INPUT_FILTER = +FILTER_PATTERNS = +FILTER_SOURCE_FILES = NO +FILTER_SOURCE_PATTERNS = +USE_MDFILE_AS_MAINPAGE = +SOURCE_BROWSER = NO +INLINE_SOURCES = NO +STRIP_CODE_COMMENTS = YES +REFERENCED_BY_RELATION = YES +REFERENCES_RELATION = YES +REFERENCES_LINK_SOURCE = YES +SOURCE_TOOLTIPS = YES +USE_HTAGS = NO +VERBATIM_HEADERS = YES +#CLANG_ASSISTED_PARSING = NO +#CLANG_OPTIONS = +ALPHABETICAL_INDEX = NO +COLS_IN_ALPHA_INDEX = 5 +IGNORE_PREFIX = +GENERATE_HTML = YES +HTML_OUTPUT = html +HTML_FILE_EXTENSION = .html +HTML_HEADER = +HTML_FOOTER = +HTML_STYLESHEET = +HTML_EXTRA_STYLESHEET = ccpp_dox_extra_style.css +HTML_EXTRA_FILES = +HTML_COLORSTYLE_HUE = 220 +HTML_COLORSTYLE_SAT = 100 +HTML_COLORSTYLE_GAMMA = 80 +HTML_TIMESTAMP = NO +HTML_DYNAMIC_SECTIONS = NO +HTML_INDEX_NUM_ENTRIES = 100 +GENERATE_DOCSET = NO +DOCSET_FEEDNAME = "Doxygen generated docs" +DOCSET_BUNDLE_ID = org.doxygen.Project +DOCSET_PUBLISHER_ID = org.doxygen.Publisher +DOCSET_PUBLISHER_NAME = Publisher +GENERATE_HTMLHELP = NO +CHM_FILE = +HHC_LOCATION = +GENERATE_CHI = NO +CHM_INDEX_ENCODING = +BINARY_TOC = NO +TOC_EXPAND = NO +GENERATE_QHP = NO +QCH_FILE = +QHP_NAMESPACE = org.doxygen.Project +QHP_VIRTUAL_FOLDER = doc +QHP_CUST_FILTER_NAME = +QHP_CUST_FILTER_ATTRS = +QHP_SECT_FILTER_ATTRS = +QHG_LOCATION = +GENERATE_ECLIPSEHELP = NO +ECLIPSE_DOC_ID = org.doxygen.Project +DISABLE_INDEX = YES +GENERATE_TREEVIEW = YES +ENUM_VALUES_PER_LINE = 4 +TREEVIEW_WIDTH = 250 +EXT_LINKS_IN_WINDOW = NO +FORMULA_FONTSIZE = 10 +FORMULA_TRANSPARENT = YES +USE_MATHJAX = YES +MATHJAX_FORMAT = HTML-CSS +MATHJAX_RELPATH = https://cdnjs.cloudflare.com/ajax/libs/mathjax/2.7.2 +MATHJAX_EXTENSIONS = +MATHJAX_CODEFILE = +SEARCHENGINE = YES +SERVER_BASED_SEARCH = NO +EXTERNAL_SEARCH = NO +SEARCHENGINE_URL = +SEARCHDATA_FILE = searchdata.xml +EXTERNAL_SEARCH_ID = +EXTRA_SEARCH_MAPPINGS = +GENERATE_LATEX = YES +LATEX_OUTPUT = latex +LATEX_CMD_NAME = latex +MAKEINDEX_CMD_NAME = makeindex +COMPACT_LATEX = YES +PAPER_TYPE = a4 +EXTRA_PACKAGES = amsmath +LATEX_HEADER = +LATEX_FOOTER = +LATEX_EXTRA_STYLESHEET = +LATEX_EXTRA_FILES = +PDF_HYPERLINKS = YES +USE_PDFLATEX = YES +LATEX_BATCHMODE = NO +LATEX_HIDE_INDICES = YES +LATEX_SOURCE_CODE = NO + +LATEX_BIB_STYLE = plainnat + +LATEX_TIMESTAMP = NO + +GENERATE_RTF = NO + +RTF_OUTPUT = rtf +COMPACT_RTF = NO +RTF_HYPERLINKS = NO +RTF_STYLESHEET_FILE = +RTF_EXTENSIONS_FILE = +RTF_SOURCE_CODE = NO +GENERATE_MAN = NO +MAN_OUTPUT = man +MAN_EXTENSION = .3 +MAN_SUBDIR = +MAN_LINKS = NO +GENERATE_XML = NO +XML_OUTPUT = xml +XML_PROGRAMLISTING = YES +GENERATE_DOCBOOK = NO +DOCBOOK_OUTPUT = docbook +DOCBOOK_PROGRAMLISTING = NO +GENERATE_AUTOGEN_DEF = NO +GENERATE_PERLMOD = NO +PERLMOD_LATEX = NO +PERLMOD_PRETTY = YES +PERLMOD_MAKEVAR_PREFIX = +ENABLE_PREPROCESSING = NO +MACRO_EXPANSION = NO +EXPAND_ONLY_PREDEF = NO +SEARCH_INCLUDES = YES +INCLUDE_PATH = +INCLUDE_FILE_PATTERNS = +PREDEFINED = CCPP \ + MULTI_GASES \ + 0 +EXPAND_AS_DEFINED = +SKIP_FUNCTION_MACROS = YES +TAGFILES = +GENERATE_TAGFILE = +ALLEXTERNALS = NO +EXTERNAL_GROUPS = YES +EXTERNAL_PAGES = YES +PERL_PATH = /usr/bin/perl +CLASS_DIAGRAMS = YES +MSCGEN_PATH = +DIA_PATH = +HIDE_UNDOC_RELATIONS = NO +HAVE_DOT = YES +DOT_NUM_THREADS = 0 +DOT_FONTNAME = Helvetica +DOT_FONTSIZE = 10 +DOT_FONTPATH = +CLASS_GRAPH = NO +COLLABORATION_GRAPH = NO +GROUP_GRAPHS = YES +UML_LOOK = YES +UML_LIMIT_NUM_FIELDS = 10 +TEMPLATE_RELATIONS = NO +INCLUDE_GRAPH = YES +INCLUDED_BY_GRAPH = NO +CALL_GRAPH = YES +CALLER_GRAPH = NO +GRAPHICAL_HIERARCHY = YES +DIRECTORY_GRAPH = YES +DOT_IMAGE_FORMAT = svg +INTERACTIVE_SVG = NO +DOT_PATH = +DOTFILE_DIRS = +MSCFILE_DIRS = +DIAFILE_DIRS = +PLANTUML_JAR_PATH = +PLANTUML_INCLUDE_PATH = +DOT_GRAPH_MAX_NODES = 200 +MAX_DOT_GRAPH_DEPTH = 0 +DOT_TRANSPARENT = NO +DOT_MULTI_TARGETS = YES +GENERATE_LEGEND = YES +DOT_CLEANUP = YES diff --git a/physics/docs/library.bib b/physics/docs/library.bib index 7384e08a0..dd2b2042e 100644 --- a/physics/docs/library.bib +++ b/physics/docs/library.bib @@ -1,7 +1,7 @@ %% This BibTeX bibliography file was created using BibDesk. -%% https://bibdesk.sourceforge.io/ +%% http://bibdesk.sourceforge.net/ -%% Created for Grant Firl at 2019-10-25 16:36:06 -0600 +%% Created for Man Zhang at 2020-03-02 13:10:25 -0700 %% Saved with string encoding Unicode (UTF-8) @@ -1859,12 +1859,12 @@ @article{zeng_and_dickinson_1998 @conference{zheng_et_al_2009, Address = {Omaha, Nebraska}, Author = {W. Zheng and H. Wei and J. Meng and M. Ek and K. Mitchell and J. Derber and X. Zeng and Z. Wang}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBWLi4vLi4vLi4vLi4vLi4vRGVza3RvcC9OT0FIX0xTTS9JbXByb3ZlbWVudF9vZl9MYW5kX1N1cmZhY2VfU2tpbl9UZW1wZXJhdHVyZV9pbl9OQy5wZGZPEQIgAAAAAAIgAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADT4djXSCsAAANl5rUfSW1wcm92ZW1lbnRfb2ZfTGFuZCMzNjVGRjBGLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA2X/D9aQ780AAAAAAAAAAAAFAAMAAAkgAAAAAAAAAAAAAAAAAAAACE5PQUhfTFNNABAACAAA0+ItNwAAABEACAAA1pFSPQAAAAEAEANl5rUAD8YgAA/GDwAGL94AAgBRTWFjaW50b3NoIEhEOlVzZXJzOgBtYW4uemhhbmc6AERlc2t0b3A6AE5PQUhfTFNNOgBJbXByb3ZlbWVudF9vZl9MYW5kIzM2NUZGMEYucGRmAAAOAG4ANgBJAG0AcAByAG8AdgBlAG0AZQBuAHQAXwBvAGYAXwBMAGEAbgBkAF8AUwB1AHIAZgBhAGMAZQBfAFMAawBpAG4AXwBUAGUAbQBwAGUAcgBhAHQAdQByAGUAXwBpAG4AXwBOAEMALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAFdVc2Vycy9tYW4uemhhbmcvRGVza3RvcC9OT0FIX0xTTS9JbXByb3ZlbWVudF9vZl9MYW5kX1N1cmZhY2VfU2tpbl9UZW1wZXJhdHVyZV9pbl9OQy5wZGYAABMAAS8AABUAAgAQ//8AAAAIAA0AGgAkAH0AAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACoQ==}, Date-Added = {2018-01-26 22:19:06 +0000}, Date-Modified = {2018-01-29 23:51:37 +0000}, Organization = {The 23rd Conference on Weather Analysis and Forecasting (WAF)/19th Conference on Numerical Weather Prediction(NWP)}, Title = {Improvement of land surface skin temperature in NCEP Operational NWP models and its impact on satellite Data Assimilation}, - Year = {2009}} + Year = {2009}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBWLi4vLi4vLi4vLi4vLi4vRGVza3RvcC9OT0FIX0xTTS9JbXByb3ZlbWVudF9vZl9MYW5kX1N1cmZhY2VfU2tpbl9UZW1wZXJhdHVyZV9pbl9OQy5wZGZPEQIgAAAAAAIgAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADT4djXSCsAAANl5rUfSW1wcm92ZW1lbnRfb2ZfTGFuZCMzNjVGRjBGLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA2X/D9aQ780AAAAAAAAAAAAFAAMAAAkgAAAAAAAAAAAAAAAAAAAACE5PQUhfTFNNABAACAAA0+ItNwAAABEACAAA1pFSPQAAAAEAEANl5rUAD8YgAA/GDwAGL94AAgBRTWFjaW50b3NoIEhEOlVzZXJzOgBtYW4uemhhbmc6AERlc2t0b3A6AE5PQUhfTFNNOgBJbXByb3ZlbWVudF9vZl9MYW5kIzM2NUZGMEYucGRmAAAOAG4ANgBJAG0AcAByAG8AdgBlAG0AZQBuAHQAXwBvAGYAXwBMAGEAbgBkAF8AUwB1AHIAZgBhAGMAZQBfAFMAawBpAG4AXwBUAGUAbQBwAGUAcgBhAHQAdQByAGUAXwBpAG4AXwBOAEMALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAFdVc2Vycy9tYW4uemhhbmcvRGVza3RvcC9OT0FIX0xTTS9JbXByb3ZlbWVudF9vZl9MYW5kX1N1cmZhY2VfU2tpbl9UZW1wZXJhdHVyZV9pbl9OQy5wZGYAABMAAS8AABUAAgAQ//8AAAAIAA0AGgAkAH0AAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACoQ==}} @article{chen_et_al_1997, Author = {F. Chen and Z. Janjic and K. Mitchell}, @@ -2016,11 +2016,11 @@ @url{Li_2015 Url = {http://cpo.noaa.gov/sites/cpo/MAPP/workshops/rtf_technical_ws/presentations/21_Xu_Li.pdf}, Bdsk-Url-1 = {http://cpo.noaa.gov/sites/cpo/MAPP/workshops/rtf_technical_ws/presentations/21_Xu_Li.pdf}} -@url{li_and_derber_2009, +@webpage{li_and_derber_2009, Author = {Xu Li and John Derber}, - Date-Modified = {2018-07-17 20:46:44 +0000}, + Date-Modified = {2020-02-24 17:06:35 +0000}, Title = {Near Sea Surface Temperatures (NSST) Analysis in NCEP GFS}, - Url = {https://www.jcsda.noaa.gov/documents/meetings/wkshp2008/4/JCSDA_2008_Li.pdf}, + Url = {http://data.jcsda.org/Workshops/6th-workshop-onDA/Session-4/JCSDA_2008_Li.pdf}, Bdsk-Url-1 = {https://www.jcsda.noaa.gov/documents/meetings/wkshp2008/4/JCSDA_2008_Li.pdf}} @article{Fairall_et_al_1996, @@ -2103,7 +2103,6 @@ @article{iacono_et_al_2008 @article{grant_2001, Abstract = {A closure for the fluxes of mass, heat, and moisture at cloud base in the cumulus-capped boundary layer is developed. The cloud-base mass flux is obtained from a simplifed turbulence kinetic energy (TKE) budget for the sub-cloud layer, in which cumulus convection is assumed to be associated with a transport of TKE from the sub-cloud layer to the cloud layer.The heat and moisture fluxes are obtained from a jump model based on the virtual-potential-temperature equation. A key part of this parametrization is the parametrization of the virtual-temperature flux at the top of the transition zone between the sub-cloud and cloud layers.It is argued that pressure fluctuations must be responsible for the transport of TKE from the cloud layer to the sub-cloud layer.}, Author = {A. L. M. Grant}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvR3JhbnQvMjAwMS5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAoiV4IMjAwMS5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAARgJuNOHLk4AAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABUdyYW50AAAQAAgAANHneLIAAAARAAgAANOHgq4AAAABABgAKIleAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AEdyYW50OgAyMDAxLnBkZgAADgASAAgAMgAwADAAMQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9HcmFudC8yMDAxLnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Date-Added = {2016-06-15 22:11:22 +0000}, Date-Modified = {2018-07-06 19:02:34 +0000}, Doi = {10.1002/qj.49712757209}, @@ -2117,13 +2116,13 @@ @article{grant_2001 Url = {http://dx.doi.org/10.1002/qj.49712757209}, Volume = {127}, Year = {2001}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvR3JhbnQvMjAwMS5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAoiV4IMjAwMS5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAARgJuNOHLk4AAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABUdyYW50AAAQAAgAANHneLIAAAARAAgAANOHgq4AAAABABgAKIleAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AEdyYW50OgAyMDAxLnBkZgAADgASAAgAMgAwADAAMQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9HcmFudC8yMDAxLnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Bdsk-Url-1 = {http://dx.doi.org/10.1002/qj.49712757209}} @article{zhang_and_wu_2003, Abstract = {Abstract This study uses a 2D cloud-resolving model to investigate the vertical transport of horizontal momentum and to understand the role of a convection-generated perturbation pressure field in the momentum transport by convective systems during part of the Tropical Ocean and Global Atmosphere Coupled Ocean?Atmosphere Response Experiment (TOGA COARE) Intensive Observation Period. It shows that convective updrafts transport a significant amount of momentum vertically. This transport is downgradient in the easterly wind regime, but upgradient during a westerly wind burst. The differences in convective momentum transport between easterly and westerly wind regimes are examined. The perturbation pressure gradient accounts for an important part of the apparent momentum source. In general it is opposite in sign to the product of cloud mass flux and the vertical wind shear, with smaller magnitude. Examination of the dynamic forcing to the pressure field demonstrates that the linear forcing representing the interaction between the convective updrafts and the large-scale wind shear is the dominant term, while the nonlinear forcing is of secondary importance. Thus, parameterization schemes taking into account the linear interaction between the convective updrafts and the large-scale wind shear can capture the essential features of the perturbation pressure field. The parameterization scheme for momentum transport by Zhang and Cho is evaluated using the model simulation data. The parameterized pressure gradient force using the scheme is in excellent agreement with the simulated one. The parameterized apparent momentum source is also in good agreement with the model simulation. Other parameterization methods for the pressure gradient are also discussed.}, Annote = {doi: 10.1175/1520-0469(2003)060<1120:CMTAPP>2.0.CO;2}, Author = {Zhang, Guang J. and Wu, Xiaoqing}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvWmhhbmcvMjAwMy5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAqjuYIMjAwMy5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFrUP9K0L8MAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABVpoYW5nAAAQAAgAANHneLIAAAARAAgAANK0kjMAAAABABgAKo7mAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AFpoYW5nOgAyMDAzLnBkZgAADgASAAgAMgAwADAAMwAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9aaGFuZy8yMDAzLnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Booktitle = {Journal of the Atmospheric Sciences}, Da = {2003/05/01}, Date-Added = {2016-06-14 23:39:50 +0000}, @@ -2142,13 +2141,13 @@ @article{zhang_and_wu_2003 Url = {http://dx.doi.org/10.1175/1520-0469(2003)060<1120:CMTAPP>2.0.CO;2}, Volume = {60}, Year = {2003}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvWmhhbmcvMjAwMy5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAqjuYIMjAwMy5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAFrUP9K0L8MAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABVpoYW5nAAAQAAgAANHneLIAAAARAAgAANK0kjMAAAABABgAKo7mAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AFpoYW5nOgAyMDAzLnBkZgAADgASAAgAMgAwADAAMwAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9aaGFuZy8yMDAzLnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/1520-0469(2003)060%3C1120:CMTAPP%3E2.0.CO;2}} @article{fritsch_and_chappell_1980, Abstract = {Abstract A parameterization formulation for incorporating the effects of midlatitude deep convection into mesoscale-numerical models is presented. The formulation is based on the hypothesis that the buoyant energy available to a parcel, in combination with a prescribed period of time for the convection to remove that energy, can be used to regulate the amount of convection in a mesoscale numerical model grid element. Individual clouds are represented as entraining moist updraft and downdraft plumes. The fraction of updraft condensate evaporated in moist downdrafts is determined from an empirical relationship between the vertical shear of the horizontal wind and precipitation efficiency. Vertical transports of horizontal momentum and warming by compensating subsidence are included in the parameterization. Since updraft and downdraft areas are sometimes a substantial fraction of mesoscale model grid-element areas, grid-point temperatures (adjusted for convection) are an area-weighted mean of updraft, downdraft and environmental temperatures.}, Annote = {doi: 10.1175/1520-0469(1980)037<1722:NPOCDM>2.0.CO;2}, Author = {Fritsch, J. M. and Chappell, C. F.}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBDLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvRnJpdHNjaC8xOTgwLnBkZk8RAcoAAAAAAcoAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAARCuMwgxOTgwLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABEKs103xvpgAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAHRnJpdHNjaAAAEAAIAADR53iyAAAAEQAIAADTfMQGAAAAAQAYARCuMwAobJYAKGyLAChnewAbXgcAAphcAAIAXU1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBGcml0c2NoOgAxOTgwLnBkZgAADgASAAgAMQA5ADgAMAAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9Gcml0c2NoLzE5ODAucGRmABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGoAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOA==}, Booktitle = {Journal of the Atmospheric Sciences}, Da = {1980/08/01}, Date = {1980/08/01}, @@ -2169,12 +2168,12 @@ @article{fritsch_and_chappell_1980 Volume = {37}, Year = {1980}, Year1 = {1980}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBDLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvRnJpdHNjaC8xOTgwLnBkZk8RAcoAAAAAAcoAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAARCuMwgxOTgwLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABEKs103xvpgAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAHRnJpdHNjaAAAEAAIAADR53iyAAAAEQAIAADTfMQGAAAAAQAYARCuMwAobJYAKGyLAChnewAbXgcAAphcAAIAXU1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBGcml0c2NoOgAxOTgwLnBkZgAADgASAAgAMQA5ADgAMAAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9Gcml0c2NoLzE5ODAucGRmABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGoAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOA==}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/1520-0469(1980)037%3C1722:NPOCDM%3E2.0.CO;2}} @article{bechtold_et_al_2008, Abstract = {Advances in simulating atmospheric variability with the ECMWF model are presented that stem from revisions of the convection and diffusion parametrizations. The revisions concern in particular the introduction of a variable convective adjustment time-scale, a convective entrainment rate proportional to the environmental relative humidity, as well as free tropospheric diffusion coefficients for heat and momentum based on Monin--Obukhov functional dependencies.The forecasting system is evaluated against analyses and observations using high-resolution medium-range deterministic and ensemble forecasts, monthly and seasonal integrations, and decadal integrations with coupled atmosphere-ocean models. The results show a significantly higher and more realistic level of model activity in terms of the amplitude of tropical and extratropical mesoscale, synoptic and planetary perturbations. Importantly, with the higher variability and reduced bias not only the probabilistic scores are improved, but also the midlatitude deterministic scores in the short and medium ranges. Furthermore, for the first time the model is able to represent a realistic spectrum of convectively coupled equatorial Kelvin and Rossby waves, and maintains a realistic amplitude of the Madden--Julian oscillation (MJO) during monthly forecasts. However, the propagation speed of the MJO is slower than observed. The higher tropical tropospheric wave activity also results in better stratospheric temperatures and winds through the deposition of momentum.The partitioning between convective and resolved precipitation is unaffected by the model changes with roughly 62% of the total global precipitation being of the convective type. Finally, the changes in convection and diffusion parametrizations resulted in a larger spread of the ensemble forecasts, which allowed the amplitude of the initial perturbations in the ensemble prediction system to decrease by 30%. Copyright {\copyright} 2008 Royal Meteorological Society}, Author = {Bechtold, Peter and K{\"o}hler, Martin and Jung, Thomas and Doblas-Reyes, Francisco and Leutbecher, Martin and Rodwell, Mark J. and Vitart, Frederic and Balsamo, Gianpaolo}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBELi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQmVjaHRvbGQvMjAwOC5wZGZPEQHMAAAAAAHMAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAobfkIMjAwOC5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAARZce9OEjEwAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAACEJlY2h0b2xkABAACAAA0ed4sgAAABEACAAA04TgrAAAAAEAGAAobfkAKGyWAChsiwAoZ3sAG14HAAKYXAACAF5NYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAQmVjaHRvbGQ6ADIwMDgucGRmAA4AEgAIADIAMAAwADgALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEtVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQmVjaHRvbGQvMjAwOC5wZGYAABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGsAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOw==}, Date-Added = {2016-06-14 23:11:58 +0000}, Date-Modified = {2016-06-14 23:11:58 +0000}, Doi = {10.1002/qj.289}, @@ -2188,12 +2187,12 @@ @article{bechtold_et_al_2008 Url = {http://dx.doi.org/10.1002/qj.289}, Volume = {134}, Year = {2008}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBELi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQmVjaHRvbGQvMjAwOC5wZGZPEQHMAAAAAAHMAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAobfkIMjAwOC5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAARZce9OEjEwAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAACEJlY2h0b2xkABAACAAA0ed4sgAAABEACAAA04TgrAAAAAEAGAAobfkAKGyWAChsiwAoZ3sAG14HAAKYXAACAF5NYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAQmVjaHRvbGQ6ADIwMDgucGRmAA4AEgAIADIAMAAwADgALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEtVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQmVjaHRvbGQvMjAwOC5wZGYAABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGsAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOw==}, Bdsk-Url-1 = {http://dx.doi.org/10.1002/qj.289}} @article{han_and_pan_2011, Annote = {doi: 10.1175/WAF-D-10-05038.1}, Author = {Han, Jongil and Pan, Hua-Lu}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxA/Li4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSGFuLzIwMTEucGRmTxEBvgAAAAABvgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAWsT5CDIwMTEucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADC1cfTGvlvAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAANIYW4AABAACAAA0ed4sgAAABEACAAA0xtNzwAAAAEAGABaxPkAKGyWAChsiwAoZ3sAG14HAAKYXAACAFlNYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoASGFuOgAyMDExLnBkZgAADgASAAgAMgAwADEAMQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIARlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9IYW4vMjAxMS5wZGYAEwABLwAAFQACAA3//wAAAAgADQAaACQAZgAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIo}, Booktitle = {Weather and Forecasting}, Da = {2011/08/01}, Date = {2011/08/01}, @@ -2214,22 +2213,22 @@ @article{han_and_pan_2011 Volume = {26}, Year = {2011}, Year1 = {2011}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxA/Li4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSGFuLzIwMTEucGRmTxEBvgAAAAABvgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAWsT5CDIwMTEucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADC1cfTGvlvAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAANIYW4AABAACAAA0ed4sgAAABEACAAA0xtNzwAAAAEAGABaxPkAKGyWAChsiwAoZ3sAG14HAAKYXAACAFlNYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoASGFuOgAyMDExLnBkZgAADgASAAgAMgAwADEAMQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIARlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9IYW4vMjAxMS5wZGYAEwABLwAAFQACAA3//wAAAAgADQAaACQAZgAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIo}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/WAF-D-10-05038.1}} @article{pan_and_wu_1995, Author = {Pan, H. -L. and W.-S. Wu}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxA/Li4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvUGFuLzE5OTUucGRmTxEBvgAAAAABvgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAwtTNCDE5OTUucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADCtU/TGvMJAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAANQYW4AABAACAAA0ed4sgAAABEACAAA0xtHaQAAAAEAGADC1M0AKGyWAChsiwAoZ3sAG14HAAKYXAACAFlNYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAUGFuOgAxOTk1LnBkZgAADgASAAgAMQA5ADkANQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIARlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9QYW4vMTk5NS5wZGYAEwABLwAAFQACAA3//wAAAAgADQAaACQAZgAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIo}, Date-Added = {2016-06-14 23:06:41 +0000}, Date-Modified = {2016-06-14 23:06:41 +0000}, Journal = {NMC Office Note, No. 409}, Pages = {40pp}, Title = {Implementing a Mass Flux Convection Parameterization Package for the NMC Medium-Range Forecast Model}, - Year = {1995}} + Year = {1995}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxA/Li4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvUGFuLzE5OTUucGRmTxEBvgAAAAABvgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAwtTNCDE5OTUucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAADCtU/TGvMJAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAANQYW4AABAACAAA0ed4sgAAABEACAAA0xtHaQAAAAEAGADC1M0AKGyWAChsiwAoZ3sAG14HAAKYXAACAFlNYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAUGFuOgAxOTk1LnBkZgAADgASAAgAMQA5ADkANQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIARlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9QYW4vMTk5NS5wZGYAEwABLwAAFQACAA3//wAAAAgADQAaACQAZgAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIo}} @article{grell_1993, Annote = {doi: 10.1175/1520-0493(1993)121<0764:PEOAUB>2.0.CO;2}, Author = {Grell, Georg A.}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvR3JlbGwvMTk5My5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAoie0IMTk5My5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMK4dtMa9LMAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABUdyZWxsAAAQAAgAANHneLIAAAARAAgAANMbSRMAAAABABgAKIntAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AEdyZWxsOgAxOTkzLnBkZgAADgASAAgAMQA5ADkAMwAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9HcmVsbC8xOTkzLnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Booktitle = {Monthly Weather Review}, Da = {1993/03/01}, Date = {1993/03/01}, @@ -2250,11 +2249,11 @@ @article{grell_1993 Volume = {121}, Year = {1993}, Year1 = {1993}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvR3JlbGwvMTk5My5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAoie0IMTk5My5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAMK4dtMa9LMAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABUdyZWxsAAAQAAgAANHneLIAAAARAAgAANMbSRMAAAABABgAKIntAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AEdyZWxsOgAxOTkzLnBkZgAADgASAAgAMQA5ADkAMwAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9HcmVsbC8xOTkzLnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/1520-0493(1993)121%3C0764:PEOAUB%3E2.0.CO;2}} @article{arakawa_and_schubert_1974, Author = {Arakawa, A and Schubert, WH}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBDLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQXJha2F3YS8xOTc0LnBkZk8RAcoAAAAAAcoAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAAChtVQgxOTc0LnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKG1ctM8h9AAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAHQXJha2F3YQAAEAAIAADR53iyAAAAEQAIAAC0z4RkAAAAAQAYAChtVQAobJYAKGyLAChnewAbXgcAAphcAAIAXU1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBBcmFrYXdhOgAxOTc0LnBkZgAADgASAAgAMQA5ADcANAAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9BcmFrYXdhLzE5NzQucGRmABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGoAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOA==}, Date-Added = {2016-06-14 23:04:30 +0000}, Date-Modified = {2018-07-18 19:00:17 +0000}, Isi = {A1974S778800004}, @@ -2267,6 +2266,7 @@ @article{arakawa_and_schubert_1974 Title = {Interaction of a cumulus cloud ensemble with the large-scale environment, Part I}, Volume = {31}, Year = {1974}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBDLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQXJha2F3YS8xOTc0LnBkZk8RAcoAAAAAAcoAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAAChtVQgxOTc0LnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKG1ctM8h9AAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAHQXJha2F3YQAAEAAIAADR53iyAAAAEQAIAAC0z4RkAAAAAQAYAChtVQAobJYAKGyLAChnewAbXgcAAphcAAIAXU1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBBcmFrYXdhOgAxOTc0LnBkZgAADgASAAgAMQA5ADcANAAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9BcmFrYXdhLzE5NzQucGRmABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGoAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOA==}, Bdsk-Url-1 = {http://ws.isiknowledge.com/cps/openurl/service?url_ver=Z39.88-2004&rft_id=info:ut/A1974S778800004}} @article{harshvardhan_et_al_1989, @@ -2500,7 +2500,6 @@ @article{akmaev_1991 @article{siebesma_et_al_2007, Abstract = {A better conceptual understanding and more realistic parameterizations of convective boundary layers in climate and weather prediction models have been major challenges in meteorological research. In particular, parameterizations of the dry convective boundary layer, in spite of the absence of water phase-changes and its consequent simplicity as compared to moist convection, typically suffer from problems in attempting to represent realistically the boundary layer growth and what is often referred to as countergradient fluxes. The eddy-diffusivity (ED) approach has been relatively successful in representing some characteristics of neutral boundary layers and surface layers in general. The mass-flux (MF) approach, on the other hand, has been used for the parameterization of shallow and deep moist convection. In this paper, a new approach that relies on a combination of the ED and MF parameterizations (EDMF) is proposed for the dry convective boundary layer. It is shown that the EDMF approach follows naturally from a decomposition of the turbulent fluxes into 1) a part that includes strong organized updrafts, and 2) a remaining turbulent field. At the basis of the EDMF approach is the concept that nonlocal subgrid transport due to the strong updrafts is taken into account by the MF approach, while the remaining transport is taken into account by an ED closure. Large-eddy simulation (LES) results of the dry convective boundary layer are used to support the theoretical framework of this new approach and to determine the parameters of the EDMF model. The performance of the new formulation is evaluated against LES results, and it is shown that the EDMF closure is able to reproduce the main properties of dry convective boundary layers in a realistic manner. Furthermore, it will be shown that this approach has strong advantages over the more traditional countergradient approach, especially in the entrainment layer. As a result, this EDMF approach opens the way to parameterize the clear and cumulus-topped boundary layer in a simple and unified way.}, Author = {Siebesma, A. Pier and Soares, Pedro M. M. and Teixeira, Joao}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBELi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU2llYmVzbWEvMjAwNy5wZGZPEQHMAAAAAAHMAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAqYEwIMjAwNy5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACphyMc7+4hQREYgQ0FSTwACAAUAAAkgAAAAAAAAAAAAAAAAAAAACFNpZWJlc21hABAACAAA0ed4sgAAABEACAAAxzxd+AAAAAEAGAAqYEwAKGyWAChsiwAoZ3sAG14HAAKYXAACAF5NYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAU2llYmVzbWE6ADIwMDcucGRmAA4AEgAIADIAMAAwADcALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEtVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU2llYmVzbWEvMjAwNy5wZGYAABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGsAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOw==}, Date-Added = {2016-05-20 17:17:49 +0000}, Date-Modified = {2016-05-20 17:17:49 +0000}, Doi = {DOI 10.1175/JAS3888.1}, @@ -2514,12 +2513,12 @@ @article{siebesma_et_al_2007 Title = {A combined eddy-diffusivity mass-flux approach for the convective boundary layer}, Volume = {64}, Year = {2007}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBELi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU2llYmVzbWEvMjAwNy5wZGZPEQHMAAAAAAHMAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAqYEwIMjAwNy5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACphyMc7+4hQREYgQ0FSTwACAAUAAAkgAAAAAAAAAAAAAAAAAAAACFNpZWJlc21hABAACAAA0ed4sgAAABEACAAAxzxd+AAAAAEAGAAqYEwAKGyWAChsiwAoZ3sAG14HAAKYXAACAF5NYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAU2llYmVzbWE6ADIwMDcucGRmAA4AEgAIADIAMAAwADcALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEtVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU2llYmVzbWEvMjAwNy5wZGYAABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGsAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOw==}, Bdsk-Url-1 = {http://ws.isiknowledge.com/cps/openurl/service?url_ver=Z39.88-2004&rft_id=info:ut/000245742600011}} @article{soares_et_al_2004, Abstract = {Recently, a new consistent way of parametrizing simultaneously local and non-local turbulent transport for the convective atmospheric boundary layer has been proposed and tested for the clear boundary layer. This approach assumes that in the convective boundary layer the subgrid-scale fluxes result from two different mixing scales: small eddies, that are parametrized by an eddy-diffusivity approach, and thermals, which are represented by a mass-flux contribution. Since the interaction between the cloud layer and the underlying sub-cloud layer predominantly takes place through strong updraughts, this approach offers an interesting avenue of establishing a unified description of the turbulent transport in the cumulus-topped boundary layer. This paper explores the possibility of such a new approach for the cumulus-topped boundary layer. In the sub-cloud and cloud layers, the mass-flux term represents the effect of strong updraughts. These are modelled by a simple entraining parcel, which determines the mean properties of the strong updraughts, the boundary-layer height, the lifting condensation level and cloud top. The residual smaller-scale turbulent transport is parametrized with an eddy-diffusivity approach that uses a turbulent kinetic energy closure. The new scheme is implemented and tested in the research model MesoNH. Copyright {\copyright} 2004 Royal Meteorological Society}, Author = {Soares, P. M. M. and Miranda, P. M. A. and Siebesma, A. P. and Teixeira, J.}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBCLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU29hcmVzLzIwMDQucGRmTxEBxgAAAAABxgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAWIC2CDIwMDQucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABYf6DSsqNwAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAAZTb2FyZXMAEAAIAADR53iyAAAAEQAIAADSswXgAAAAAQAYAFiAtgAobJYAKGyLAChnewAbXgcAAphcAAIAXE1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBTb2FyZXM6ADIwMDQucGRmAA4AEgAIADIAMAAwADQALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAElVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU29hcmVzLzIwMDQucGRmAAATAAEvAAAVAAIADf//AAAACAANABoAJABpAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjM=}, Date-Added = {2016-05-20 17:17:49 +0000}, Date-Modified = {2016-05-20 17:17:49 +0000}, Doi = {10.1256/qj.03.223}, @@ -2533,11 +2532,11 @@ @article{soares_et_al_2004 Url = {http://dx.doi.org/10.1256/qj.03.223}, Volume = {130}, Year = {2004}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBCLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU29hcmVzLzIwMDQucGRmTxEBxgAAAAABxgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAWIC2CDIwMDQucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABYf6DSsqNwAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAAZTb2FyZXMAEAAIAADR53iyAAAAEQAIAADSswXgAAAAAQAYAFiAtgAobJYAKGyLAChnewAbXgcAAphcAAIAXE1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBTb2FyZXM6ADIwMDQucGRmAA4AEgAIADIAMAAwADQALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAElVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvU29hcmVzLzIwMDQucGRmAAATAAEvAAAVAAIADf//AAAACAANABoAJABpAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjM=}, Bdsk-Url-1 = {http://dx.doi.org/10.1256/qj.03.223}} @article{troen_and_mahrt_1986, Author = {Troen, IB and Mahrt, L.}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvVHJvZW4vMTk4Ni5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAABNeegIMTk4Ni5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAE13kNKUWwUAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABVRyb2VuAAAQAAgAANHneLIAAAARAAgAANKUvXUAAAABABgATXnoAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AFRyb2VuOgAxOTg2LnBkZgAADgASAAgAMQA5ADgANgAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9Ucm9lbi8xOTg2LnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Date-Added = {2016-05-20 17:17:49 +0000}, Date-Modified = {2016-05-20 17:17:49 +0000}, Doi = {10.1007/BF00122760}, @@ -2551,13 +2550,13 @@ @article{troen_and_mahrt_1986 Url = {http://dx.doi.org/10.1007/BF00122760}, Volume = {37}, Year = {1986}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvVHJvZW4vMTk4Ni5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAABNeegIMTk4Ni5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAE13kNKUWwUAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAABVRyb2VuAAAQAAgAANHneLIAAAARAAgAANKUvXUAAAABABgATXnoAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AFRyb2VuOgAxOTg2LnBkZgAADgASAAgAMQA5ADgANgAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9Ucm9lbi8xOTg2LnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Bdsk-Url-1 = {http://dx.doi.org/10.1007/BF00122760}} @article{macvean_and_mason_1990, Abstract = {Abstract In a recent paper, Kuo and Schubert demonstrated the lack of observational support for the relevance of the criterion for cloud-top entrainment instability proposed by Randall and by Deardorff. Here we derive a new criterion, based on a model of the instability as resulting from the energy released close to cloud top, by Mixing between saturated boundary-layer air and unsaturated air from above the capping inversion. The condition is derived by considering the net conversion from potential to kinetic energy in a system consisting of two layers of fluid straddling cloud-top, when a small amount of mixing occurs between these layers. This contrasts with previous analyses, which only considered the change in buoyancy of the cloud layer when unsaturated air is mixed into it. In its most general form, this new criterion depends on the ratio of the depths of the layers involved in the mixing. It is argued that, for a self-sustaining instability, there must be a net release of kinetic energy on the same depth and time scales as the entrainment process itself. There are two plausible ways in which this requirement may be satisfied. Either one takes the depths of the layers involved in the mixing to each be comparable to the vertical scale of the entrainment process, which is typically of order tens of meters or less, or alternatively, one must allow for the efficiency with which energy released by mixing through a much deeper lower layer becomes available to initiate further entrainment. In both cases the same criterion for instability results. This criterion is much more restrictive than that proposed by Randall and by Deardorff; furthermore, the observational data is then consistent with the predictions of the current theory. Further analysis provides estimates of the turbulent fluxes associated with cloud-top entrainment instability. This analysis effectively constitutes an energetically consistent turbulence closure for models of boundary layers with cloud. The implications for such numerical models are discussed. Comparisons are also made with other possible criteria for cloud-top entrainment instability which have recently been suggested.}, Annote = {doi: 10.1175/1520-0469(1990)047<1012:CTEITS>2.0.CO;2}, Author = {MacVean, M. K. and Mason, P. J.}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBDLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTWFjVmVhbi8xOTkwLnBkZk8RAcoAAAAAAcoAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAAFx8zwgxOTkwLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAXHyn0rkkRQAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAHTWFjVmVhbgAAEAAIAADR53iyAAAAEQAIAADSuYa1AAAAAQAYAFx8zwAobJYAKGyLAChnewAbXgcAAphcAAIAXU1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBNYWNWZWFuOgAxOTkwLnBkZgAADgASAAgAMQA5ADkAMAAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9NYWNWZWFuLzE5OTAucGRmABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGoAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOA==}, Booktitle = {Journal of the Atmospheric Sciences}, Da = {1990/04/01}, Date-Added = {2016-05-20 17:16:05 +0000}, @@ -2576,11 +2575,11 @@ @article{macvean_and_mason_1990 Url = {http://dx.doi.org/10.1175/1520-0469(1990)047<1012:CTEITS>2.0.CO;2}, Volume = {47}, Year = {1990}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBDLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTWFjVmVhbi8xOTkwLnBkZk8RAcoAAAAAAcoAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAAFx8zwgxOTkwLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAXHyn0rkkRQAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAHTWFjVmVhbgAAEAAIAADR53iyAAAAEQAIAADSuYa1AAAAAQAYAFx8zwAobJYAKGyLAChnewAbXgcAAphcAAIAXU1hY2ludG9zaCBIRDpVc2VyczoAZ3JhbnRmOgBDbG91ZFN0YXRpb246AGZpcmxfbGlicmFyeToAZmlybF9saWJyYXJ5X2ZpbGVzOgBNYWNWZWFuOgAxOTkwLnBkZgAADgASAAgAMQA5ADkAMAAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9NYWNWZWFuLzE5OTAucGRmABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGoAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOA==}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/1520-0469(1990)047%3C1012:CTEITS%3E2.0.CO;2}} @article{louis_1979, Author = {Louis, JF}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTG91aXMvMTk3OS5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAonogIMTk3OS5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACiej8FuU4pQREYgQ0FSTwACAAUAAAkgAAAAAAAAAAAAAAAAAAAABUxvdWlzAAAQAAgAANHneLIAAAARAAgAAMFutfoAAAABABgAKJ6IAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AExvdWlzOgAxOTc5LnBkZgAADgASAAgAMQA5ADcAOQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9Mb3Vpcy8xOTc5LnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Date-Added = {2016-05-20 17:15:52 +0000}, Date-Modified = {2016-05-20 17:15:52 +0000}, Isi = {A1979HT69700004}, @@ -2593,12 +2592,12 @@ @article{louis_1979 Title = {A PARAMETRIC MODEL OF VERTICAL EDDY FLUXES IN THE ATMOSPHERE}, Volume = {17}, Year = {1979}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBBLi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTG91aXMvMTk3OS5wZGZPEQHEAAAAAAHEAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAonogIMTk3OS5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACiej8FuU4pQREYgQ0FSTwACAAUAAAkgAAAAAAAAAAAAAAAAAAAABUxvdWlzAAAQAAgAANHneLIAAAARAAgAAMFutfoAAAABABgAKJ6IAChslgAobIsAKGd7ABteBwACmFwAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AExvdWlzOgAxOTc5LnBkZgAADgASAAgAMQA5ADcAOQAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIASFVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9Mb3Vpcy8xOTc5LnBkZgATAAEvAAAVAAIADf//AAAACAANABoAJABoAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAjA=}, Bdsk-Url-1 = {http://ws.isiknowledge.com/cps/openurl/service?url_ver=Z39.88-2004&rft_id=info:ut/A1979HT69700004}} @article{lock_et_al_2000, Abstract = {A new boundary layer turbulent mixing scheme has been developed for use in the UKMO weather forecasting and climate prediction models. This includes a representation of nonlocal mixing (driven by both surface fluxes and cloud-top processes) in unstable layers, either coupled to or decoupled from the surface, and an explicit entrainment parameterization. The scheme is formulated in moist conserved variables so that it can treat both dry and cloudy layers. Details of the scheme and examples of its performance in single-column model tests are presented.}, Author = {Lock, AP and Brown, AR and Bush, MR and Martin, GM and Smith, RNB}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBALi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTG9jay8yMDAwLnBkZk8RAcAAAAAAAcAAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAACibewgyMDAwLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKJuLywPrPAAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAETG9jawAQAAgAANHneLIAAAARAAgAAMsETawAAAABABgAKJt7AChslgAobIsAKGd7ABteBwACmFwAAgBaTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AExvY2s6ADIwMDAucGRmAA4AEgAIADIAMAAwADAALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEdVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTG9jay8yMDAwLnBkZgAAEwABLwAAFQACAA3//wAAAAgADQAaACQAZwAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIr}, Date-Added = {2016-05-20 17:15:36 +0000}, Date-Modified = {2016-05-20 17:15:36 +0000}, Isi = {000089461100008}, @@ -2611,13 +2610,13 @@ @article{lock_et_al_2000 Title = {A new boundary layer mixing scheme. {P}art {I}: Scheme description and single-column model tests}, Volume = {128}, Year = {2000}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBALi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTG9jay8yMDAwLnBkZk8RAcAAAAAAAcAAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAACibewgyMDAwLnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKJuLywPrPAAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAETG9jawAQAAgAANHneLIAAAARAAgAAMsETawAAAABABgAKJt7AChslgAobIsAKGd7ABteBwACmFwAAgBaTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AExvY2s6ADIwMDAucGRmAA4AEgAIADIAMAAwADAALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEdVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvTG9jay8yMDAwLnBkZgAAEwABLwAAFQACAA3//wAAAAgADQAaACQAZwAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIr}, Bdsk-Url-1 = {http://ws.isiknowledge.com/cps/openurl/service?url_ver=Z39.88-2004&rft_id=info:ut/000089461100008}} @article{hong_and_pan_1996, Abstract = {Abstract In this paper, the incorporation of a simple atmospheric boundary layer diffusion scheme into the NCEP Medium-Range Forecast Model is described. A boundary layer diffusion package based on the Troen and Mahrt nonlocal diffusion concept has been tested for possible operational implementation. The results from this approach are compared with those from the local diffusion approach, which is the current operational scheme, and verified against FIFE observations during 9?10 August 1987. The comparisons between local and nonlocal approaches are extended to the forecast for a heavy rain case of 15?17 May 1995. The sensitivity of both the boundary layer development and the precipitation forecast to the tuning parameters in the nonlocal diffusion scheme is also investigated. Special attention is given to the interaction of boundary layer processes with precipitation physics. Some results of parallel runs during August 1995 are also presented.}, Annote = {doi: 10.1175/1520-0493(1996)124<2322:NBLVDI>2.0.CO;2}, Author = {Hong, Song-You and Pan, Hua-Lu}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBALi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSG9uZy8xOTk2LnBkZk8RAcAAAAAAAcAAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAAE18FggxOTk2LnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAATXvY0pRb8QAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAESG9uZwAQAAgAANHneLIAAAARAAgAANKUvmEAAAABABgATXwWAChslgAobIsAKGd7ABteBwACmFwAAgBaTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AEhvbmc6ADE5OTYucGRmAA4AEgAIADEAOQA5ADYALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEdVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSG9uZy8xOTk2LnBkZgAAEwABLwAAFQACAA3//wAAAAgADQAaACQAZwAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIr}, Booktitle = {Monthly Weather Review}, Da = {1996/10/01}, Date = {1996/10/01}, @@ -2638,13 +2637,13 @@ @article{hong_and_pan_1996 Volume = {124}, Year = {1996}, Year1 = {1996}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBALi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSG9uZy8xOTk2LnBkZk8RAcAAAAAAAcAAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAANHnJFJIKwAAAE18FggxOTk2LnBkZgAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAATXvY0pRb8QAAAAAAAAAAAAIABQAACSAAAAAAAAAAAAAAAAAAAAAESG9uZwAQAAgAANHneLIAAAARAAgAANKUvmEAAAABABgATXwWAChslgAobIsAKGd7ABteBwACmFwAAgBaTWFjaW50b3NoIEhEOlVzZXJzOgBncmFudGY6AENsb3VkU3RhdGlvbjoAZmlybF9saWJyYXJ5OgBmaXJsX2xpYnJhcnlfZmlsZXM6AEhvbmc6ADE5OTYucGRmAA4AEgAIADEAOQA5ADYALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEdVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSG9uZy8xOTk2LnBkZgAAEwABLwAAFQACAA3//wAAAAgADQAaACQAZwAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIr}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/1520-0493(1996)124%3C2322:NBLVDI%3E2.0.CO;2}} @article{han_and_pan_2006, Abstract = {Abstract A parameterization of the convection-induced pressure gradient force (PGF) in convective momentum transport (CMT) is tested for hurricane intensity forecasting using NCEP's operational Global Forecast System (GFS) and its nested Regional Spectral Model (RSM). In the parameterization the PGF is assumed to be proportional to the product of the cloud mass flux and vertical wind shear. Compared to control forecasts using the present operational GFS and RSM where the PGF effect in CMT is taken into account empirically, the new PGF parameterization helps increase hurricane intensity by reducing the vertical momentum exchange, giving rise to a closer comparison to the observations. In addition, the new PGF parameterization forecasts not only show more realistically organized precipitation patterns with enhanced hurricane intensity but also reduce the forecast track error. Nevertheless, the model forecasts with the new PGF parameterization still largely underpredict the observed intensity. One of the many possible reasons for the large underprediction may be the absence of hurricane initialization in the models.}, Annote = {doi: 10.1175/MWR3090.1}, Author = {Han, Jongil and Pan, Hua-Lu}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxA/Li4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSGFuLzIwMDYucGRmTxEBvgAAAAABvgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAWsT5CDIwMDYucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABazFjStCvVAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAANIYW4AABAACAAA0ed4sgAAABEACAAA0rSORQAAAAEAGABaxPkAKGyWAChsiwAoZ3sAG14HAAKYXAACAFlNYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoASGFuOgAyMDA2LnBkZgAADgASAAgAMgAwADAANgAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIARlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9IYW4vMjAwNi5wZGYAEwABLwAAFQACAA3//wAAAAgADQAaACQAZgAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIo}, Booktitle = {Monthly Weather Review}, Da = {2006/02/01}, Date-Added = {2016-05-20 17:11:17 +0000}, @@ -2663,11 +2662,11 @@ @article{han_and_pan_2006 Url = {http://dx.doi.org/10.1175/MWR3090.1}, Volume = {134}, Year = {2006}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxA/Li4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvSGFuLzIwMDYucGRmTxEBvgAAAAABvgACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAA0eckUkgrAAAAWsT5CDIwMDYucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABazFjStCvVAAAAAAAAAAAAAgAFAAAJIAAAAAAAAAAAAAAAAAAAAANIYW4AABAACAAA0ed4sgAAABEACAAA0rSORQAAAAEAGABaxPkAKGyWAChsiwAoZ3sAG14HAAKYXAACAFlNYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoASGFuOgAyMDA2LnBkZgAADgASAAgAMgAwADAANgAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIARlVzZXJzL2dyYW50Zi9DbG91ZFN0YXRpb24vZmlybF9saWJyYXJ5L2ZpcmxfbGlicmFyeV9maWxlcy9IYW4vMjAwNi5wZGYAEwABLwAAFQACAA3//wAAAAgADQAaACQAZgAAAAAAAAIBAAAAAAAAAAUAAAAAAAAAAAAAAAAAAAIo}, Bdsk-Url-1 = {http://dx.doi.org/10.1175/MWR3090.1}} @article{businger_et_al_1971, Author = {Businger, JA and Wyngaard, JC and Izumi, Y and Bradley, EF}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBELi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQnVzaW5nZXIvMTk3MS5wZGZPEQHMAAAAAAHMAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAodUUIMTk3MS5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACh1cbTPIxwAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAACEJ1c2luZ2VyABAACAAA0ed4sgAAABEACAAAtM+FjAAAAAEAGAAodUUAKGyWAChsiwAoZ3sAG14HAAKYXAACAF5NYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAQnVzaW5nZXI6ADE5NzEucGRmAA4AEgAIADEAOQA3ADEALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEtVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQnVzaW5nZXIvMTk3MS5wZGYAABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGsAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOw==}, Date-Added = {2016-05-20 17:10:50 +0000}, Date-Modified = {2018-07-18 18:58:08 +0000}, Isi = {A1971I822800004}, @@ -2680,6 +2679,7 @@ @article{businger_et_al_1971 Title = {Flux-profile relationships in the atmospheric surface layer}, Volume = {28}, Year = {1971}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxBELi4vLi4vQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQnVzaW5nZXIvMTk3MS5wZGZPEQHMAAAAAAHMAAIAAAxNYWNpbnRvc2ggSEQAAAAAAAAAAAAAAAAAAADR5yRSSCsAAAAodUUIMTk3MS5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACh1cbTPIxwAAAAAAAAAAAACAAUAAAkgAAAAAAAAAAAAAAAAAAAACEJ1c2luZ2VyABAACAAA0ed4sgAAABEACAAAtM+FjAAAAAEAGAAodUUAKGyWAChsiwAoZ3sAG14HAAKYXAACAF5NYWNpbnRvc2ggSEQ6VXNlcnM6AGdyYW50ZjoAQ2xvdWRTdGF0aW9uOgBmaXJsX2xpYnJhcnk6AGZpcmxfbGlicmFyeV9maWxlczoAQnVzaW5nZXI6ADE5NzEucGRmAA4AEgAIADEAOQA3ADEALgBwAGQAZgAPABoADABNAGEAYwBpAG4AdABvAHMAaAAgAEgARAASAEtVc2Vycy9ncmFudGYvQ2xvdWRTdGF0aW9uL2ZpcmxfbGlicmFyeS9maXJsX2xpYnJhcnlfZmlsZXMvQnVzaW5nZXIvMTk3MS5wZGYAABMAAS8AABUAAgAN//8AAAAIAA0AGgAkAGsAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACOw==}, Bdsk-Url-1 = {http://ws.isiknowledge.com/cps/openurl/service?url_ver=Z39.88-2004&rft_id=info:ut/A1971I822800004}} @article{xu_and_randall_1996, @@ -2870,18 +2870,17 @@ @article{kim_and_arakawa_1995 @techreport{hou_et_al_2002, Author = {Y. Hou and S. Moorthi and K. Campana}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxAiLi4vLi4vemhhbmctbGliL2hvdV9ldF9hbF8yMDAyLnBkZk8RAdwAAAAAAdwAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAAM/T1mZIKwAAAFKkjRJob3VfZXRfYWxfMjAwMi5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUqai02OGCgAAAAAAAAAAAAIAAgAACSAAAAAAAAAAAAAAAAAAAAAJemhhbmctbGliAAAQAAgAAM/UKsYAAAARAAgAANNj2moAAAABABgAUqSNAE1lSgAj19QACTbFAAk2xAACZvkAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBtYW56aGFuZzoARG9jdW1lbnRzOgBNYW4uWmhhbmc6AGdtdGItZG9jOgB6aGFuZy1saWI6AGhvdV9ldF9hbF8yMDAyLnBkZgAADgAmABIAaABvAHUAXwBlAHQAXwBhAGwAXwAyADAAMAAyAC4AcABkAGYADwAaAAwATQBhAGMAaQBuAHQAbwBzAGgAIABIAEQAEgBIVXNlcnMvbWFuemhhbmcvRG9jdW1lbnRzL01hbi5aaGFuZy9nbXRiLWRvYy96aGFuZy1saWIvaG91X2V0X2FsXzIwMDIucGRmABMAAS8AABUAAgAP//8AAAAIAA0AGgAkAEkAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACKQ==}, Date-Added = {2016-05-19 19:52:22 +0000}, Date-Modified = {2016-05-20 15:14:59 +0000}, Institution = {NCEP}, Number = {441}, Title = {Parameterization of Solar Radiation Transfer}, Type = {office note}, - Year = {2002}} + Year = {2002}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxAiLi4vLi4vemhhbmctbGliL2hvdV9ldF9hbF8yMDAyLnBkZk8RAdwAAAAAAdwAAgAADE1hY2ludG9zaCBIRAAAAAAAAAAAAAAAAAAAAM/T1mZIKwAAAFKkjRJob3VfZXRfYWxfMjAwMi5wZGYAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAUqai02OGCgAAAAAAAAAAAAIAAgAACSAAAAAAAAAAAAAAAAAAAAAJemhhbmctbGliAAAQAAgAAM/UKsYAAAARAAgAANNj2moAAAABABgAUqSNAE1lSgAj19QACTbFAAk2xAACZvkAAgBbTWFjaW50b3NoIEhEOlVzZXJzOgBtYW56aGFuZzoARG9jdW1lbnRzOgBNYW4uWmhhbmc6AGdtdGItZG9jOgB6aGFuZy1saWI6AGhvdV9ldF9hbF8yMDAyLnBkZgAADgAmABIAaABvAHUAXwBlAHQAXwBhAGwAXwAyADAAMAAyAC4AcABkAGYADwAaAAwATQBhAGMAaQBuAHQAbwBzAGgAIABIAEQAEgBIVXNlcnMvbWFuemhhbmcvRG9jdW1lbnRzL01hbi5aaGFuZy9nbXRiLWRvYy96aGFuZy1saWIvaG91X2V0X2FsXzIwMDIucGRmABMAAS8AABUAAgAP//8AAAAIAA0AGgAkAEkAAAAAAAACAQAAAAAAAAAFAAAAAAAAAAAAAAAAAAACKQ==}} @article{hu_and_stamnes_1993, Author = {Y.X. Hu and K. Stamnes}, - Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxAnLi4vLi4vemhhbmctbGliL2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmTxEB8AAAAAAB8AACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAAz9PWZkgrAAAAUqSNF2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABSpJHTY3R+AAAAAAAAAAAAAgACAAAJIAAAAAAAAAAAAAAAAAAAAAl6aGFuZy1saWIAABAACAAAz9QqxgAAABEACAAA02PI3gAAAAEAGABSpI0ATWVKACPX1AAJNsUACTbEAAJm+QACAGBNYWNpbnRvc2ggSEQ6VXNlcnM6AG1hbnpoYW5nOgBEb2N1bWVudHM6AE1hbi5aaGFuZzoAZ210Yi1kb2M6AHpoYW5nLWxpYjoAaHVfYW5kX3N0YW1uZXNfMTk5My5wZGYADgAwABcAaAB1AF8AYQBuAGQAXwBzAHQAYQBtAG4AZQBzAF8AMQA5ADkAMwAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIATVVzZXJzL21hbnpoYW5nL0RvY3VtZW50cy9NYW4uWmhhbmcvZ210Yi1kb2MvemhhbmctbGliL2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmAAATAAEvAAAVAAIAD///AAAACAANABoAJABOAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAkI=}, Date-Added = {2016-05-19 19:31:56 +0000}, Date-Modified = {2016-05-20 15:13:12 +0000}, Journal = {J. Climate}, @@ -2889,276 +2888,312 @@ @article{hu_and_stamnes_1993 Pages = {728-742}, Title = {An accurate parameterization of the radiative properties of water clouds suitable for use in climate models}, Volume = {6}, - Year = {1993}} + Year = {1993}, + Bdsk-File-1 = {YnBsaXN0MDDSAQIDBFxyZWxhdGl2ZVBhdGhZYWxpYXNEYXRhXxAnLi4vLi4vemhhbmctbGliL2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmTxEB8AAAAAAB8AACAAAMTWFjaW50b3NoIEhEAAAAAAAAAAAAAAAAAAAAz9PWZkgrAAAAUqSNF2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAABSpJHTY3R+AAAAAAAAAAAAAgACAAAJIAAAAAAAAAAAAAAAAAAAAAl6aGFuZy1saWIAABAACAAAz9QqxgAAABEACAAA02PI3gAAAAEAGABSpI0ATWVKACPX1AAJNsUACTbEAAJm+QACAGBNYWNpbnRvc2ggSEQ6VXNlcnM6AG1hbnpoYW5nOgBEb2N1bWVudHM6AE1hbi5aaGFuZzoAZ210Yi1kb2M6AHpoYW5nLWxpYjoAaHVfYW5kX3N0YW1uZXNfMTk5My5wZGYADgAwABcAaAB1AF8AYQBuAGQAXwBzAHQAYQBtAG4AZQBzAF8AMQA5ADkAMwAuAHAAZABmAA8AGgAMAE0AYQBjAGkAbgB0AG8AcwBoACAASABEABIATVVzZXJzL21hbnpoYW5nL0RvY3VtZW50cy9NYW4uWmhhbmcvZ210Yi1kb2MvemhhbmctbGliL2h1X2FuZF9zdGFtbmVzXzE5OTMucGRmAAATAAEvAAAVAAIAD///AAAACAANABoAJABOAAAAAAAAAgEAAAAAAAAABQAAAAAAAAAAAAAAAAAAAkI=}} @article{alexander_et_al_2010, - author = {Alexander, M. J. and Geller, M. and McLandress, C. and Polavarapu, S. and Preusse, P. and Sassi, F. and Sato, K. and Eckermann, S. and Ern, M. and Hertzog, A. and Kawatani, Y. and Pulido, M. and Shaw, T. A. and Sigmond, M. and Vincent, R. and Watanabe, S.}, - title = {Recent developments in gravity-wave effects in climate models and the global distribution of gravity-wave momentum flux from observations and models}, - journal = {Quarterly Journal of the Royal Meteorological Society}, - volume = {136}, - number = {650}, - pages = {1103-1124}, - keywords = {atmosphere, gravity wave, momentum flux, drag, force, wind tendency, climate, global model}, - doi = {10.1002/qj.637}, - url = {https://rmets.onlinelibrary.wiley.com/doi/abs/10.1002/qj.637}, - eprint = {https://rmets.onlinelibrary.wiley.com/doi/pdf/10.1002/qj.637}, - year = {2010}} + Author = {Alexander, M. J. and Geller, M. and McLandress, C. and Polavarapu, S. and Preusse, P. and Sassi, F. and Sato, K. and Eckermann, S. and Ern, M. and Hertzog, A. and Kawatani, Y. and Pulido, M. and Shaw, T. A. and Sigmond, M. and Vincent, R. and Watanabe, S.}, + Doi = {10.1002/qj.637}, + Eprint = {https://rmets.onlinelibrary.wiley.com/doi/pdf/10.1002/qj.637}, + Journal = {Quarterly Journal of the Royal Meteorological Society}, + Keywords = {atmosphere, gravity wave, momentum flux, drag, force, wind tendency, climate, global model}, + Number = {650}, + Pages = {1103-1124}, + Title = {Recent developments in gravity-wave effects in climate models and the global distribution of gravity-wave momentum flux from observations and models}, + Url = {https://rmets.onlinelibrary.wiley.com/doi/abs/10.1002/qj.637}, + Volume = {136}, + Year = {2010}, + Bdsk-Url-1 = {https://rmets.onlinelibrary.wiley.com/doi/abs/10.1002/qj.637}, + Bdsk-Url-2 = {http://dx.doi.org/10.1002/qj.637}} @article{plougonven_and_zhang_2014, - author = {Plougonven, R. and Zhang, F.}, - title = {Internal gravity waves from atmospheric jets and fronts}, - journal = {Reviews of Geophysics}, - volume = {52}, - number = {1}, - pages = {33-76}, - keywords = {gravity waves, stratosphere, atmosphere, jets, fronts, weather}, - doi = {10.1002/2012RG000419}, - url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1002/2012RG000419}, - eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1002/2012RG000419}, - year = {2014}} + Author = {Plougonven, R. and Zhang, F.}, + Doi = {10.1002/2012RG000419}, + Eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1002/2012RG000419}, + Journal = {Reviews of Geophysics}, + Keywords = {gravity waves, stratosphere, atmosphere, jets, fronts, weather}, + Number = {1}, + Pages = {33-76}, + Title = {Internal gravity waves from atmospheric jets and fronts}, + Url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1002/2012RG000419}, + Volume = {52}, + Year = {2014}, + Bdsk-Url-1 = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1002/2012RG000419}, + Bdsk-Url-2 = {http://dx.doi.org/10.1002/2012RG000419}} @article{weinstock_1984, - author = {Weinstock, J.}, - title = {Simplified derivation of an algorithm for nonlinear gravity waves}, - journal = {Journal of Geophysical Research: Space Physics}, - volume = {89}, - number = {A1}, - pages = {345-350}, - doi = {10.1029/JA089iA01p00345}, - url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/JA089iA01p00345}, - eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/JA089iA01p00345}, - year = {1984}} + Author = {Weinstock, J.}, + Doi = {10.1029/JA089iA01p00345}, + Eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/JA089iA01p00345}, + Journal = {Journal of Geophysical Research: Space Physics}, + Number = {A1}, + Pages = {345-350}, + Title = {Simplified derivation of an algorithm for nonlinear gravity waves}, + Url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/JA089iA01p00345}, + Volume = {89}, + Year = {1984}, + Bdsk-Url-1 = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/JA089iA01p00345}, + Bdsk-Url-2 = {http://dx.doi.org/10.1029/JA089iA01p00345}} @article{holton_1983, - author = {Holton, James R.}, - title = {The Influence of Gravity Wave Breaking on the General Circulation of the Middle Atmosphere}, - journal = {Journal of the Atmospheric Sciences}, - volume = {40}, - number = {10}, - pages = {2497-2507}, - year = {1983}, - doi = {10.1175/1520-0469(1983)040<2497:TIOGWB>2.0.CO;2}, - URL = {https://doi.org/10.1175/1520-0469(1983)040<2497:TIOGWB>2.0.CO;2}, - eprint = {https://doi.org/10.1175/1520-0469(1983)040<2497:TIOGWB>2.0.CO;2}} + Author = {Holton, James R.}, + Doi = {10.1175/1520-0469(1983)040<2497:TIOGWB>2.0.CO;2}, + Eprint = {https://doi.org/10.1175/1520-0469(1983)040<2497:TIOGWB>2.0.CO;2}, + Journal = {Journal of the Atmospheric Sciences}, + Number = {10}, + Pages = {2497-2507}, + Title = {The Influence of Gravity Wave Breaking on the General Circulation of the Middle Atmosphere}, + Url = {https://doi.org/10.1175/1520-0469(1983)040<2497:TIOGWB>2.0.CO;2}, + Volume = {40}, + Year = {1983}, + Bdsk-Url-1 = {https://doi.org/10.1175/1520-0469(1983)040%3C2497:TIOGWB%3E2.0.CO;2}, + Bdsk-Url-2 = {http://dx.doi.org/10.1175/1520-0469(1983)040%3C2497:TIOGWB%3E2.0.CO;2}} @article{geller_et_al_2013, - author = {Geller, M. A. and Alexander, M. Joan and Love, P. T. and Bacmeister, J. and Ern, M. and Hertzog, A. and Manzini, E. and Preusse, P. and Sato, K. and Scaife, A. A. and Zhou, T.}, - title = {A Comparison between Gravity Wave Momentum Fluxes in Observations and Climate Models}, - journal = {Journal of Climate}, - volume = {26}, - number = {17}, - pages = {6383-6405}, - year = {2013}, - doi = {10.1175/JCLI-D-12-00545.1}, - URL = {https://doi.org/10.1175/JCLI-D-12-00545.1}, - eprint = {https://doi.org/10.1175/JCLI-D-12-00545.1}} + Author = {Geller, M. A. and Alexander, M. Joan and Love, P. T. and Bacmeister, J. and Ern, M. and Hertzog, A. and Manzini, E. and Preusse, P. and Sato, K. and Scaife, A. A. and Zhou, T.}, + Doi = {10.1175/JCLI-D-12-00545.1}, + Eprint = {https://doi.org/10.1175/JCLI-D-12-00545.1}, + Journal = {Journal of Climate}, + Number = {17}, + Pages = {6383-6405}, + Title = {A Comparison between Gravity Wave Momentum Fluxes in Observations and Climate Models}, + Url = {https://doi.org/10.1175/JCLI-D-12-00545.1}, + Volume = {26}, + Year = {2013}, + Bdsk-Url-1 = {https://doi.org/10.1175/JCLI-D-12-00545.1}, + Bdsk-Url-2 = {http://dx.doi.org/10.1175/JCLI-D-12-00545.1}} @article{garcia_et_al_2017, - author = {Garcia, R. R. and Smith, A. K. and Kinnison, D. E. and Cámara, Á. and Murphy, D. J.}, - title = {Modification of the Gravity Wave Parameterization in the Whole Atmosphere Community Climate Model: Motivation and Results}, - journal = {Journal of the Atmospheric Sciences}, - volume = {74}, - number = {1}, - pages = {275-291}, - year = {2017}, - doi = {10.1175/JAS-D-16-0104.1}, - URL = {https://doi.org/10.1175/JAS-D-16-0104.1}, - eprint = {https://doi.org/10.1175/JAS-D-16-0104.1}} + Author = {Garcia, R. R. and Smith, A. K. and Kinnison, D. E. and C{\'a}mara, {\'A}. and Murphy, D. J.}, + Doi = {10.1175/JAS-D-16-0104.1}, + Eprint = {https://doi.org/10.1175/JAS-D-16-0104.1}, + Journal = {Journal of the Atmospheric Sciences}, + Number = {1}, + Pages = {275-291}, + Title = {Modification of the Gravity Wave Parameterization in the Whole Atmosphere Community Climate Model: Motivation and Results}, + Url = {https://doi.org/10.1175/JAS-D-16-0104.1}, + Volume = {74}, + Year = {2017}, + Bdsk-Url-1 = {https://doi.org/10.1175/JAS-D-16-0104.1}, + Bdsk-Url-2 = {http://dx.doi.org/10.1175/JAS-D-16-0104.1}} @inproceedings{yudin_et_al_2016, - title={Gravity wave physics in the NOAA Environmental Modeling System}, - author={Yudin, V.A. and Akmaev, R.A. and Fuller-Rowell, T.J. and Alpert, J.C.}, - booktitle={International SPARC Gravity Wave Symposium}, - volume={48}, - number={1}, - pages={012024}, - year={2016}, - organization={}} + Author = {Yudin, V.A. and Akmaev, R.A. and Fuller-Rowell, T.J. and Alpert, J.C.}, + Booktitle = {International SPARC Gravity Wave Symposium}, + Number = {1}, + Pages = {012024}, + Title = {Gravity wave physics in the NOAA Environmental Modeling System}, + Volume = {48}, + Year = {2016}} @inproceedings{alpert_et_al_2018, - title={Integrating Unified Gravity Wave Physics Research into the Next Generation Global Prediction System for NCEP Research to Operations}, - author={Alpert, Jordan C and Yudin, Valery and Fuller-Rowell, Tim and Akmaev, Rashid A}, - booktitle={98th American Meteorological Society Annual Meeting}, - year={2018}, - organization={AMS}} + Author = {Alpert, Jordan C and Yudin, Valery and Fuller-Rowell, Tim and Akmaev, Rashid A}, + Booktitle = {98th American Meteorological Society Annual Meeting}, + Organization = {AMS}, + Title = {Integrating Unified Gravity Wave Physics Research into the Next Generation Global Prediction System for NCEP Research to Operations}, + Year = {2018}} @article{eckermann_2011, - author = {Eckermann, Stephen D.}, - title = {Explicitly Stochastic Parameterization of Nonorographic Gravity Wave Drag}, - journal = {Journal of the Atmospheric Sciences}, - volume = {68}, - number = {8}, - pages = {1749-1765}, - year = {2011}, - doi = {10.1175/2011JAS3684.1}, - URL = {https://doi.org/10.1175/2011JAS3684.1}, - eprint = {https://doi.org/10.1175/2011JAS3684.1}} + Author = {Eckermann, Stephen D.}, + Doi = {10.1175/2011JAS3684.1}, + Eprint = {https://doi.org/10.1175/2011JAS3684.1}, + Journal = {Journal of the Atmospheric Sciences}, + Number = {8}, + Pages = {1749-1765}, + Title = {Explicitly Stochastic Parameterization of Nonorographic Gravity Wave Drag}, + Url = {https://doi.org/10.1175/2011JAS3684.1}, + Volume = {68}, + Year = {2011}, + Bdsk-Url-1 = {https://doi.org/10.1175/2011JAS3684.1}, + Bdsk-Url-2 = {http://dx.doi.org/10.1175/2011JAS3684.1}} @article{lott_et_al_2012, - author = {Lott, F. and Guez, L. and Maury, P.}, - title = {A stochastic parameterization of non-orographic gravity waves: Formalism and impact on the equatorial stratosphere}, - journal = {Geophysical Research Letters}, - volume = {39}, - number = {6}, - pages = {}, - keywords = {Quasi-Biennial Oscillation, Rossby-gravity waves, gravity waves, stochastic parameterization, stratospheric dynamics}, - doi = {10.1029/2012GL051001}, - url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2012GL051001}, - eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/2012GL051001}, - year = {2012}} + Author = {Lott, F. and Guez, L. and Maury, P.}, + Doi = {10.1029/2012GL051001}, + Eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/2012GL051001}, + Journal = {Geophysical Research Letters}, + Keywords = {Quasi-Biennial Oscillation, Rossby-gravity waves, gravity waves, stochastic parameterization, stratospheric dynamics}, + Number = {6}, + Title = {A stochastic parameterization of non-orographic gravity waves: Formalism and impact on the equatorial stratosphere}, + Url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2012GL051001}, + Volume = {39}, + Year = {2012}, + Bdsk-Url-1 = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2012GL051001}, + Bdsk-Url-2 = {http://dx.doi.org/10.1029/2012GL051001}} @conference{yudin_et_al_2018, - author = {Yudin, V. A and Akmaev, R. A. and Alpert, J. C. and Fuller-Rowell T. J., and Karol S. I.}, - Booktitle = {25th Conference on Numerical Weather Prediction}, - Date-Added = {2018-06-04 10:50:44 -0600}, - Date-Modified = {2018-06-04 10:54:39 -0600}, - Editor = {Am. Meteorol. Soc.}, - Title = {Gravity Wave Physics and Dynamics in the FV3-based Atmosphere Models Extended into the Mesosphere}, - Year = {2018}} + Author = {Yudin, V. A and Akmaev, R. A. and Alpert, J. C. and Fuller-Rowell T. J., and Karol S. I.}, + Booktitle = {25th Conference on Numerical Weather Prediction}, + Date-Added = {2018-06-04 10:50:44 -0600}, + Date-Modified = {2018-06-04 10:54:39 -0600}, + Editor = {Am. Meteorol. Soc.}, + Title = {Gravity Wave Physics and Dynamics in the FV3-based Atmosphere Models Extended into the Mesosphere}, + Year = {2018}} @article{hines_1997, - title = "Doppler-spread parameterization of gravity-wave momentum deposition in the middle atmosphere. Part 2: Broad and quasi monochromatic spectra, and implementation", - journal = "Journal of Atmospheric and Solar-Terrestrial Physics", - volume = "59", - number = "4", - pages = "387 - 400", - year = "1997", - issn = "1364-6826", - doi = "https://doi.org/10.1016/S1364-6826(96)00080-6", - url = "http://www.sciencedirect.com/science/article/pii/S1364682696000806", - author = "Colin O. Hines"} + Author = {Colin O. Hines}, + Doi = {https://doi.org/10.1016/S1364-6826(96)00080-6}, + Issn = {1364-6826}, + Journal = {Journal of Atmospheric and Solar-Terrestrial Physics}, + Number = {4}, + Pages = {387 - 400}, + Title = {Doppler-spread parameterization of gravity-wave momentum deposition in the middle atmosphere. Part 2: Broad and quasi monochromatic spectra, and implementation}, + Url = {http://www.sciencedirect.com/science/article/pii/S1364682696000806}, + Volume = {59}, + Year = {1997}, + Bdsk-Url-1 = {http://www.sciencedirect.com/science/article/pii/S1364682696000806}, + Bdsk-Url-2 = {https://doi.org/10.1016/S1364-6826(96)00080-6}} @article{alexander_and_dunkerton_1999, - author = {Alexander, M. J. and Dunkerton, T. J.}, - title = {A Spectral Parameterization of Mean-Flow Forcing due to Breaking Gravity Waves}, - journal = {Journal of the Atmospheric Sciences}, - volume = {56}, - number = {24}, - pages = {4167-4182}, - year = {1999}, - doi = {10.1175/1520-0469(1999)056<4167:ASPOMF>2.0.CO;2}, - URL = {https://doi.org/10.1175/1520-0469(1999)056<4167:ASPOMF>2.0.CO;2}, - eprint = {https://doi.org/10.1175/1520-0469(1999)056<4167:ASPOMF>2.0.CO;2}} + Author = {Alexander, M. J. and Dunkerton, T. J.}, + Doi = {10.1175/1520-0469(1999)056<4167:ASPOMF>2.0.CO;2}, + Eprint = {https://doi.org/10.1175/1520-0469(1999)056<4167:ASPOMF>2.0.CO;2}, + Journal = {Journal of the Atmospheric Sciences}, + Number = {24}, + Pages = {4167-4182}, + Title = {A Spectral Parameterization of Mean-Flow Forcing due to Breaking Gravity Waves}, + Url = {https://doi.org/10.1175/1520-0469(1999)056<4167:ASPOMF>2.0.CO;2}, + Volume = {56}, + Year = {1999}, + Bdsk-Url-1 = {https://doi.org/10.1175/1520-0469(1999)056%3C4167:ASPOMF%3E2.0.CO;2}, + Bdsk-Url-2 = {http://dx.doi.org/10.1175/1520-0469(1999)056%3C4167:ASPOMF%3E2.0.CO;2}} @article{scinocca_2003, - author = {Scinocca, John F.}, - title = {An Accurate Spectral Nonorographic Gravity Wave Drag Parameterization for General Circulation Models}, - journal = {Journal of the Atmospheric Sciences}, - volume = {60}, - number = {4}, - pages = {667-682}, - year = {2003}, - doi = {10.1175/1520-0469(2003)060<0667:AASNGW>2.0.CO;2}, - URL = {https://doi.org/10.1175/1520-0469(2003)060<0667:AASNGW>2.0.CO;2}, - eprint = {https://doi.org/10.1175/1520-0469(2003)060<0667:AASNGW>2.0.CO;2}} + Author = {Scinocca, John F.}, + Doi = {10.1175/1520-0469(2003)060<0667:AASNGW>2.0.CO;2}, + Eprint = {https://doi.org/10.1175/1520-0469(2003)060<0667:AASNGW>2.0.CO;2}, + Journal = {Journal of the Atmospheric Sciences}, + Number = {4}, + Pages = {667-682}, + Title = {An Accurate Spectral Nonorographic Gravity Wave Drag Parameterization for General Circulation Models}, + Url = {https://doi.org/10.1175/1520-0469(2003)060<0667:AASNGW>2.0.CO;2}, + Volume = {60}, + Year = {2003}, + Bdsk-Url-1 = {https://doi.org/10.1175/1520-0469(2003)060%3C0667:AASNGW%3E2.0.CO;2}, + Bdsk-Url-2 = {http://dx.doi.org/10.1175/1520-0469(2003)060%3C0667:AASNGW%3E2.0.CO;2}} @article{shaw_and_shepherd_2009, - author = {Shaw, Tiffany A. and Shepherd, Theodore G.}, - title = {A Theoretical Framework for Energy and Momentum Consistency in Subgrid-Scale Parameterization for Climate Models}, - journal = {Journal of the Atmospheric Sciences}, - volume = {66}, - number = {10}, - pages = {3095-3114}, - year = {2009}, - doi = {10.1175/2009JAS3051.1}, - URL = {https://doi.org/10.1175/2009JAS3051.1}, - eprint = {https://doi.org/10.1175/2009JAS3051.1}} - -@Article{molod_et_al_2015, - AUTHOR = {Molod, A. and Takacs, L. and Suarez, M. and Bacmeister, J.}, - TITLE = {Development of the GEOS-5 atmospheric general circulation model: evolution from MERRA to MERRA2}, - JOURNAL = {Geoscientific Model Development}, - VOLUME = {8}, - YEAR = {2015}, - NUMBER = {5}, - PAGES = {1339--1356}, - URL = {https://www.geosci-model-dev.net/8/1339/2015/}, - DOI = {10.5194/gmd-8-1339-2015}} + Author = {Shaw, Tiffany A. and Shepherd, Theodore G.}, + Doi = {10.1175/2009JAS3051.1}, + Eprint = {https://doi.org/10.1175/2009JAS3051.1}, + Journal = {Journal of the Atmospheric Sciences}, + Number = {10}, + Pages = {3095-3114}, + Title = {A Theoretical Framework for Energy and Momentum Consistency in Subgrid-Scale Parameterization for Climate Models}, + Url = {https://doi.org/10.1175/2009JAS3051.1}, + Volume = {66}, + Year = {2009}, + Bdsk-Url-1 = {https://doi.org/10.1175/2009JAS3051.1}, + Bdsk-Url-2 = {http://dx.doi.org/10.1175/2009JAS3051.1}} + +@article{molod_et_al_2015, + Author = {Molod, A. and Takacs, L. and Suarez, M. and Bacmeister, J.}, + Doi = {10.5194/gmd-8-1339-2015}, + Journal = {Geoscientific Model Development}, + Number = {5}, + Pages = {1339--1356}, + Title = {Development of the GEOS-5 atmospheric general circulation model: evolution from MERRA to MERRA2}, + Url = {https://www.geosci-model-dev.net/8/1339/2015/}, + Volume = {8}, + Year = {2015}, + Bdsk-Url-1 = {https://www.geosci-model-dev.net/8/1339/2015/}, + Bdsk-Url-2 = {http://dx.doi.org/10.5194/gmd-8-1339-2015}} @article{richter_et_al_2010, - author = {Richter, Jadwiga H. and Sassi, Fabrizio and Garcia, Rolando R.}, - title = {Toward a Physically Based Gravity Wave Source Parameterization in a General Circulation Model}, - journal = {Journal of the Atmospheric Sciences}, - volume = {67}, - number = {1}, - pages = {136-156}, - year = {2010}, - doi = {10.1175/2009JAS3112.1}, - URL = {https://doi.org/10.1175/2009JAS3112.1}, - eprint = {https://doi.org/10.1175/2009JAS3112.1}} + Author = {Richter, Jadwiga H. and Sassi, Fabrizio and Garcia, Rolando R.}, + Doi = {10.1175/2009JAS3112.1}, + Eprint = {https://doi.org/10.1175/2009JAS3112.1}, + Journal = {Journal of the Atmospheric Sciences}, + Number = {1}, + Pages = {136-156}, + Title = {Toward a Physically Based Gravity Wave Source Parameterization in a General Circulation Model}, + Url = {https://doi.org/10.1175/2009JAS3112.1}, + Volume = {67}, + Year = {2010}, + Bdsk-Url-1 = {https://doi.org/10.1175/2009JAS3112.1}, + Bdsk-Url-2 = {http://dx.doi.org/10.1175/2009JAS3112.1}} @article{richter_et_al_2014, - author = {Richter, Jadwiga H. and Solomon, Abraham and Bacmeister, Julio T.}, - title = {Effects of vertical resolution and nonorographic gravity wave drag on the simulated climate in the Community Atmosphere Model, version 5}, - journal = {Journal of Advances in Modeling Earth Systems}, - volume = {6}, - number = {2}, - pages = {357-383}, - keywords = {climate modeling, vertical resolution, modeling, climate, global circulation model, general circulation model}, - doi = {10.1002/2013MS000303}, - url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1002/2013MS000303}, - eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1002/2013MS000303}, - year = {2014}} + Author = {Richter, Jadwiga H. and Solomon, Abraham and Bacmeister, Julio T.}, + Doi = {10.1002/2013MS000303}, + Eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1002/2013MS000303}, + Journal = {Journal of Advances in Modeling Earth Systems}, + Keywords = {climate modeling, vertical resolution, modeling, climate, global circulation model, general circulation model}, + Number = {2}, + Pages = {357-383}, + Title = {Effects of vertical resolution and nonorographic gravity wave drag on the simulated climate in the Community Atmosphere Model, version 5}, + Url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1002/2013MS000303}, + Volume = {6}, + Year = {2014}, + Bdsk-Url-1 = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1002/2013MS000303}, + Bdsk-Url-2 = {http://dx.doi.org/10.1002/2013MS000303}} @article{gelaro_et_al_2017, - author = {Gelaro, et al.}, - title = {The Modern-Era Retrospective Analysis for Research and Applications, Version 2 (MERRA-2)}, - journal = {Journal of Climate}, - volume = {30}, - number = {14}, - pages = {5419-5454}, - year = {2017}, - doi = {10.1175/JCLI-D-16-0758.1}, - URL = {https://doi.org/10.1175/JCLI-D-16-0758.1}, - eprint = {https://doi.org/10.1175/JCLI-D-16-0758.1}} + Author = {Gelaro, et al.}, + Doi = {10.1175/JCLI-D-16-0758.1}, + Eprint = {https://doi.org/10.1175/JCLI-D-16-0758.1}, + Journal = {Journal of Climate}, + Number = {14}, + Pages = {5419-5454}, + Title = {The Modern-Era Retrospective Analysis for Research and Applications, Version 2 (MERRA-2)}, + Url = {https://doi.org/10.1175/JCLI-D-16-0758.1}, + Volume = {30}, + Year = {2017}, + Bdsk-Url-1 = {https://doi.org/10.1175/JCLI-D-16-0758.1}, + Bdsk-Url-2 = {http://dx.doi.org/10.1175/JCLI-D-16-0758.1}} @article{garcia_et_al_2007, - author = {Garcia, R. R. and Marsh, D. R. and Kinnison, D. E. and Boville, B. A. and Sassi, F.}, - title = {Simulation of secular trends in the middle atmosphere, 1950–2003}, - journal = {Journal of Geophysical Research: Atmospheres}, - volume = {112}, - number = {D9}, - pages = {}, - keywords = {global change, ozone depletion, water vapor trends, temperature trends}, - doi = {10.1029/2006JD007485}, - url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2006JD007485}, - eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/2006JD007485}, - year = {2007}} + Author = {Garcia, R. R. and Marsh, D. R. and Kinnison, D. E. and Boville, B. A. and Sassi, F.}, + Doi = {10.1029/2006JD007485}, + Eprint = {https://agupubs.onlinelibrary.wiley.com/doi/pdf/10.1029/2006JD007485}, + Journal = {Journal of Geophysical Research: Atmospheres}, + Keywords = {global change, ozone depletion, water vapor trends, temperature trends}, + Number = {D9}, + Title = {Simulation of secular trends in the middle atmosphere, 1950--2003}, + Url = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2006JD007485}, + Volume = {112}, + Year = {2007}, + Bdsk-Url-1 = {https://agupubs.onlinelibrary.wiley.com/doi/abs/10.1029/2006JD007485}, + Bdsk-Url-2 = {http://dx.doi.org/10.1029/2006JD007485}} @article{eckermann_et_al_2009, - title = "High-altitude data assimilation system experiments for the northern summer mesosphere season of 2007", - journal = "Journal of Atmospheric and Solar-Terrestrial Physics", - volume = "71", - number = "3", - pages = "531 - 551", - year = "2009", - note = "Global Perspectives on the Aeronomy of the Summer Mesopause Region", - issn = "1364-6826", - doi = "https://doi.org/10.1016/j.jastp.2008.09.036", - url = "http://www.sciencedirect.com/science/article/pii/S1364682608002575", - author = "Stephen D. Eckermann and Karl W. Hoppel and Lawrence Coy and John P. McCormack and David E. Siskind and Kim Nielsen and Andrew Kochenash and Michael H. Stevens and Christoph R. Englert and Werner Singer and Mark Hervig", - keywords = "Data assimilation, Polar mesospheric cloud, Tide, Planetary wave, Mesosphere",} + Author = {Stephen D. Eckermann and Karl W. Hoppel and Lawrence Coy and John P. McCormack and David E. Siskind and Kim Nielsen and Andrew Kochenash and Michael H. Stevens and Christoph R. Englert and Werner Singer and Mark Hervig}, + Doi = {https://doi.org/10.1016/j.jastp.2008.09.036}, + Issn = {1364-6826}, + Journal = {Journal of Atmospheric and Solar-Terrestrial Physics}, + Keywords = {Data assimilation, Polar mesospheric cloud, Tide, Planetary wave, Mesosphere}, + Note = {Global Perspectives on the Aeronomy of the Summer Mesopause Region}, + Number = {3}, + Pages = {531 - 551}, + Title = {High-altitude data assimilation system experiments for the northern summer mesosphere season of 2007}, + Url = {http://www.sciencedirect.com/science/article/pii/S1364682608002575}, + Volume = {71}, + Year = {2009}, + Bdsk-Url-1 = {http://www.sciencedirect.com/science/article/pii/S1364682608002575}, + Bdsk-Url-2 = {https://doi.org/10.1016/j.jastp.2008.09.036}} @inproceedings{alpert_et_al_2019, - title={Atmospheric Gravity Wave Sources Correlated with Resolved-scale GW Activity and Sub-grid Scale Parameterization in the FV3gfs Model}, - author={Alpert, Jordan C and Yudin, Valery A and Strobach, Edward}, - booktitle={AGU Fall Meeting 2019}, - year={2019}, - organization={AGU}} - -@Article{ern_et_al_2018, - AUTHOR = {Ern, M. and Trinh, Q. T. and Preusse, P. and Gille, J. C. and Mlynczak, M. G. and Russell III, J. M. and Riese, M.}, - TITLE = {GRACILE: a comprehensive climatology of atmospheric gravity wave parameters based on satellite limb soundings}, - JOURNAL = {Earth System Science Data}, - VOLUME = {10}, - YEAR = {2018}, - NUMBER = {2}, - PAGES = {857--892}, - URL = {https://www.earth-syst-sci-data.net/10/857/2018/}, - DOI = {10.5194/essd-10-857-2018}} + Author = {Alpert, Jordan C and Yudin, Valery A and Strobach, Edward}, + Booktitle = {AGU Fall Meeting 2019}, + Organization = {AGU}, + Title = {Atmospheric Gravity Wave Sources Correlated with Resolved-scale GW Activity and Sub-grid Scale Parameterization in the FV3gfs Model}, + Year = {2019}} + +@article{ern_et_al_2018, + Author = {Ern, M. and Trinh, Q. T. and Preusse, P. and Gille, J. C. and Mlynczak, M. G. and Russell III, J. M. and Riese, M.}, + Doi = {10.5194/essd-10-857-2018}, + Journal = {Earth System Science Data}, + Number = {2}, + Pages = {857--892}, + Title = {GRACILE: a comprehensive climatology of atmospheric gravity wave parameters based on satellite limb soundings}, + Url = {https://www.earth-syst-sci-data.net/10/857/2018/}, + Volume = {10}, + Year = {2018}, + Bdsk-Url-1 = {https://www.earth-syst-sci-data.net/10/857/2018/}, + Bdsk-Url-2 = {http://dx.doi.org/10.5194/essd-10-857-2018}} @inproceedings{yudin_et_al_2019, - title={Longitudinal Variability of Wave Dynamics in Weather Models Extended into the Mesosphere and Thermosphere}, - author={Yudin V.A. , S. I. Karol, R.A. Akmaev, T. Fuller-Rowell, D. Kleist, A. Kubaryk, and C. Thompson}, - booktitle={Space Weather Workshop}, - year={2019},} + Author = {Yudin V.A. , S. I. Karol, R.A. Akmaev, T. Fuller-Rowell, D. Kleist, A. Kubaryk, and C. Thompson}, + Booktitle = {Space Weather Workshop}, + Title = {Longitudinal Variability of Wave Dynamics in Weather Models Extended into the Mesosphere and Thermosphere}, + Year = {2019}} diff --git a/physics/docs/pdftxt/CPT_adv_suite.txt b/physics/docs/pdftxt/CPT_adv_suite.txt index 132d8bd11..26d514d51 100644 --- a/physics/docs/pdftxt/CPT_adv_suite.txt +++ b/physics/docs/pdftxt/CPT_adv_suite.txt @@ -3,31 +3,28 @@ \section csawmg_suite_overview Overview -The advanced csawmg physics suite uses the parameterizations in the following order: +The csawmg physics suite uses the parameterizations in the following order: - \ref GFS_RRTMG - \ref GFS_SFCLYR - \ref GFS_NSST - \ref GFS_NOAH - \ref GFS_SFCSICE - \ref GFS_HEDMF - - \ref GFS_GWDPS + - \ref GFS_UGWP_v0 - \ref GFS_RAYLEIGH - \ref GFS_OZPHYS - \ref GFS_H2OPHYS - \ref CSAW_scheme - - \ref GFS_GWDC - \ref GFS_SAMFshal - \ref CPT_MG3 - \ref mod_cs_conv_aw_adj - \ref GFS_CALPRECIPTYPE \section sdf_cpt_suite Suite Definition File - -The advanced csawmg physics suite uses the parameterizations in the following order, as defined in \c SCM_csawmg : \code - + @@ -56,9 +53,10 @@ The advanced csawmg physics suite uses the parameterizations in the following or GFS_suite_stateout_reset get_prs_fv3 GFS_suite_interstitial_1 - dcyc2t3 GFS_surface_generic_pre GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter GFS_suite_interstitial_2 @@ -75,7 +73,6 @@ The advanced csawmg physics suite uses the parameterizations in the following or GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post @@ -83,8 +80,9 @@ The advanced csawmg physics suite uses the parameterizations in the following or hedmf GFS_PBL_generic_post GFS_GWD_generic_pre - gwdps - gwdps_post + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post rayleigh_damp GFS_suite_stateout_update ozphys_2015 @@ -96,12 +94,8 @@ The advanced csawmg physics suite uses the parameterizations in the following or cs_conv cs_conv_post GFS_DCNV_generic_post - gwdc_pre - gwdc - gwdc_post GFS_SCNV_generic_pre samfshalcnv - samfshalcnv_post GFS_SCNV_generic_post GFS_suite_interstitial_4 cnvc90 @@ -111,21 +105,20 @@ The advanced csawmg physics suite uses the parameterizations in the following or m_micro_post cs_conv_aw_adj GFS_MP_generic_post - sfc_sice_post maximum_hourly_diagnostics - \endcode -\section cpt_nml_option Namelist Option +\section cpt_nml_option Namelist \code &gfs_physics_nml fhzero = 6. ldiag3d = .true. fhcyc = 24. + nst_anl = .true. use_ufo = .true. pre_rad = .false. crtrh = 0.93,0.90,0.95 @@ -147,25 +140,40 @@ The advanced csawmg physics suite uses the parameterizations in the following or shal_cnv = .true. cal_pre = .false. redrag = .true. - dspheat = .true. + dspheat = .false. hybedmf = .true. satmedmf = .false. - lheatstrg = .true. + lheatstrg = .false. random_clds = .true. trans_trac = .true. - cnvcld = .true. + cnvcld = .false. imfshalcnv = 2 imfdeepcnv = -1 cdmbgwd = 3.5,0.25 prslrd0 = 0. ivegsrc = 1 isot = 1 + lsm = 1 + iopt_dveg = 2 + iopt_crs = 1 + iopt_btr = 1 + iopt_run = 1 + iopt_sfc = 1 + iopt_frz = 1 + iopt_inf = 1 + iopt_rad = 1 + iopt_alb = 2 + iopt_snf = 4 + iopt_tbot = 2 + iopt_stc = 1 oz_phys = .false. oz_phys_2015 = .true. debug = .false. + ras = .false. cscnv = .true. do_shoc = .false. + shoc_parm = 7000.0,1.0,2.0,0.7,-999.0 do_aw = .true. shoc_cld = .false. h2o_phys = .true. @@ -173,8 +181,6 @@ The advanced csawmg physics suite uses the parameterizations in the following or xkzm_h = 0.5 xkzm_m = 0.5 xkzm_s = 1.0 - nstf_name = 2,1,1,0,5 - nst_anl = .true. ccwf = 1.0,1.0 dlqf = 0.25,0.05 mg_dcs = 200.0 @@ -190,12 +196,13 @@ The advanced csawmg physics suite uses the parameterizations in the following or mg_do_ice_gmao = .false. mg_do_liq_liu = .true. cs_parm = 8.0,4.0,1.0e3,3.5e3,20.0,1.0,0.0,1.0,0.6,0.0 - shoc_parm = 7000.0,1.0,2.0,0.7,-999.0 ctei_rm = 0.60,0.23 max_lon = 8000 max_lat = 4000 rhcmax = 0.9999999 effr_in = .true. + + nstf_name = 2,1,1,0,5 ltaerosol = .false. lradar = .false. cplflx = .false. @@ -203,6 +210,22 @@ The advanced csawmg physics suite uses the parameterizations in the following or iaufhrs = 30 iau_inc_files = "''" / + +&cires_ugwp_nml + knob_ugwp_solver = 2 + knob_ugwp_source = 1,1,0,0 + knob_ugwp_wvspec = 1,25,25,25 + knob_ugwp_azdir = 2,4,4,4 + knob_ugwp_stoch = 0,0,0,0 + knob_ugwp_effac = 1,1,1,1 + knob_ugwp_doaxyz = 1 + knob_ugwp_doheat = 1 + knob_ugwp_dokdis = 1 + knob_ugwp_ndx4lh = 1 + knob_ugwp_version = 0 + launch_level = 25 +/ +/ \endcode diff --git a/physics/docs/pdftxt/GFS_OCEAN.txt b/physics/docs/pdftxt/GFS_OCEAN.txt new file mode 100644 index 000000000..b384aec84 --- /dev/null +++ b/physics/docs/pdftxt/GFS_OCEAN.txt @@ -0,0 +1,17 @@ +/** +\page GFS_OCEAN GFS Simple Ocean Scheme +\section des_sfcocean Description + +The Sea Surface Temperature (SST) is a required field in Numerical Weather Prediciton (NWP) systems because it +functions as the lower boundary condition for the calculation of air-sea heat fluxes. The GFS Simple Ocean Scheme +does not change the SST. Therefore, the SST stays constant throughout the forecast unless it is updated by other processes. +In some models, such as the UFS atmosphere, the SST can change if forcing towards the climatology is turned on. + +\section intra_sfcocean Intraphysics Communication +\ref arg_table_sfc_ocean_run + + + + + +*/ diff --git a/physics/docs/pdftxt/GFS_OZPHYS.txt b/physics/docs/pdftxt/GFS_OZPHYS.txt index fadaf95a5..3a2ddc173 100644 --- a/physics/docs/pdftxt/GFS_OZPHYS.txt +++ b/physics/docs/pdftxt/GFS_OZPHYS.txt @@ -1,5 +1,5 @@ /** -\page GFS_OZPHYS GFS Ozone Photochemistry Scheme +\page GFS_OZPHYS GFS Ozone Photochemistry (2015) Scheme \section des_ozone Description In recent years, the leading NWP centers have extended the vertical range of their NWP and DA systems from the surface up through the stratosphere (~10-50 km altitude) and lower mesosphere (~50-65 km). Some diff --git a/physics/docs/pdftxt/GFS_SATMEDMFVDIFQ.txt b/physics/docs/pdftxt/GFS_SATMEDMFVDIFQ.txt new file mode 100644 index 000000000..de543fe6c --- /dev/null +++ b/physics/docs/pdftxt/GFS_SATMEDMFVDIFQ.txt @@ -0,0 +1,35 @@ +/** +\page GFS_SATMEDMFVDIFQ GFS Scale-aware TKE-based Moist Eddy-Diffusion Mass-Flux (EDMF) PBL and Free Atmospheric Turbulence Scheme +\section des_satmedmfvdifq Description + +The current operational \ref GFS_HEDMF uses a hybrid EDMF parameterization for the convective PBL (Han et al. 2016 \cite Han_2016; +Han et al. 2017 \cite han_et_al_2017), where the EDMF scheme is applied only for the strongly unstable PBL, while the eddy-diffusivity +counter-gradient(EDCG) scheme is used for the weakly unstable PBL. The new TKE-EDMF is an extended version of \ref GFS_HEDMF with below enhancement: + +-# Eddy diffusivity (K) is now a function of TKE which is prognostically predicted + +-# EDMF approach is applied for all the unstable PBL + +-# EDMF approach is also applied to the stratocumulus-top-driven turbulence mixing + +-# It includes a moist-adiabatic process when updraft thermal becomes saturated + +-# Scale-aware capability + +-# It includes interaction between TKE and cumulus convection + +The CCPP-compliant subroutine satmedmfvdifq_run() computes subgrid vertical turbulence mixing using scale-aware +TKE-based moist eddy-diffusion mass-flux paramterization (Han et al. 2019 \cite Han_2019) +- For the convective boundary layer, the scheme adopts EDMF parameterization (Siebesma et al. (2007)\cite Siebesma_2007) +to take into account nonlocal transport by large eddies(mfpbltq.f) +- A new mass-flux paramterization for stratocumulus-top-induced turbulence mixing has been introduced (mfscuq.f; previously, +it was an eddy diffusion form) +- For local turbulence mixing, a TKE closure model is used. + +\section intra_satmedmfvdifq Intraphysics Communication +\ref arg_table_satmedmfvdifq_run + +\section gen_pbl_satmedmfvdifq General Algorithm +\ref gen_satmedmfvdifq + +*/ diff --git a/physics/docs/pdftxt/GFS_UGWPv0.txt b/physics/docs/pdftxt/GFS_UGWPv0.txt new file mode 100644 index 000000000..e6ea3b6f4 --- /dev/null +++ b/physics/docs/pdftxt/GFS_UGWPv0.txt @@ -0,0 +1,117 @@ +/** +\page GFS_UGWP_v0 CIRES Unified Gravity Wave Physics Scheme - Version 0 +\section des_UGWP Description + +Gravity waves (GWs) are generated by a variety of sources in the atmosphere +including orographic GWs (OGWs; quasi-stationary waves) and non-orographic +GWs (NGWs; non-stationary oscillations). When the Version 0 of the Unified +Gravity Wave Physics (UGWP v0) is invoked, the subgrid OGWs and NGWs are +parameterized. For the subgrid-scale parameterization of OGWs, the UGWP +invokes a separate scheme, the \subpage GFS_GWDPS, which is used in the operational +Global Forecast System (GFS) version 15. + +The NGW physics scheme parameterizes the effects of non-stationary waves +unresolved by dynamical cores. These non-stationary oscillations with periods +bounded by Coriolis and Brunt-Väisälä frequencies and typical horizontal +scales from tens to several hundreds of kilometers, are forced by the +imbalance of convective and frontal/jet dynamics in the troposphere and +lower stratosphere (Fritts 1984 \cite fritts_1984; Alexander et al. +2010 \cite alexander_et_al_2010; Plougonven and Zhang 2014 \cite plougonven_and_zhang_2014). +The NGWs propagate upwards and the amplitudes exponentially grow with +altitude until instability and breaking of waves occur. Convective and +dynamical instability induced by GWs with large amplitudes can trigger +production of small-scale turbulence and self-destruction of waves. +The latter process in the theory of atmospheric GWs is frequently referred +as the wave saturation (Lindzen 1981 \cite lindzen_1981; Weinstock +1984 \cite weinstock_1984; Fritts 1984 \cite fritts_1984). Herein, +“saturation” or "breaking" refers to any processes that act to reduce +wave amplitudes due to instabilities and/or interactions arising from +large-amplitude perturbations limiting the exponential growth of GWs +with height. Background dissipation processes such as molecular diffusion +and radiative cooling, in contrast, act independently of GW amplitudes. +In the middle atmosphere, impacts of NGW saturation (or breaking) and +dissipation on the large-scale circulation, mixing, and transport have +been acknowledged in the physics of global weather and climate models +after pioneering studies by Lindzen 1981 \cite lindzen_1981 and Holton +1983 \cite holton_1983. Comprehensive reviews on the physics of NGWs +and OGWs in climate and weather models have been discussted in Alexander +et al. 2010 \cite alexander_et_al_2010, Geller et al. +2013 \cite geller_et_al_2013, and Garcia et al. 2017 \cite garcia_et_al_2017. +They are formulated using different aspects of the nonlinear and linear +propagation, instability, breaking and dissipation of waves along with +different specifications of GW sources (Garcia et al. 2007 \cite garcia_et_al_2007; +Richter et al 2010 \cite richter_et_al_2010; Eckermann et al. +2009 \cite eckermann_et_al_2009; Eckermann 2011 \cite eckermann_2011; +Lott et al. 2012 \cite lott_et_al_2012). + +Several studies have demonstrated the importance of NGW physics to improve +model predictions in the stratosphere and upper atmosphere (Alexander et al. + 2010 \cite alexander_et_al_2010; Geller et al. 2013). In order to describe +the effects of unresolved GWs in global forecast models, the representation of +subgrid OGWs and NGWs has been implemented in the self-consistent manner using the +UGWP framework. + +The concept of UGWP was first proposed and implemented in the Unified +Forecast System (UFS)with model top at different levels by scientists from +the University of Colorado Cooperative Institute for Research in the +Environmental Sciences (CIRES) at NOAA's Space Weather Prediction Center (SWPC) +and from NOAA's Environmental Modeling Center (EMC) (Alpert et al. +2019 \cite alpert_et_al_2019; Yudin et al. 2016 \cite yudin_et_al_2016; +Yudin et al. 2018 \cite yudin_et_al_2018). The UGWP considers identical +GW propagation solvers for OGWs and NGWs with different approaches for +specification of subgrid wave sources. The current set of the input and +control paramters for UGWP version 0 (UGWP v0) enables options for GW +effects, including momentum deposition (also called GW drag), heat +deposition, and mixing by eddy viscosity, conductivity and diffusion; +however, note that the eddy mixing effects induced by instability of GWs +are not activated in this version. + +Namelist paramters control the number of directional azimuths in which +waves can propagate, number of waves in a single direction, and the level +above the surface at which NGWs can be launched. Among the input parameters, +the GW efficiency factors reflect intermittency of wave excitation. +They should vary with horizontal resolution, reflecting the capability of +the dynamical core to resolve mesoscale wave activity with the enhancement +of model resolution. + +Prescribed distributions for vertical momentum flux (VMF) of NGWs have been employed +in global numerical weather prediction and reanalysis models to ease tuning of GW +schemes to the climatology of the middle atmosphere dynamics in the absence of +the global wind data above about 35 km (Eckermann et al. 2009 \cite eckermann_et_al_2009; +Molod et al. 2015 \cite molod_et_al_2015). These distributions of VMF +qualitatively describe the general features of the latitudinal and seasonal + variations of the global GW activity in the lower stratosphere, observed from the +ground and space (Ern et al. 2018 \cite ern_et_al_2018). Subgrid GW sources can also be +parameterized to respond to year-to-year variations of solar input and +anthropogenic emissions (Richter et al 2010 \cite richter_et_al_2010; +2014 \cite richter_et_al_2014). + +Note that in UGWP v0, the momentum and heat deposition due to GW breaking +and dissipation have been tested in the multi-year simulations and +medium-range forecasts using a configuration of the UFS weather model +using 127 levels with model top at approximately 80 km. + +Along with the GW heat and momentum depositions, GW eddy mixing is an +important element of the Whole Atmosphere Model (WAM) physics, as shown +in WAM simulations with the spectral dynamics (Yudin et al. 2018 \cite yudin_et_al_2018). +The impact of eddy mixing effects in the middle and upper atmosphere, +which is not included in this version, need to be tested, evaluated, and +orchestrated with the representation of the subgrid turbulent diffusion and +the numerical dissipation. + +The representation of subgrid GWs is particularly important for WAMs that +extend into the thermosphere (top lid at ~600 km). In the mesosphere and +thermosphere, the background attenuation of subgrid waves due to molecular +and turbulent diffusion, radiative damping and ion drag will be the +additional mechanism of NGW and OGW dissipation along with convective +and dynamical instability of waves described by the linear +(Lindzen 1981 \cite lindzen_1981) and nonlinear +(Weinstock 1984 \cite weinstock_1984; Hines 1997 \cite hines_1997) saturation theories. + +\section intra_UGWPv0 Intraphysics Communication +\ref arg_table_cires_ugwp_run + +\section gen_al_ugwpv0 General Algorithm +\ref gen_cires_ugwp + +*/ diff --git a/physics/docs/pdftxt/GFSv14_suite.txt b/physics/docs/pdftxt/GFSv14_suite.txt index 23f611a25..d1dcb038c 100644 --- a/physics/docs/pdftxt/GFSv14_suite.txt +++ b/physics/docs/pdftxt/GFSv14_suite.txt @@ -75,7 +75,6 @@ The GFS v14 suite uses the parameterizations in the following order, as defined - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/physics/docs/pdftxt/GFSv15_suite.txt b/physics/docs/pdftxt/GFSv15_suite.txt index 6b5fddcf8..abf446224 100644 --- a/physics/docs/pdftxt/GFSv15_suite.txt +++ b/physics/docs/pdftxt/GFSv15_suite.txt @@ -85,7 +85,6 @@ The GFS v15 suite uses the parameterizations in the following order, as defined GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/physics/docs/pdftxt/GFSv15_suite_TKEEDMF.txt b/physics/docs/pdftxt/GFSv15_suite_TKEEDMF.txt index 56a1f97f5..6215fe361 100644 --- a/physics/docs/pdftxt/GFSv15_suite_TKEEDMF.txt +++ b/physics/docs/pdftxt/GFSv15_suite_TKEEDMF.txt @@ -76,7 +76,6 @@ The GFS v15plus suite uses the parameterizations in the following order, as defi GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post diff --git a/physics/docs/pdftxt/GFSv15p2_no_nsst_suite.txt b/physics/docs/pdftxt/GFSv15p2_no_nsst_suite.txt new file mode 100644 index 000000000..982afc860 --- /dev/null +++ b/physics/docs/pdftxt/GFSv15p2_no_nsst_suite.txt @@ -0,0 +1,127 @@ +/** +\page GFS_v15p2_no_nsst_page GFS_v15p2_no_nsst Suite + +\section gfsv15_no_nsst_suite_overview Overview + +Suite GFS_v15p2_no_nsst is a companion suite of GFS_v15p2 with GRIB2 data initialization. + +The GFS_v15p2_no_nsst physics suite uses the parameterizations in the following order: + - \ref GFS_RRTMG + - \ref GFS_SFCLYR + - \ref GFS_OCEAN + - \ref GFS_NOAH + - \ref GFS_SFCSICE + - \ref GFS_HEDMF + - \ref GFS_UGWP_v0 + - \ref GFS_RAYLEIGH + - \ref GFS_OZPHYS + - \ref GFS_H2OPHYS + - \ref GFS_SAMFdeep + - \ref GFS_SAMFshal + - \ref GFDL_cloud + - \ref GFS_CALPRECIPTYPE + +\section sdf_gfsv15p2_no_nsst Suite Definition File +- For GRIB2 initialization data: \subpage suite_FV3_GFS_v15p2_no_nsst_xml + +\section gfs15p2nonsst_nml_opt_des Namelist + +- \b &gfs_physics_nml +\n \c fhzero = 6 +\n \c h2o_phys = .true. +\n \c ldiag3d = .false. +\n \c fhcyc = 24 +\n \c use_ufo = .true. +\n \c pre_rad = .false. +\n \c ncld = 5 +\n \c imp_physics = 11 +\n \c pdfcld = .false. +\n \c fhswr = 3600. +\n \c fhlwr = 3600. +\n \c ialb = 1 +\n \c iems = 1 +\n \c iaer = 111 +\n \c ico2 = 2 +\n \c isubc_sw = 2 +\n \c isubc_lw = 2 +\n \c isol = 2 +\n \c lwhtr = .true. +\n \c swhtr = .true. +\n \c cnvgwd = .true. +\n \c shal_cnv = .true. +\n \c cal_pre = .false. +\n \c redrag = .true. +\n \c dspheat = .true. +\n \c hybedmf = .true. +\n \c random_clds = .false. +\n \c trans_trac = .true. +\n \c cnvcld = .true. +\n \c imfshalcnv = 2 +\n \c imfdeepcnv = 2 +\n \c cdmbgwd = 3.5,0.25 [1.0,1.2] [0.2,2.5] [0.125,3.0] ! [C768] [C384] [C192] [C96]L64 +\n \c prslrd0 = 0. +\n \c ivegsrc = 1 +\n \c isot = 1 +\n \c debug = .false. +\n \c oz_phys = .F. +\n \c oz_phys_2015 = .T. +\n \c nstf_name = 0,0,0,0,0 +\n \c nst_anl = .true. +\n \c psautco = 0.0008,0.0005 +\n \c prautco = 0.00015,0.00015 +\n \c lgfdlmprad = .true. +\n \c effr_in = .true. +\n \c do_sppt = .false. +\n \c do_shum = .false. +\n \c do_skeb = .false. +\n \c do_sfcperts = .false. + +- \b &gfdl_cloud_microphysics_nml +\n \c sedi_transport = .true. +\n \c do_sedi_heat = .false. +\n \c rad_snow = .true. +\n \c rad_graupel = .true. +\n \c rad_rain = .true. +\n \c const_vi = .F. +\n \c const_vs = .F. +\n \c const_vg = .F. +\n \c const_vr = .F. +\n \c vi_max = 1. +\n \c vs_max = 2. +\n \c vg_max = 12. +\n \c vr_max = 12. +\n \c qi_lim = 1. +\n \c prog_ccn = .false. +\n \c do_qa = .true. +\n \c fast_sat_adj = .true. +\n \c tau_l2v = 225. +\n \c tau_v2l = 150. +\n \c tau_g2v = 900. +\n \c rthresh = 10.e-6 +\n \c dw_land = 0.16 +\n \c dw_ocean = 0.10 +\n \c ql_gen = 1.0e-3 +\n \c ql_mlt = 1.0e-3 +\n \c qi0_crt = 8.0E-5 +\n \c qs0_crt = 1.0e-3 +\n \c tau_i2s = 1000. +\n \c c_psaci = 0.05 +\n \c c_pgacs = 0.01 +\n \c rh_inc = 0.30 +\n \c rh_inr = 0.30 +\n \c rh_ins = 0.30 +\n \c ccn_l = 300. +\n \c ccn_o = 100. +\n \c c_paut = 0.5 +\n \c c_cracw = 0.8 +\n \c use_ppm = .false. +\n \c use_ccn = .true. +\n \c mono_prof = .true. +\n \c z_slope_liq = .true. +\n \c z_slope_ice = .true. +\n \c de_ice = .false. +\n \c fix_negative = .true. +\n \c icloud_f = 1 +\n \c mp_time = 150. + +*/ diff --git a/physics/docs/pdftxt/GFSv15p2_suite.txt b/physics/docs/pdftxt/GFSv15p2_suite.txt new file mode 100644 index 000000000..944fd49f1 --- /dev/null +++ b/physics/docs/pdftxt/GFSv15p2_suite.txt @@ -0,0 +1,133 @@ +/** +\page GFS_v15p2_page GFS_v15p2 Suite + +\section gfs1_suite_overview Overview + +Suite GFS_v15p2 has the parameterizations used in the GFS v15 implemented operationally +in June 2019. + +The GFS_v15p2 physics suite uses the parameterizations in the following order: + - \ref GFS_RRTMG + - \ref GFS_SFCLYR + - \ref GFS_NSST + - \ref GFS_OCEAN + - \ref GFS_NOAH + - \ref GFS_SFCSICE + - \ref GFS_HEDMF + - \ref GFS_UGWP_v0 + - \ref GFS_RAYLEIGH + - \ref GFS_OZPHYS + - \ref GFS_H2OPHYS + - \ref GFS_SAMFdeep + - \ref GFS_SAMFshal + - \ref GFDL_cloud + - \ref GFS_CALPRECIPTYPE + +\section sdf_gfsv15p2 Suite Definition File +- For NEMSIO initialization data: \subpage suite_FV3_GFS_v15p2_xml + +\section gfs15p2_nml_opt_des Namelist + +- \b &gfs_physics_nml +\n \c fhzero = 6 +\n \c h2o_phys = .true. +\n \c ldiag3d = .false. +\n \c fhcyc = 24 +\n \c use_ufo = .true. +\n \c pre_rad = .false. +\n \c ncld = 5 +\n \c imp_physics = 11 +\n \c pdfcld = .false. +\n \c fhswr = 3600. +\n \c fhlwr = 3600. +\n \c ialb = 1 +\n \c iems = 1 +\n \c iaer = 111 +\n \c ico2 = 2 +\n \c isubc_sw = 2 +\n \c isubc_lw = 2 +\n \c isol = 2 +\n \c lwhtr = .true. +\n \c swhtr = .true. +\n \c cnvgwd = .true. +\n \c shal_cnv = .true. +\n \c cal_pre = .false. +\n \c redrag = .true. +\n \c dspheat = .true. +\n \c hybedmf = .true. +\n \c random_clds = .false. +\n \c trans_trac = .true. +\n \c cnvcld = .true. +\n \c imfshalcnv = 2 +\n \c imfdeepcnv = 2 +\n \c cdmbgwd = 3.5,0.25 [1.0,1.2] [0.2,2.5] [0.125,3.0] ! [C768] [C384] [C192] [C96]L64 +\n \c prslrd0 = 0. +\n \c ivegsrc = 1 +\n \c isot = 1 +\n \c debug = .false. +\n \c oz_phys = .F. +\n \c oz_phys_2015 = .T. +\n \c nstf_name = @[NSTF_NAME] +\n \c nst_anl = .true. +\n \c psautco = 0.0008,0.0005 +\n \c prautco = 0.00015,0.00015 +\n \c lgfdlmprad = .true. +\n \c effr_in = .true. +\n \c do_sppt = .false. +\n \c do_shum = .false. +\n \c do_skeb = .false. +\n \c do_sfcperts = .false. + +- \b &gfdl_cloud_microphysics_nml +\n \c sedi_transport = .true. +\n \c do_sedi_heat = .false. +\n \c rad_snow = .true. +\n \c rad_graupel = .true. +\n \c rad_rain = .true. +\n \c const_vi = .F. +\n \c const_vs = .F. +\n \c const_vg = .F. +\n \c const_vr = .F. +\n \c vi_max = 1. +\n \c vs_max = 2. +\n \c vg_max = 12. +\n \c vr_max = 12. +\n \c qi_lim = 1. +\n \c prog_ccn = .false. +\n \c do_qa = .true. +\n \c fast_sat_adj = .true. +\n \c tau_l2v = 225. +\n \c tau_v2l = 150. +\n \c tau_g2v = 900. +\n \c rthresh = 10.e-6 +\n \c dw_land = 0.16 +\n \c dw_ocean = 0.10 +\n \c ql_gen = 1.0e-3 +\n \c ql_mlt = 1.0e-3 +\n \c qi0_crt = 8.0E-5 +\n \c qs0_crt = 1.0e-3 +\n \c tau_i2s = 1000. +\n \c c_psaci = 0.05 +\n \c c_pgacs = 0.01 +\n \c rh_inc = 0.30 +\n \c rh_inr = 0.30 +\n \c rh_ins = 0.30 +\n \c ccn_l = 300. +\n \c ccn_o = 100. +\n \c c_paut = 0.5 +\n \c c_cracw = 0.8 +\n \c use_ppm = .false. +\n \c use_ccn = .true. +\n \c mono_prof = .true. +\n \c z_slope_liq = .true. +\n \c z_slope_ice = .true. +\n \c de_ice = .false. +\n \c fix_negative = .true. +\n \c icloud_f = 1 +\n \c mp_time = 150. + +\note nstf_name = \f$[2,0,0,0,0]^1 [2,1,0,0,0]^2 \f$ +- \f$^1\f$ NSST is on and coupled with spin up off +- \f$^2\f$ NSST is on and coupled with spin up on + +*/ diff --git a/physics/docs/pdftxt/GFSv16beta_no_nsst_suite.txt b/physics/docs/pdftxt/GFSv16beta_no_nsst_suite.txt new file mode 100644 index 000000000..3e5205199 --- /dev/null +++ b/physics/docs/pdftxt/GFSv16beta_no_nsst_suite.txt @@ -0,0 +1,167 @@ +/** +\page GFS_v16beta_no_nsst_page GFS_v16beta_no_nsst Suite + +\section gfsv16beta_no_nsst_suite_overview Overview + +Suite GFS_v16beta_no_nsst is a companion suite of GFS_v16beta with GRIB2 data initialization. + +The GFS_v16beta_no_nsst physics suite uses the parameterizations in the following order: + - \ref GFS_RRTMG + - \ref GFS_SFCLYR + - \ref GFS_OCEAN + - \ref GFS_NOAH + - \ref GFS_SFCSICE + - \ref GFS_SATMEDMFVDIFQ + - \ref GFS_UGWP_v0 + - \ref GFS_RAYLEIGH + - \ref GFS_OZPHYS + - \ref GFS_H2OPHYS + - \ref GFS_SAMFdeep + - \ref GFS_SAMFshal + - \ref GFDL_cloud + - \ref GFS_CALPRECIPTYPE + +\section sdf_gfsv16bnonsst Suite Definition File +- For GRIB2 initialization data: \subpage suite_FV3_GFS_v16beta_no_nsst_xml + +\section gfs16betanonsst_nml_opt_des Namelist + +- \b &gfs_physics_nml +\n \c fhzero = 6 +\n \c h2o_phys = .true. +\n \c ldiag3d = .false. +\n \c fhcyc = 24 +\n \c use_ufo = .true. +\n \c pre_rad = .false. +\n \c ncld = 5 +\n \c imp_physics = 11 +\n \c pdfcld = .false. +\n \c fhswr = 3600. +\n \c fhlwr = 3600. +\n \c ialb = 1 +\n \c iems = 1 +\n \c iaer = 5111 +\n \c icliq_sw = 2 +\n \c iovr_lw = 3 +\n \c iovr_sw = 3 +\n \c ico2 = 2 +\n \c isubc_sw = 2 +\n \c isubc_lw = 2 +\n \c isol = 2 +\n \c lwhtr = .true. +\n \c swhtr = .true. +\n \c cnvgwd = .true. +\n \c shal_cnv = .true. +\n \c cal_pre = .false. +\n \c redrag = .true. +\n \c dspheat = .true. +\n \c hybedmf = .false. +\n \c satmedmf = .true. +\n \c isatmedmf = 1 +\n \c lheatstrg = .true. +\n \c random_clds = .false. +\n \c trans_trac = .true. +\n \c cnvcld = .true. +\n \c imfshalcnv = 2 +\n \c imfdeepcnv = 2 +\n \c cdmbgwd = 4.0,0.15,1.0,1.0 [1.1,0.72,1.0,1.0] [0.23,1.5,1.0,1.0] [0.14,1.8,1.0,1.0] ! [C768] [C384] [C192] [C96]L64 +\n \c prslrd0 = 0. +\n \c ivegsrc = 1 +\n \c isot = 1 +\n \c lsoil = 4 +\n \c lsm = 1 +\n \c iopt_dveg = 1 +\n \c iopt_crs = 1 +\n \c iopt_btr = 1 +\n \c iopt_run = 1 +\n \c iopt_sfc = 1 +\n \c iopt_frz = 1 +\n \c iopt_inf = 1 +\n \c iopt_rad = 1 +\n \c iopt_alb = 2 +\n \c iopt_snf = 4 +\n \c iopt_tbot = 2 +\n \c iopt_stc = 1 +\n \c debug = .false. +\n \c oz_phys = .F. +\n \c oz_phys_2015 = .T. +\n \c nstf_name = 0,0,0,0,0 +\n \c nst_anl = .true. +\n \c psautco = 0.0008,0.0005 +\n \c prautco = 0.00015,0.00015 +\n \c lgfdlmprad = .true. +\n \c effr_in = .true. +\n \c ldiag_ugwp = .false. +\n \c do_ugwp = .false. +\n \c do_tofd = .true. +\n \c do_sppt = .false. +\n \c do_shum = .false. +\n \c do_skeb = .false. +\n \c do_sfcperts = .false. + + +- \b &gfdl_cloud_microphysics_nml +\n \c sedi_transport = .true. +\n \c do_sedi_heat = .false. +\n \c rad_snow = .true. +\n \c rad_graupel = .true. +\n \c rad_rain = .true. +\n \c const_vi = .F. +\n \c const_vs = .F. +\n \c const_vg = .F. +\n \c const_vr = .F. +\n \c vi_max = 1. +\n \c vs_max = 2. +\n \c vg_max = 12. +\n \c vr_max = 12. +\n \c qi_lim = 1. +\n \c prog_ccn = .false. +\n \c do_qa = .true. +\n \c fast_sat_adj = .true. +\n \c tau_l2v = 225. +\n \c tau_v2l = 150. +\n \c tau_g2v = 900. +\n \c rthresh = 10.e-6 +\n \c dw_land = 0.16 +\n \c dw_ocean = 0.10 +\n \c ql_gen = 1.0e-3 +\n \c ql_mlt = 1.0e-3 +\n \c qi0_crt = 8.0E-5 +\n \c qs0_crt = 1.0e-3 +\n \c tau_i2s = 1000. +\n \c c_psaci = 0.05 +\n \c c_pgacs = 0.01 +\n \c rh_inc = 0.30 +\n \c rh_inr = 0.30 +\n \c rh_ins = 0.30 +\n \c ccn_l = 300. +\n \c ccn_o = 100. +\n \c c_paut = 0.5 +\n \c c_cracw = 0.8 +\n \c use_ppm = .false. +\n \c use_ccn = .true. +\n \c mono_prof = .true. +\n \c z_slope_liq = .true. +\n \c z_slope_ice = .true. +\n \c de_ice = .false. +\n \c fix_negative = .true. +\n \c icloud_f = 1 +\n \c mp_time = 150. +\n \c reiflag = 2 + + +- \b &cires_ugwp_nml +\n \c knob_ugwp_solver = 2 +\n \c knob_ugwp_source = 1,1,0,0 +\n \c knob_ugwp_wvspec = 1,25,25,25 +\n \c knob_ugwp_azdir = 2,4,4,4 +\n \c knob_ugwp_stoch = 0,0,0,0 +\n \c knob_ugwp_effac = 1,1,1,1 +\n \c knob_ugwp_doaxyz = 1 +\n \c knob_ugwp_doheat = 1 +\n \c knob_ugwp_dokdis = 1 +\n \c knob_ugwp_ndx4lh = 1 +\n \c knob_ugwp_version = 0 +\n \c launch_level = 27 + +*/ diff --git a/physics/docs/pdftxt/GFSv16beta_suite.txt b/physics/docs/pdftxt/GFSv16beta_suite.txt new file mode 100644 index 000000000..8389d0c40 --- /dev/null +++ b/physics/docs/pdftxt/GFSv16beta_suite.txt @@ -0,0 +1,176 @@ +/** +\page GFS_v16beta_page GFS_v16beta Suite + +\section gfsv16beta_suite_overview Overview + +Version 16 of the Global Forecast System (GFS) will be implemented operationally by the NOAA +National Centers for Environmental Prediction (NCEP) in 2021. GFS_v16beta is a prototype of +the GFS_v16 suite. The main difference between the GFS_v15p2 and GFS_v16beta suites is the +replacement of the K-based EDMF PBL scheme with a moist TKE based one. + + +The GFS_v16beta physics suite uses the parameterizations in the following order: + - \ref GFS_RRTMG + - \ref GFS_SFCLYR + - \ref GFS_NSST + - \ref GFS_OCEAN + - \ref GFS_NOAH + - \ref GFS_SFCSICE + - \ref GFS_SATMEDMFVDIFQ + - \ref GFS_UGWP_v0 + - \ref GFS_RAYLEIGH + - \ref GFS_OZPHYS + - \ref GFS_H2OPHYS + - \ref GFS_SAMFdeep + - \ref GFS_SAMFshal + - \ref GFDL_cloud + - \ref GFS_CALPRECIPTYPE + +\section sdf_gfsv16b Suite Definition File +- For NEMSIO initialization data: \subpage suite_FV3_GFS_v16beta_xml + +\section gfs16beta_nml_opt_des Namelist + +- \b &gfs_physics_nml +\n \c fhzero = 6 +\n \c h2o_phys = .true. +\n \c ldiag3d = .false. +\n \c fhcyc = 24 +\n \c use_ufo = .true. +\n \c pre_rad = .false. +\n \c ncld = 5 +\n \c imp_physics = 11 +\n \c pdfcld = .false. +\n \c fhswr = 3600. +\n \c fhlwr = 3600. +\n \c ialb = 1 +\n \c iems = 1 +\n \c iaer = 5111 +\n \c icliq_sw = 2 +\n \c iovr_lw = 3 +\n \c iovr_sw = 3 +\n \c ico2 = 2 +\n \c isubc_sw = 2 +\n \c isubc_lw = 2 +\n \c isol = 2 +\n \c lwhtr = .true. +\n \c swhtr = .true. +\n \c cnvgwd = .true. +\n \c shal_cnv = .true. +\n \c cal_pre = .false. +\n \c redrag = .true. +\n \c dspheat = .true. +\n \c hybedmf = .false. +\n \c satmedmf = .true. +\n \c isatmedmf = 1 +\n \c lheatstrg = .true. +\n \c random_clds = .false. +\n \c trans_trac = .true. +\n \c cnvcld = .true. +\n \c imfshalcnv = 2 +\n \c imfdeepcnv = 2 +\n \c cdmbgwd = 4.0,0.15,1.0,1.0 [1.1,0.72,1.0,1.0] [0.23,1.5,1.0,1.0] [0.14,1.8,1.0,1.0] ! [C768] [C384] [C192] [C96]L64 +\n \c prslrd0 = 0. +\n \c ivegsrc = 1 +\n \c isot = 1 +\n \c lsoil = 4 +\n \c lsm = 1 +\n \c iopt_dveg = 1 +\n \c iopt_crs = 1 +\n \c iopt_btr = 1 +\n \c iopt_run = 1 +\n \c iopt_sfc = 1 +\n \c iopt_frz = 1 +\n \c iopt_inf = 1 +\n \c iopt_rad = 1 +\n \c iopt_alb = 2 +\n \c iopt_snf = 4 +\n \c iopt_tbot = 2 +\n \c iopt_stc = 1 +\n \c debug = .false. +\n \c oz_phys = .F. +\n \c oz_phys_2015 = .T. +\n \c nstf_name = @[NSTF_NAME] +\n \c nst_anl = .true. +\n \c psautco = 0.0008,0.0005 +\n \c prautco = 0.00015,0.00015 +\n \c lgfdlmprad = .true. +\n \c effr_in = .true. +\n \c ldiag_ugwp = .false. +\n \c do_ugwp = .false. +\n \c do_tofd = .true. +\n \c do_sppt = .false. +\n \c do_shum = .false. +\n \c do_skeb = .false. +\n \c do_sfcperts = .false. + + +- \b &gfdl_cloud_microphysics_nml +\n \c sedi_transport = .true. +\n \c do_sedi_heat = .false. +\n \c rad_snow = .true. +\n \c rad_graupel = .true. +\n \c rad_rain = .true. +\n \c const_vi = .F. +\n \c const_vs = .F. +\n \c const_vg = .F. +\n \c const_vr = .F. +\n \c vi_max = 1. +\n \c vs_max = 2. +\n \c vg_max = 12. +\n \c vr_max = 12. +\n \c qi_lim = 1. +\n \c prog_ccn = .false. +\n \c do_qa = .true. +\n \c fast_sat_adj = .true. +\n \c tau_l2v = 225. +\n \c tau_v2l = 150. +\n \c tau_g2v = 900. +\n \c rthresh = 10.e-6 +\n \c dw_land = 0.16 +\n \c dw_ocean = 0.10 +\n \c ql_gen = 1.0e-3 +\n \c ql_mlt = 1.0e-3 +\n \c qi0_crt = 8.0E-5 +\n \c qs0_crt = 1.0e-3 +\n \c tau_i2s = 1000. +\n \c c_psaci = 0.05 +\n \c c_pgacs = 0.01 +\n \c rh_inc = 0.30 +\n \c rh_inr = 0.30 +\n \c rh_ins = 0.30 +\n \c ccn_l = 300. +\n \c ccn_o = 100. +\n \c c_paut = 0.5 +\n \c c_cracw = 0.8 +\n \c use_ppm = .false. +\n \c use_ccn = .true. +\n \c mono_prof = .true. +\n \c z_slope_liq = .true. +\n \c z_slope_ice = .true. +\n \c de_ice = .false. +\n \c fix_negative = .true. +\n \c icloud_f = 1 +\n \c mp_time = 150. +\n \c reiflag = 2 + + +- \b &cires_ugwp_nml +\n \c knob_ugwp_solver = 2 +\n \c knob_ugwp_source = 1,1,0,0 +\n \c knob_ugwp_wvspec = 1,25,25,25 +\n \c knob_ugwp_azdir = 2,4,4,4 +\n \c knob_ugwp_stoch = 0,0,0,0 +\n \c knob_ugwp_effac = 1,1,1,1 +\n \c knob_ugwp_doaxyz = 1 +\n \c knob_ugwp_doheat = 1 +\n \c knob_ugwp_dokdis = 1 +\n \c knob_ugwp_ndx4lh = 1 +\n \c knob_ugwp_version = 0 +\n \c launch_level = 27 + +\note nstf_name = \f$[2,0,0,0,0]^1 [2,1,0,0,0]^2\f$ +- \f$^1\f$ NSST is on and coupled with spin up off +- \f$^2\f$ NSST is on and coupled with spin up on + +*/ diff --git a/physics/docs/pdftxt/GSD_adv_suite.txt b/physics/docs/pdftxt/GSD_adv_suite.txt index fb662bc22..39c5ebd20 100644 --- a/physics/docs/pdftxt/GSD_adv_suite.txt +++ b/physics/docs/pdftxt/GSD_adv_suite.txt @@ -1,47 +1,38 @@ /** -\page GSD_v0_page GSD_v0 Suite +\page GSD_v1_page GSD_v1 Suite \section gsd_suite_overview Overview -The original Rapid Update Cycle (RUC), implemented in 1994, was designed to provide accurate short-range (0 to 12-hr) -numerical forecast guidance for weather-sensitive users, including those in the U.S. aviation community. -The RUC started to run every hour starting in 1998. Significant weather forecasting problems that occur in the 0- to -12-hr range include severe weather in all seasons (for example, tornadoes, severe thunderstorms, crippling snow, and -ice storms) and hazards to aviation (for example, clear air turbulence, icing, and downbursts). The RUC soon became a -key model for short-range convectiion forecasts and for the pre-convective environments. +Suite GSD_v1 contains the parameterizations used in the NOAA operational Rapid Refresh (RAP) +and High-Resolution Rapid Refresh (HRRR) models. These models runs at 13- and 3- km resolution, +respectively. -The RAP, which replaced the RUC in 2012, runs hourly at the National Centers for Environmental Prediction (NCEP), providing -high frequency updates of current conditions and short-range forecasts over North America at 13km resolution. A CONUS-nested -version at 3-km resolution called the High Resolution Rapid Refresh (HRRR), was implemented in the fall of 2014. Additional Model Information Links: - https://rapidrefresh.noaa.gov - https://rapidrefresh.noaa.gov/hrrr/ -The advanced GSD RAP/HRRR physics suite uses the parameterizations in the following order: +The GSD_v1 physics suite uses the parameterizations in the following order: - \ref GFS_RRTMG - \ref GFS_SFCLYR - \ref GFS_NSST - \ref GSD_RUCLSM - \ref GSD_MYNNEDMF - - \ref GFS_GWDPS + - \ref GFS_UGWP_v0 - \ref GFS_RAYLEIGH - \ref GFS_OZPHYS - \ref GFS_H2OPHYS - \ref GSD_CU_GF - \ref cu_gf_deep_group - \ref cu_gf_sh_group - - \ref GFS_GWDC - \ref GSD_THOMPSON - \ref GFS_CALPRECIPTYPE \section sdf_gsdsuite Suite Definition File - -The GSD RAP/HRRR physics suite uses the parameterizations in the following order, as defined in \c SCM_GSD_v0: \code - + @@ -72,9 +63,10 @@ The GSD RAP/HRRR physics suite uses the parameterizations in the following order GFS_suite_stateout_reset get_prs_fv3 GFS_suite_interstitial_1 - dcyc2t3 GFS_surface_generic_pre GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter GFS_suite_interstitial_2 @@ -85,19 +77,22 @@ The GSD RAP/HRRR physics suite uses the parameterizations in the following order sfc_nst sfc_nst_post lsm_ruc + lsm_ruc_sfc_sice_pre + sfc_sice + lsm_ruc_sfc_sice_post GFS_surface_loop_control_part2 GFS_surface_composites_post - dcyc2t3_post sfc_diag sfc_diag_post GFS_surface_generic_post mynnedmf_wrapper GFS_GWD_generic_pre - gwdps - gwdps_post + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post rayleigh_damp GFS_suite_stateout_update ozphys_2015 @@ -108,9 +103,6 @@ The GSD RAP/HRRR physics suite uses the parameterizations in the following order cu_gf_driver_pre cu_gf_driver GFS_DCNV_generic_post - gwdc_pre - gwdc - gwdc_post GFS_SCNV_generic_pre GFS_SCNV_generic_post GFS_suite_interstitial_4 @@ -126,73 +118,149 @@ The GSD RAP/HRRR physics suite uses the parameterizations in the following order - \endcode -\section gsd_nml_option Namelist Option +\section gsd_nml_option Namelist \code &gfs_physics_nml - fhzero = 6. - h2o_phys = .true. - ldiag3d = .true. - fhcyc = 0. - nst_anl = .true. - use_ufo = .true. - pre_rad = .false. - ncld = 5 - imp_physics = 8 - ltaerosol = .true. - lradar = .true. - ttendlim = -999. - pdfcld = .false. - fhswr = 3600. - fhlwr = 3600. - ialb = 1 - iems = 1 - iaer = 111 - ico2 = 2 - isubc_sw = 2 - isubc_lw = 2 - isol = 2 - lwhtr = .true. - swhtr = .true. - cnvgwd = .true. - shal_cnv = .true. - cal_pre = .false. - redrag = .true. - dspheat = .true. - hybedmf = .false. - satmedmf = .false. - lheatstrg = .false. - do_mynnedmf = .true. - do_mynnsfclay = .false. - random_clds = .false. - trans_trac = .true. - cnvcld = .true. - imfshalcnv = 3 - imfdeepcnv = 3 - cdmbgwd = 3.5,0.25 - prslrd0 = 0. - ivegsrc = 1 - isot = 1 - debug = .false. - oz_phys = .false. - oz_phys_2015 = .true. - nstf_name = 2,1,1,0,5 - cplflx = .false. - iau_delthrs = 6 - iaufhrs = 30 - iau_inc_files = "''" - do_sppt = .false. - do_shum = .false. - do_skeb = .false. - do_sfcperts = .false. - lsm = 2 - lsoil_lsm = 9 + fhzero = 6. + h2o_phys = .true. + ldiag3d = .true. + fhcyc = 0. + nst_anl = .true. + use_ufo = .true. + pre_rad = .false. + ncld = 5 + imp_physics = 8 + ltaerosol = .true. + lradar = .true. + ttendlim = 0.004 + pdfcld = .false. + fhswr = 3600. + fhlwr = 3600. + ialb = 1 + iems = 1 + iaer = 111 + ico2 = 2 + isubc_sw = 2 + isubc_lw = 2 + isol = 2 + lwhtr = .true. + swhtr = .true. + cnvgwd = .true. + shal_cnv = .true. + cal_pre = .false. + redrag = .true. + dspheat = .true. + hybedmf = .false. + satmedmf = .false. + lheatstrg = .false. + do_mynnedmf = .true. + do_mynnsfclay = .false. + random_clds = .false. + trans_trac = .true. + cnvcld = .true. + imfshalcnv = 3 + imfdeepcnv = 3 + cdmbgwd = 3.5,0.25 + prslrd0 = 0. + ivegsrc = 1 + isot = 1 + debug = .false. + oz_phys = .false. + oz_phys_2015 = .true. + nstf_name = 2,1,1,0,5 + cplflx = .false. + iau_delthrs = 6 + iaufhrs = 30 + iau_inc_files = "''" + do_sppt = .false. + do_shum = .false. + do_skeb = .false. + do_sfcperts = .false. + lsm = 3 + lsoil_lsm = 9 + iopt_dveg = 2 + iopt_crs = 1 + iopt_btr = 1 + iopt_run = 1 + iopt_sfc = 1 + iopt_frz = 1 + iopt_inf = 1 + iopt_rad = 1 + iopt_alb = 2 + iopt_snf = 4 + iopt_tbot = 2 + iopt_stc = 1 icloud_bl = 1 bl_mynn_tkeadvect = .true. bl_mynn_edmf = 1 bl_mynn_edmf_mom = 1 + gwd_opt = 1 +/ + +&gfdl_cloud_microphysics_nml + sedi_transport = .true. + do_sedi_heat = .false. + rad_snow = .true. + rad_graupel = .true. + rad_rain = .true. + const_vi = .F. + const_vs = .F. + const_vg = .F. + const_vr = .F. + vi_max = 1. + vs_max = 2. + vg_max = 12. + vr_max = 12. + qi_lim = 1. + prog_ccn = .false. + do_qa = .false. + fast_sat_adj = .false. + tau_l2v = 225. + tau_v2l = 150. + tau_g2v = 900. + rthresh = 10.e-6 + dw_land = 0.16 + dw_ocean = 0.10 + ql_gen = 1.0e-3 + ql_mlt = 1.0e-3 + qi0_crt = 8.0E-5 + qs0_crt = 1.0e-3 + tau_i2s = 1000. + c_psaci = 0.05 + c_pgacs = 0.01 + rh_inc = 0.30 + rh_inr = 0.30 + rh_ins = 0.30 + ccn_l = 300. + ccn_o = 100. + c_paut = 0.5 + c_cracw = 0.8 + use_ppm = .false. + use_ccn = .true. + mono_prof = .true. + z_slope_liq = .true. + z_slope_ice = .true. + de_ice = .false. + fix_negative = .true. + icloud_f = 1 + mp_time = 150. +/ + +&cires_ugwp_nml + knob_ugwp_solver = 2 + knob_ugwp_source = 1,1,0,0 + knob_ugwp_wvspec = 1,25,25,25 + knob_ugwp_azdir = 2,4,4,4 + knob_ugwp_stoch = 0,0,0,0 + knob_ugwp_effac = 1,1,1,1 + knob_ugwp_doaxyz = 1 + knob_ugwp_doheat = 1 + knob_ugwp_dokdis = 1 + knob_ugwp_ndx4lh = 1 + knob_ugwp_version = 0 + launch_level = 25 / \endcode diff --git a/physics/docs/pdftxt/UGWPv0.txt b/physics/docs/pdftxt/UGWPv0.txt deleted file mode 100644 index da7009b79..000000000 --- a/physics/docs/pdftxt/UGWPv0.txt +++ /dev/null @@ -1,21 +0,0 @@ -/** -\page UGWPv0 Unified Gravity Wave Physics Version 0 -\section des_UGWP Description - -Gravity waves (GWs) are generated by a variety of sources in the atmosphere including orographic GWs (OGWs; quasi-stationary waves) and non-orographic GWs (NGWs; non-stationary oscillations). The subgrid scale parameterization scheme for OGWs can be found in Section \ref GFS_GWDPS. This scheme represents the operational version of the subgrid scale orography effects in Version 15 of Global Forecast System (GFS). - -The NGW physics scheme parameterizes the effects of non-stationary subgrid-scale waves in the global atmosphere models extended into the stratosphere, mesosphere, and thermosphere. These non-stationary oscillations with periods bounded by Coriolis and Brunt-Väisälä frequencies and typical horizontal scales from tens to several hundreds of kilometers are forced by the imbalance of convective and frontal/jet dynamics in the troposphere and lower stratosphere (Fritts 1984 \cite fritts_1984; Alexander et al. 2010 \cite alexander_et_al_2010; Plougonven and Zhang 2014 \cite plougonven_and_zhang_2014). The NGWs propagate upwards and the amplitudes exponentially grow with altitude until instability and breaking of waves occur. Convective and dynamical instability induced by GWs with large amplitudes can trigger production of small-scale turbulence and self-destruction of waves. The latter process in the theory of atmospheric GWs is frequently referred as the wave saturation (Lindzen 1981 \cite lindzen_1981; Weinstock 1984 \cite weinstock_1984; Fritts 1984 \cite fritts_1984). Herein, “saturation” or "breaking" refers to any processes that act to reduce wave amplitudes due to instabilities and/or interactions arising from large-amplitude perturbations limiting the exponential growth of GWs with height. Background dissipation processes such as molecular diffusion and radiative cooling, in contrast, act independently of GW amplitudes. In the middle atmosphere, impacts of NGW saturation (or breaking) and dissipation on the large-scale circulation, mixing, and transport have been acknowledged in the physics of global weather and climate models after pioneering studies by Lindzen 1981 \cite lindzen_1981 and Holton 1983 \cite holton_1983. Comprehensive reviews on the physics of NGWs and OGWs in the climate research and weather forecasting highlighted the variety of parameterization schemes for NGWs （Alexander et al. 2010 \cite alexander_et_al_2010; Geller et al. 2013 \cite geller_et_al_2013; Garcia et al. 2017 \cite garcia_et_al_2017). They are formulated using different aspects of the nonlinear and linear propagation, instability, breaking and dissipation of waves along with different specifications of GW sources (Garcia et al. 2007 \cite garcia_et_al_2007; Richter et al 2010 \cite richter_et_al_2010; Eckermann et al. 2009 \cite eckermann_et_al_2009; Eckermann 2011 \cite eckermann_2011; Lott et al. 2012 \cite lott_et_al_2012). - -The current operational GFS physics parameterizes effects of stationary OGWs and convective GWs, neglecting the impacts of non-stationary subgrid scale GW physics. This leads to well-known shortcomings in the global model predictions in the stratosphere and upper atmosphere (Alexander et al. 2010 \cite alexander_et_al_2010; Geller et al. 2013). In order to describe the effects of unresolved GWs by dynamical cores in global forecast models, subgrid scales physics of stationary and non-stationary GWs needs to be implemented in the self-consistent manner under the Unified Gravity Wave Physics (UGWP) framework. - -The concept of UGWP and the related programming architecture implemented in FV3GFS was first proposed by CU-CIRES, NOAA Space Weather Prediction Center (SWPC) and Environmental Modeling Center (EMC) for the Unified Forecast System (UFS) with variable positions of the model top lids (Alpert et al. 2019 \cite alpert_et_al_2019; Yudin et al. 2016 \cite yudin_et_al_2016; Yudin et al. 2018 \cite yudin_et_al_2018). As above, the UGWP considers identical GW propagation solvers for OGWs and NGWs with different approaches for specification of subgrid wave sources. The current set of the input and control parameters for UGWP version 0 (UGWP-v0) can select different options for GW effects including momentum deposition (also called GW drag), heat deposition, and mixing by eddy viscosity, conductivity and diffusion. The input GW parameters can control the number of directional azimuths in which waves can propagate, number of waves in single direction, and the interface model layer from the surface at which NGWs can be launched. Among the input parameters, the GW efficiency factors reflect intermittency of wave excitation. They can vary with horizontal resolutions, reflecting capability of the FV3 dynamical core to resolve mesoscale wave activity with the enhancement of model resolution. The prescribed distributions for vertical momentum flux (VMF) of NGWs have been employed in the global forecast models of NWP centers and reanalysis projects to ease tuning of GW schemes to the climatology of the middle atmosphere dynamics in the absence of the global wind data above about 35 km (Eckermann et al. 2009 \cite eckermann_et_al_2009; Molod et al. 2015 \cite molod_et_al_2015). These distributions of VMF qualitatively describe the general features of the latitudinal and seasonal variations of the global GW activity in the lower stratosphere, observed from the ground and space (Ern et al. 2018 \cite ern_et_al_2018). For the long-term climate projections, global models seek to establish communication between model physics and dynamics. This provides variable in time and space excitation of subgrid GWs under year-to-year variations of solar input and anthropogenic emissions (Richter et al 2010 \cite richter_et_al_2010; 2014 \cite richter_et_al_2014). - -Note that in the first release of UGWP (UGWP-v0), the momentum and heat deposition due to GW breaking and dissipation have been tested in the multi-year simulations and medium-range forecasts using FV3GFS-L127 configuration with top lid at about 80 km. In addition, the eddy mixing effects induced by instability of GWs are not activated in this version. Along with the GW heat and momentum depositions, GW eddy mixing is an important element of the Whole Atmosphere Model (WAM) physics, as shown in WAM simulations with the spectral dynamics (Yudin et al. 2018 \cite yudin_et_al_2018). The additional impact of eddy mixing effects in the middle and upper atmosphere need to be further tested, evaluated, and orchestrated with the subgrid turbulent diffusion of the GFS physics (work in progress). In UFS, the WAM with FV3 dynamics (FV3-WAM) will represent the global atmosphere model configuration extended into the thermosphere (top lid at ~600 km). In the mesosphere and thermosphere, the background attenuation of subgrid waves due to molecular and turbulent diffusion, radiative damping and ion drag will be the additional mechanism of NGW and OGW dissipation along with convective and dynamical instability of waves described by the linear (Lindzen 1981 \cite lindzen_1981) and nonlinear (Weinstock 1984 \cite weinstock_1984; Hines 1997 \cite hines_1997) saturation theories. - -\section intra_UGWPv0 Intraphysics Communication -\ref arg_table_cires_ugwp_run - -\section gen_al_ugwpv0 General Algorithm -\ref cires_ugwp_run - -*/ diff --git a/physics/docs/pdftxt/all_shemes_list.txt b/physics/docs/pdftxt/all_shemes_list.txt index 3f2290d7b..4d7d08e90 100644 --- a/physics/docs/pdftxt/all_shemes_list.txt +++ b/physics/docs/pdftxt/all_shemes_list.txt @@ -1,11 +1,10 @@ /** \page allscheme_page Parameterizations and Suites Overview -\section allscheme_overview Physics Parameterizations +\section allscheme_overview Physical Parameterizations -In the CCPP-Physics v3.0 release, each parameterization is in its own modern Fortran module, - which facilitates model development and -code maintenance. While some individual parameterization can be invoked for the GMTB SCM, most users will assemble the +In the CCPP, each parameterization is in its own modern Fortran module, which facilitates model development and +code maintenance. While some individual parameterization can be invoked for the SCM, most users will assemble the parameterizations in suites. - \b Radiation @@ -14,6 +13,7 @@ parameterizations in suites. - \b PBL \b and \b Turbulence - \subpage GFS_HEDMF - \subpage GFS_SATMEDMF + - \subpage GFS_SATMEDMFVDIFQ - \subpage GSD_MYNNEDMF - \b Land \b Surface \b Model @@ -37,19 +37,18 @@ parameterizations in suites. - \b Ozone \b Photochemical \b Production \b and \b Loss - \subpage GFS_OZPHYS - - \ref GFS_ozphys_2015 - \b Water \b Vapor \b Photochemical \b Production \b and \b Loss - \subpage GFS_H2OPHYS - \b Gravity \b Wave \b Drag - - \subpage GFS_GWDPS - - \subpage GFS_GWDC - - \subpage UGWPv0 + - \subpage GFS_UGWP_v0 + - \subpage GFS_GWDPS - \b Surface \b Layer \b and \b Simplified \b Ocean \b and \b Sea \b Ice \b Representation - \subpage GFS_SFCLYR - \subpage GFS_NSST + - \subpage GFS_OCEAN - \subpage GFS_SFCSICE - \b Others @@ -81,25 +80,34 @@ to the parameterization. \section allsuite_overview Physics Suites -The CCPP v3 includes the suite used in the GFS v15 implemented operationally in June 2019 (suite GFS_v15). Additionally, it includes three -developmental suites which are undergoing testing for possible future implementation in the UFS. Suite GFS_v15plus is identical to suite -GFS_v15 except for a replacement in the PBL parameterization (Han et al. 2019 \cite Han_2019 ). Suite csawmg differs from GFS_v15 as it +The CCPP includes the suite GFS_v15p2, which has the same parameterizations used in the GFS v15 implemented operationally in June 2019, and suite +GFS_v16beta, i.e., the beta version of the suite planned for GFS v16 to be implemented operationally in 2021. Suite GFS_v16beta is identical to +Suite GFS_v15p2 except for an update in the PBL parameterization (Han et al. 2019 \cite Han_2019 ). Additionally, CCPP v4 includes two +developmental suites which are undergoing testing to inform future implementations of the UFS. Suite csawmg differs from GFS_v15p2 as it contains different convection and microphysics schemes made available through a NOAA Climate Process Team (CPT) with components developed -at multiple research centers and universities, including Colorado State, Utah, NASA, NCAR, and EMC. Suite GSD_v0 differs from GFS_v15 as it +at multiple research centers and universities, including Colorado State, Utah, NASA, NCAR, and EMC. Suite GSD_v1 differs from GFS_v15p2 as it uses the convection, microphysics, and boundary layer schemes employed in the Rapid Refresh (RAP) and High-Resolution Rapid Refresh (HRRR \cite Benjamin_2016 ) operational models and was assembled by NOAA/GSD. An assessment of an earlier version of these suites can be found in the UFS portal -and in the GMTB website . +and in the DTC website . Two variant suites labelled as \a no_nsst are simplification of GFS_v15p2 and GFS_v16beta. +This simplification is needed when the UFS is initialized with files in GRIdded Binary Edition 2 (GRIB2) format instead of files in NOAA Environmental Modeling +System (NEMS) Input/Output (NEMSIO) format because the fields necesary to predict (SST) are not available in the GRIB2 files. Table 1. Physics suite options included in this documentation. \tableofcontents -| Phys suites | GFS_v15 | GFS_v15plus | csawmg | GSD_v0 | -|------------------|----------------------|----------------------|---------------------|----------------------| -| Deep Cu | \ref GFS_SAMFdeep | \ref GFS_SAMFdeep | \ref CSAW_scheme | \ref GSD_CU_GF | -| Shallow Cu | \ref GFS_SAMFshal | \ref GFS_SAMFshal | \ref GFS_SAMFshal | \ref GSD_MYNNEDMF and \ref cu_gf_sh_group | -| Microphysics | \ref GFDL_cloud | \ref GFDL_cloud | \ref CPT_MG3 | \ref GSD_THOMPSON | -| PBL/TURB | \ref GFS_HEDMF | \ref GFS_SATMEDMF | \ref GFS_HEDMF | \ref GSD_MYNNEDMF | -| Land | \ref GFS_NOAH | \ref GFS_NOAH | \ref GFS_NOAH | \ref GSD_RUCLSM | +| Physics suites | GFS_v15p2 | GFS_v16beta | csawmg | GSD_v1 | GFS_v15p2_no_nsst | GFS_v16beta_no_nsst | +|------------------|----------------------|--------------------------|---------------------|---------------------------------------------|-------------------------|---------------------------| +| Deep Cu | \ref GFS_SAMFdeep | \ref GFS_SAMFdeep | \ref CSAW_scheme | \ref GSD_CU_GF | \ref GFS_SAMFdeep | \ref GFS_SAMFdeep | +| Shallow Cu | \ref GFS_SAMFshal | \ref GFS_SAMFshal | \ref GFS_SAMFshal | \ref GSD_MYNNEDMF and \ref cu_gf_sh_group | \ref GFS_SAMFshal | \ref GFS_SAMFshal | +| Microphysics | \ref GFDL_cloud | \ref GFDL_cloud | \ref CPT_MG3 | \ref GSD_THOMPSON | \ref GFDL_cloud | \ref GFDL_cloud | +| PBL/TURB | \ref GFS_HEDMF | \ref GFS_SATMEDMFVDIFQ | \ref GFS_HEDMF | \ref GSD_MYNNEDMF | \ref GFS_HEDMF | \ref GFS_SATMEDMFVDIFQ | +| Radiation | \ref GFS_RRTMG | \ref GFS_RRTMG | \ref GFS_RRTMG | \ref GFS_RRTMG | \ref GFS_RRTMG | \ref GFS_RRTMG | +| Surface Layer | \ref GFS_SFCLYR | \ref GFS_SFCLYR | \ref GFS_SFCLYR | \ref GFS_SFCLYR | \ref GFS_SFCLYR | \ref GFS_SFCLYR | +| Land | \ref GFS_NOAH | \ref GFS_NOAH | \ref GFS_NOAH | \ref GSD_RUCLSM | \ref GFS_NOAH | \ref GFS_NOAH | +| Gravity Wave Drag| \ref GFS_UGWP_v0 | \ref GFS_UGWP_v0 | \ref GFS_UGWP_v0 | \ref GFS_UGWP_v0 | \ref GFS_UGWP_v0 | \ref GFS_UGWP_v0 | +| Ocean | \ref GFS_NSST | \ref GFS_NSST | \ref GFS_NSST | \ref GFS_NSST | \ref GFS_OCEAN | \ref GFS_OCEAN | +| Ozone | \ref GFS_OZPHYS | \ref GFS_OZPHYS | \ref GFS_OZPHYS | \ref GFS_OZPHYS | \ref GFS_OZPHYS | \ref GFS_OZPHYS | +| Water Vapor | \ref GFS_H2OPHYS | \ref GFS_H2OPHYS | \ref GFS_H2OPHYS | \ref GFS_H2OPHYS | \ref GFS_H2OPHYS | \ref GFS_H2OPHYS | \tableofcontents diff --git a/physics/docs/pdftxt/mainpage.txt b/physics/docs/pdftxt/mainpage.txt index 2ac121f3c..fdf7d1294 100644 --- a/physics/docs/pdftxt/mainpage.txt +++ b/physics/docs/pdftxt/mainpage.txt @@ -1,22 +1,26 @@ /** \mainpage Introduction -Welcome to the scientific documentation for the parameterizations available in the Common -Community Physics Package (CCPP) v3.0 public release. +Welcome to the scientific documentation for the parameterizations and suites available in the Common +Community Physics Package (CCPP) v4. -The CCPP-Physics is envisioned to contain parameterizations used by NOAA operational models for weather through -seasonal prediction timescales, as well as developmental schemes under consideration for upcoming +The CCPP-Physics is envisioned to contain parameterizations used in NOAA's Unified Forecast System (UFS) +applications for weather through seasonal prediction timescales, encompassing operational schemes as well as +developmental schemes under consideration for upcoming operational implementations. This version contains all parameterizations of the current operational GFS, -plus additional developmental schemes. The CCPP can currently be used with the Single Column Model (SCM) developed -by the Global Model Test Bed (GMTB) of the Developmental Testbed Center, as well as with the atmospheric component -of NOAA's Unified Forecast System (UFS-Atmosphere), which employs the the non-hydrostatic -Finite-Volume Cubed-Sphere (FV3) dynamic core. +plus additional developmental schemes. There are four suites supported for use with the Single Column Model (SCM) +developed by the Development Testbed Center (GFS_v15p2, GFS_v16beta, GSD_v1, and csawmg), and four suites +supported for use with the atmospheric component of the UFS (i.e., GFS_v15p2, GFS_v15p2_no_nsst, GFS_v16beta and +GFS_v16beta_no_nsst). The variants labelled as \a no_nsst are a simplification of GFS_v15p2 and GFS_v16beta suites +. This simplification is needed when the UFS is initialized with files in GRIdded Binary Edition 2 (GRIB2) +format instead of files in NOAA Environmental Modeling System (NEMS) Input/Output (NEMSIO) format because the +fields necessary to predict (SST) are not available in the GRIB2 files. In this website you will find documentation on various aspects of each parameterization, including a high-level overview of its function, the input/output argument list, and a description of the algorithm. -The latest CCPP public release is Version 3.0 (June 2019), and more details on it may be found on the - CCPP website hosted by the Global Model Test -Bed (GMTB) of the Developmental Testbed Center (DTC). +The latest CCPP public release is Version 4.0 (March 2020), and more details on it may be found on the + CCPP website hosted by +the Developmental Testbed Center (DTC). */ diff --git a/physics/docs/pdftxt/suite_FV3_GFS_v15p2.xml.txt b/physics/docs/pdftxt/suite_FV3_GFS_v15p2.xml.txt new file mode 100644 index 000000000..4074ddfc7 --- /dev/null +++ b/physics/docs/pdftxt/suite_FV3_GFS_v15p2.xml.txt @@ -0,0 +1,100 @@ +/** +\page suite_FV3_GFS_v15p2_xml suite_FV3_GFS_v15p2.xml + +\code + + + + + + + fv_sat_adj + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + GFS_rrtmg_pre + rrtmg_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_nst_pre + sfc_nst + sfc_nst_post + lsm_noah + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + hedmf + GFS_PBL_generic_post + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + rayleigh_damp + GFS_suite_stateout_update + ozphys_2015 + h2ophys + GFS_DCNV_generic_pre + get_phi_fv3 + GFS_suite_interstitial_3 + samfdeepcnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + gfdl_cloud_microphys + GFS_MP_generic_post + maximum_hourly_diagnostics + + + + + GFS_stochastics + + + + +\endcode + +*/ diff --git a/physics/docs/pdftxt/suite_FV3_GFS_v15p2_no_nsst.xml.txt b/physics/docs/pdftxt/suite_FV3_GFS_v15p2_no_nsst.xml.txt new file mode 100644 index 000000000..7a60f5e1c --- /dev/null +++ b/physics/docs/pdftxt/suite_FV3_GFS_v15p2_no_nsst.xml.txt @@ -0,0 +1,99 @@ +/** +\page suite_FV3_GFS_v15p2_no_nsst_xml suite_FV3_GFS_v15p2_no_nsst.xml + +\code + + + + + + + fv_sat_adj + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + GFS_rrtmg_pre + rrtmg_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_ocean + lsm_noah + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + hedmf + GFS_PBL_generic_post + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + rayleigh_damp + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + samfdeepcnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + gfdl_cloud_microphys + GFS_MP_generic_post + maximum_hourly_diagnostics + + + + + GFS_stochastics + + + + +\endcode + +*/ + diff --git a/physics/docs/pdftxt/suite_FV3_GFS_v16beta.xml.txt b/physics/docs/pdftxt/suite_FV3_GFS_v16beta.xml.txt new file mode 100644 index 000000000..4abafe01a --- /dev/null +++ b/physics/docs/pdftxt/suite_FV3_GFS_v16beta.xml.txt @@ -0,0 +1,100 @@ +/** +\page suite_FV3_GFS_v16beta_xml suite_FV3_GFS_v16beta.xml + +\code + + + + + + + fv_sat_adj + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + GFS_rrtmg_pre + rrtmg_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_nst_pre + sfc_nst + sfc_nst_post + lsm_noah + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + satmedmfvdifq + GFS_PBL_generic_post + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + rayleigh_damp + GFS_suite_stateout_update + ozphys_2015 + h2ophys + GFS_DCNV_generic_pre + get_phi_fv3 + GFS_suite_interstitial_3 + samfdeepcnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + gfdl_cloud_microphys + GFS_MP_generic_post + maximum_hourly_diagnostics + + + + + GFS_stochastics + + + + +\endcode + +*/ diff --git a/physics/docs/pdftxt/suite_FV3_GFS_v16beta_no_nsst.xml.txt b/physics/docs/pdftxt/suite_FV3_GFS_v16beta_no_nsst.xml.txt new file mode 100644 index 000000000..e783be1f9 --- /dev/null +++ b/physics/docs/pdftxt/suite_FV3_GFS_v16beta_no_nsst.xml.txt @@ -0,0 +1,97 @@ +/** +\page suite_FV3_GFS_v16beta_no_nsst_xml suite_FV3_GFS_v16beta_no_nsst.xml + +\code + + + + + + + fv_sat_adj + + + + + GFS_time_vary_pre + GFS_rrtmg_setup + GFS_rad_time_vary + GFS_phys_time_vary + + + + + GFS_suite_interstitial_rad_reset + GFS_rrtmg_pre + rrtmg_sw_pre + rrtmg_sw + rrtmg_sw_post + rrtmg_lw_pre + rrtmg_lw + rrtmg_lw_post + GFS_rrtmg_post + + + + + GFS_suite_interstitial_phys_reset + GFS_suite_stateout_reset + get_prs_fv3 + GFS_suite_interstitial_1 + GFS_surface_generic_pre + GFS_surface_composites_pre + dcyc2t3 + GFS_surface_composites_inter + GFS_suite_interstitial_2 + + + + sfc_diff + GFS_surface_loop_control_part1 + sfc_ocean + lsm_noah + sfc_sice + GFS_surface_loop_control_part2 + + + + GFS_surface_composites_post + sfc_diag + sfc_diag_post + GFS_surface_generic_post + GFS_PBL_generic_pre + satmedmfvdifq + GFS_PBL_generic_post + GFS_GWD_generic_pre + cires_ugwp + cires_ugwp_post + GFS_GWD_generic_post + rayleigh_damp + GFS_suite_stateout_update + ozphys_2015 + h2ophys + get_phi_fv3 + GFS_suite_interstitial_3 + GFS_DCNV_generic_pre + samfdeepcnv + GFS_DCNV_generic_post + GFS_SCNV_generic_pre + samfshalcnv + GFS_SCNV_generic_post + GFS_suite_interstitial_4 + cnvc90 + GFS_MP_generic_pre + gfdl_cloud_microphys + GFS_MP_generic_post + maximum_hourly_diagnostics + + + + + GFS_stochastics + + + + +\endcode +*/ diff --git a/physics/docs/pdftxt/suite_input.nml.txt b/physics/docs/pdftxt/suite_input.nml.txt index fcb55d84f..2565c58eb 100644 --- a/physics/docs/pdftxt/suite_input.nml.txt +++ b/physics/docs/pdftxt/suite_input.nml.txt @@ -1,20 +1,24 @@ /** -\page GFSsuite_nml Namelist Options Description +\page CCPPsuite_nml_desp Namelist Options Description -At runtime, the SCM and the UFS Atmosphere access runtime configurations from file \c input.nml. This file contains -various namelists that control aspects of the I/O, dynamics, physics etc. Most physics-related options are grouped into -two namelists:\b &gfs_physics_nml and \b &gfdl_cloud_microphysics_nml, with additional specifications for stochastic physics in +The SCM and the UFS Atmosphere access runtime configurations from file \c input.nml. This file contains +various namelists records that control aspects of the I/O, dynamics, physics etc. Most physics-related options are in +reords \b &gfs_physics_nml and \b &cires_ugwp_nml. When using the GFDL microphysics scheme, variables in namelist +\b &gfdl_cloud_microphysics_nml are also used. Additional specifications for stochastic physics are in namelists \b &stochy_nam and \b &nam_sfcperts. - Namelist \b &gfdl_cloud_microphysics_nml is only relevant when the GFDL microphysics is used, and its variables are defined in module_gfdl_cloud_microphys.F90. +- Namelist \b &cires_ugwp_nml specifies options for the use of CIRES Unified Gravity Wave Physics Version 0. + - Namelist \b &gfs_physics_nml pertains to all of the suites used, but some of the variables are only relevant for specific parameterizations. Its variables are defined in file GFS_typedefs.F90 in the host model. - Namelist \b &stochy_nam specifies options for the use of SPPT, SKEB and SHUM, while namelist \b &nam_sfcperts specifies whether and how stochastic perturbations are used in the Noah Land Surface Model. +
NML Description
option DDT in Host Model Description Default Value @@ -117,13 +121,19 @@ and how stochastic perturbations are used in the Noah Land Surface Model.
  • =2 future development (not yet)
    		• 0 -
    iaer gfs_control_type aerosol flag "abc" (volcanic, LW, SW): \n +
    iaer gfs_control_type 4-digit aerosol flag (dabc for aermdl, volcanic, LW, SW): \n
      -
    • a: stratospheric volcanic aerosols -
    • b: tropospheric aerosols for LW -
    • c: tropospheric aerosols for SW \n - 0: aerosol effect is not included; \n - 1: aerosol effect is included +
    • d:tropospheric aerosol model scheme flag \n + =0 or none, opac-climatology aerosol scheme \n + =1 use gocart climatology aerosol scheme \n + =2 use gocart prognostic aerosol scheme \n + =5 opac-clim new spectral mapping +
    • a:=0 use background stratospheric aerosol \n + =1 include stratospheric volcanic aerosol +
    • b:=0 no tropospheric aerosol in LW radiation \n + =1 include tropospheric aerosol in LW +
    • c:=0 no tropospheric aerosol in SW radiation \n + =1 include tropospheric aerosol in SW
    		1
    ico2 gfs_control_type \f$CO_2\f$ data source control flag:\n @@ -159,7 +169,7 @@ and how stochastic perturbations are used in the Noah Land Surface Model. 0
    lwhtr gfs_control_type logical flag for output of longwave heating rate .true.
    swhtr gfs_control_type logical flag for output of shortwave heating rate .true. -
    cnvgwd gfs_control_type logical flag for convective gravity wave drag scheme .false. +
    cnvgwd gfs_control_type logical flag for convective gravity wave drag scheme dependent on maxval(cdmbgwd(3:4) == 0.0) .false.
    shal_cnv gfs_control_type logical flag for calling shallow convection .false.
    lmfshal gfs_control_type flag for mass-flux shallow convection scheme in the cloud fraction calculation shal_cnv .and. (imfshalcnv > 0)
    lmfdeep2 gfs_control_type flag for mass-flux deep convection scheme in the cloud fraction calculation imfdeepcnv == 2 .or. 3 .or.4 @@ -168,6 +178,12 @@ and how stochastic perturbations are used in the Noah Land Surface Model.
    dspheat gfs_control_type logical flag for using TKE dissipative heating to temperature tendency in hybrid EDMF and TKE-EDMF schemes .false.
    hybedmf gfs_control_type logical flag for calling hybrid EDMF PBL scheme .false.
    satmedmf gfs_control_type logical flag for calling TKE EDMF PBL scheme .false. +
    isatmedmf gfs_control_type flag for scale-aware TKE-based moist EDMF scheme \n +
      +
    • 0: initial version of satmedmf (Nov.2018) +
    • 1: updated version of satmedmf (as of May 2019) +
    +     		0
    do_mynnedmf gfs_control_type flag to activate MYNN-EDMF scheme .false.
    random_clds gfs_control_type logical flag for whether clouds are random .false.
    trans_trac gfs_control_type logical flag for convective transport of tracers .false. @@ -187,6 +203,7 @@ and how stochastic perturbations are used in the Noah Land Surface Model. 1
    imfdeepcnv gfs_control_type flag for mass-flux deep convective scheme:\n
      +
    • -1: Chikira-Sugiyama deep convection (with \b cscnv = .T.)
    • 1: July 2010 version of SAS convective scheme (operational version as of 2016)
    • 2: scale- & aerosol-aware mass-flux deep convective scheme (2017)
    • 3: scale- & aerosol-aware Grell-Freitas scheme (GSD) @@ -194,12 +211,18 @@ and how stochastic perturbations are used in the Noah Land Surface Model.
    		1
    lgfdlmprad gfs_control_type flag for GFDL mp scheme and radiation consistency .false. -
    cdmbgwd(2) gfs_control_type multiplication factors for mountain blocking and orographic gravity wave drag 2.0,0.25 +
    cdmbgwd(4) gfs_control_type multiplication factors for mountain blocking(1), orographic gravity wave drag(2) +
      +
    • [1]: GWDPS mountain blocking +
    • [2]: GWDPS orographic gravity wave drag +
    • [3]: the modulation total momentum flux of NGWs by intensities of the total precipitation +
    • [4]: TKE for future tests and applications +
    +     		2.0,0.25,1.0,1.0
    prslrd0 gfs_control_type pressure level above which to apply Rayleigh damping 0.0d0
    lsm gfs_control_type flag for land surface model to use \n
      -
    • 0: OSU LSM -
    • 1: NOAH LSM +
    • 1: Noah LSM
    • 2: RUC LSM
    		1 @@ -221,14 +244,14 @@ and how stochastic perturbations are used in the Noah Land Surface Model.
    debug gfs_control_type flag for debug printout .false.
    nstf_name(5) gfs_control_type NSST related paramters:\n
      -
    • nstf_name(1): 0=NSSTM off, 1= NSSTM on but uncoupled, 2= NSSTM on and coupled -
    • nstf_name(2): 1=NSSTM spin up on, 0=NSSTM spin up off -
    • nstf_name(3): 1=NSST analysis on, 0=NSSTM analysis off +
    • nstf_name(1): 0=NSST off, 1= NSST on but uncoupled, 2= NSST on and coupled +
    • nstf_name(2): 1=NSST spin up on, 0=NSST spin up off +
    • nstf_name(3): 1=NSST analysis on, 0=NSST analysis off
    • nstf_name(4): zsea1 in mm
    • nstf_name(5): zesa2 in mm
    		/0,0,1,0,5/ -
    nst_anl gfs_control_type flag for NSSTM analysis in gcycle/sfcsub .false. +
    nst_anl gfs_control_type flag for NSST analysis in gcycle/sfcsub .false.
    effr_in gfs_control_type logical flag for using input cloud effective radii calculation .false.
    aero_in gfs_control_type logical flag for using aerosols in Morrison-Gettelman microphysics .false.
    iau_delthrs gfs_control_type incremental analysis update (IAU) time interval in hours 6 @@ -342,7 +365,14 @@ and how stochastic perturbations are used in the Noah Land Surface Model. 1
    lsoil_lsm gfs_control_type number of soil layers internal to land surface model -1 -
    \b Stochastic \b Physics \b Specific \b Parameters +
    ldiag_ugwp GFS_control_type flag for CIRES UGWP diagnostics .false. +
    do_ugwp GFS_control_type flag for CIRES UGWP revised OGW +
      +
    • .T.: revised gwdps_v0 +
    • .F.: GFS operational orographic gwdps +
    +     		.false. +
    do_tofd GFS_control_type flag for turbulent orographic form drag .false.
    do_sppt gfs_control_type flag for stochastic SPPT option .false.
    do_shum gfs_control_type flag for stochastic SHUM option .false.
    do_skeb gfs_control_type flag for stochastic SKEB option .false. @@ -389,42 +419,61 @@ and how stochastic perturbations are used in the Noah Land Surface Model.
    skebint compns_stochy_mod 0
    \b &gfdl_cloud_microphysics_nml
    sedi_transport gfdl_cloud_microphys_mod logical flag for turning on horizontal momentum transport during sedimentation .true. +
    do_sedi_w gfdl_cloud_microphys_mod \a .true. to turn on vertical motion transport during sedimentation. (not supported in GFS physics) .false.
    do_sedi_heat gfdl_cloud_microphys_mod logical flag for turning on horizontal heat transport during sedimentation .true.
    rad_snow gfdl_cloud_microphys_mod logical flag for considering snow in cloud fraction calculation .true.
    rad_graupel gfdl_cloud_microphys_mod logical flag for considering graupel in cloud fraction calculation .true.
    rad_rain gfdl_cloud_microphys_mod logical flag for considering rain in cloud fraction calculation .true. +
    cld_min gfdl_cloud_microphys_mod minimum cloud fraction. If total cloud condensate exceeds 1.0e-6 kg/kg, cloud fraction cannot be less than \p cld_min 0.05
    const_vi gfdl_cloud_microphys_mod logical flag for using constant cloud ice fall speed .false.
    const_vs gfdl_cloud_microphys_mod logical flag for using constant snow fall speed .false.
    const_vg gfdl_cloud_microphys_mod logical flag for using constant graupel fall speed .false.
    const_vr gfdl_cloud_microphys_mod logical flag for using constant rain fall speed .false. +
    vi_fac gfdl_cloud_microphys_mod tunable factor for cloud ice fall or the constant cloud ice fall speed when \p const_vi is .true. 1. +
    vr_fac gfdl_cloud_microphys_mod tunable factor for rain fall or the constant rain fall speed when \p const_vr is .true. 1. +
    vs_fac gfdl_cloud_microphys_mod tunable factor for snow fall or the constant snow fall speed when \p const_vs is .true. 1. +
    vg_fac gfdl_cloud_microphys_mod tunable factor for graupel fall or the constant graupel fall speed when \p const_vg is .true. 1.
    vi_max gfdl_cloud_microphys_mod maximum fall speed for cloud ice 0.5
    vs_max gfdl_cloud_microphys_mod maximum fall speed for snow 5.0
    vg_max gfdl_cloud_microphys_mod maximum fall speed for graupel 8.0
    vr_max gfdl_cloud_microphys_mod maximum fall speed for rain 12.0
    qi_lim gfdl_cloud_microphys_mod cloud ice limiter to prevent large ice built up in cloud ice freezing and deposition 1.
    prog_ccn gfdl_cloud_microphys_mod logical flag for activating prognostic CCN (not supported in GFS Physics) .false. -
    do_qa gfdl_cloud_microphys_mod logical flag for activating inline cloud fraction diagnosis in fast saturation adjustment .true. -
    fast_sat_adj gfdl_cloud_microphys_mod logical flag for adjusting cloud water evaporation/freezing, cloud ice deposition when fast saturation adjustment is activated .true. +
    do_qa gfdl_cloud_microphys_mod \a .true. to activate inline cloud fraction diagnosis in fast saturation adjustment. \a .false. to activate inline cloud fraction diagnosis in major cloud microphysics .true. +
    fast_sat_adj gfdl_cloud_microphys_mod logical flag for adjusting cloud water evaporation (cloud water -> water vapor), cloud water freezing (cloud water -> cloud ice), cloud ice deposition (water vapor -> cloud ice) when fast saturation adjustment is activated (\b do_sat_adj = .true. in \b fv_core_nml block) .true.
    tau_l2v gfdl_cloud_microphys_mod time scale for evaporation of cloud water to water vapor. Increasing(decreasing) \p tau_l2v can decrease(boost) deposition of cloud water to water vapor 300.
    tau_v2l gfdl_cloud_microphys_mod time scale for condensation of water vapor to cloud water. Increasing(decreasing) \p tau_v2l can decrease(boost) condensation of water vapor to cloud water 150.
    tau_g2v gfdl_cloud_microphys_mod time scale for sublimation of graupel to water vapor. Increasing(decreasing) \p tau_g2v can decrease(boost) sublimation of graupel to water vapor 900. +
    tau_g2r gfdl_cloud_microphys_mod time scale for graupel melting. Increasing(decreasing) \p tau_g2r can decrease(boost) melting of graupel to rain (graupel-> rain) 600. +
    tau_v2g gfdl_cloud_microphys_mod time scale for deposition of water vapor to graupel. Increasing(decreasing) \p tau_v2g can decrease(boost) deposition of water vapor to graupel (water vapor -> graupel) 21600. +
    tau_l2r gfdl_cloud_microphys_mod time scale for autoconversion of cloud water to rain. Increasing(decreasing) \p tau_l2r can decrese(boost) autoconversion of cloud water to rain (cloud water -> rain) 900. +
    tau_r2g gfdl_cloud_microphys_mod time scale for freezing of rain to graupel. Increasing(decreasing) \p tau_r2g can decrease(boost) freezing of rain to graupel (rain->graupel) 900. +
    tau_i2s gfdl_cloud_microphys_mod time scale for autoconversion of cloud ice to snow. Increasing(decreasing) \p tau_i2s can decrease(boost) autoconversion of cloud ice to snow (cloud ice -> snow) 1000. +
    tau_imlt gfdl_cloud_microphys_mod time scale for cloud ice melting. Increasing(decreasing) \p tau_imlt can decrease(boost) melting of cloud ice to cloud water or rain (cloud ice -> cloud water or rain) 600. +
    tau_smlt gfdl_cloud_microphys_mod time scale for snow melting. Increasing(decreasing) \p tau_smlt can decrease(boost) melting of snow to cloud water or rain (snow-> cloud water or rain) 900.
    rthresh gfdl_cloud_microphys_mod critical cloud water radius for autoconversion (cloud water -> rain). Increasing(decreasing) of \p rthresh makes the autoconversion harder(easier) 10.0e-6
    dw_land gfdl_cloud_microphys_mod base value for subgrid deviation/variability over land 0.20
    dw_ocean gfdl_cloud_microphys_mod base value for subgrid deviation/variability over ocean 0.10
    ql_gen gfdl_cloud_microphys_mod maximum value for cloud water generated from condensation of water vapor (water vapor-> cloud water) 1.0e-3 -
    ql_mlt gfdl_cloud_microphys_mod maximum value of cloud water allowed from melted cloud ice (cloud ice -> cloud water or rain) 2.0e-3 -
    qi0_crt gfdl_cloud_microphys_mod threshold of cloud ice to snow autoconversion (cloud ice -> snow) 1.0e-4 -
    qs0_crt gfdl_cloud_microphys_mod threshold of snow to graupel autoconversion (snow -> graupel) 1.0e-3 -
    tau_i2s gfdl_cloud_microphys_mod time scale for autoconversion of cloud ice to snow 1000. -
    c_psaci gfdl_cloud_microphys_mod accretion efficiency of cloud ice to snow 0.02 -
    c_pgacs gfdl_cloud_microphys_mod accretion efficiency of snow to graupel 2.0e-3 +
    qi_gen gfdl_cloud_microphys_mod maximum value of cloud ice generated from deposition of water vapor (water vapor->cloud ice) or freezing(cloud water -> cloud ice). Increasing(decreasing) \p qi_gen can increas(decrease) cloud ice 1.82e-6 +
    ql_mlt gfdl_cloud_microphys_mod maximum value of cloud water allowed from melted cloud ice (cloud ice -> cloud water or rain). Exceedance of which will become rain. Increasing(decreasing) \p ql_mlt can increase(decrease) cloud water and decrease(increase) rain 2.0e-3 +
    qs_mlt gfdl_cloud_microphys_mod maximum value of cloud water allowed from melted snow (snow -> cloud water or rain). Exceedance of which will become rain. Increasing(decreasing) \p qs_mlt can increas(decrease) cloud water and decrease (increase) rain 1.0e-6 +
    ql0_max gfdl_cloud_microphys_mod threshold of cloud water to rain autoconversion (cloud water -> rain). Increasing(decreasing) \p ql0_max can increase(decrease) rain and decrease(increase) cloud water 2.0e-3 +
    qi0_max gfdl_cloud_microphys_mod maximum value of cloud ice generated from other sources like convection. Exceedance of which will become snow. Increasing(decreasing) \p qi0_max can increase(decrease) cloud ice and decrease(increase) snow 1.0e-4 +
    qi0_crt gfdl_cloud_microphys_mod threshold of cloud ice to snow autoconversion (cloud ice -> snow). Increasing(decreasing) \p qi0_crt can increase(decrease) cloud ice and decrease(increase) snow 1.0e-4 +
    qs0_crt gfdl_cloud_microphys_mod threshold of snow to graupel autoconversion (snow -> graupel). Increasing(decreasing) \p qs0_crt can increase(decrease) snow and decrease(increase) graupel 1.0e-3 +
    qc_crt gfdl_cloud_microphys_mod minimum value of cloud condensate to allow partial cloudiness. Partial cloud can only exist when total cloud condensate exceeds \p qc_crt 5.0e-8 +
    c_psaci gfdl_cloud_microphys_mod accretion efficiency of cloud ice to snow (cloud ice -> snow). Increasing(decreasing) of \p c_psaci can boost(decrease) the accretion of cloud ice to snow 0.02 +
    c_pgacs gfdl_cloud_microphys_mod accretion efficiency of snow to graupel (snow -> graupel). Increasing(decreasing) of \p c_pgacs can boost(decrease) the accretion of snow to graupel 2.0e-3
    rh_inc gfdl_cloud_microphys_mod relative humidity increment for complete evaporation of cloud water and cloud ice 0.25
    rh_inr gfdl_cloud_microphys_mod relative humidity increment for sublimation of snow 0.25
    rh_ins gfdl_cloud_microphys_mod relative humidity increment for minimum evaporation of rain 0.25 -
    ccn_l gfdl_cloud_microphys_mod base CCN over land \f$cm^{-3}\f$ 270. -
    ccn_o gfdl_cloud_microphys_mod base CCN over ocean \f$cm^{-3}\f$ 90. -
    c_paut gfdl_cloud_microphys_mod autoconversion efficiency of cloud water to rain 0.55 -
    c_cracw gfdl_cloud_microphys_mod accretion efficiency of cloud water to rain 0.9 +
    rthresh gfdl_cloud_microphys_mod critical cloud water radius for autoconversion(cloud water->rain). Increasing(decreasing) of \p rthresh makes the autoconversion harder(easier) 1.0e-5 +
    ccn_l gfdl_cloud_microphys_mod base CCN over land. Increasing(decreasing) \p ccn_l can on the one hand boost(decrease) the autoconversion of cloud water to rain, on the other hand make the autoconversion harder(easier). The unit is \f$cm^{-3}\f$ 270. +
    ccn_o gfdl_cloud_microphys_mod base CCN over ocean. Increasing(decreasing) \p ccn_o can on the one hand boost(decrease) the autoconversion of cloud water to rain, on the other hand make the autoconversion harder(easier). The unit is \f$cm^{-3}\f$ 90. +
    c_paut gfdl_cloud_microphys_mod autoconversion efficiency of cloud water to rain (cloud water -> rain). Increasing(decreasing) of \p c_paut can boost(decrease) the autoconversion of cloud water to rain 0.55 +
    c_cracw gfdl_cloud_microphys_mod accretion efficiency of cloud water to rain (cloud water -> rain). Increasing(decreasing) of \p c_cracw can boost(decrease) the accretion of cloud water to rain 0.9 +
    sat_adj0 gfdl_cloud_microphys_mod adjust factor for condensation of water vapor to cloud water (water vapor->cloud water) and deposition of water vapor to cloud ice 0.9
    use_ppm gfdl_cloud_microphys_mod \e true to use PPM fall scheme; \e false to use time-implicit monotonic fall scheme .false.
    use_ccn gfdl_cloud_microphys_mod \e true to compute prescribed CCN. It should be .true. when \p prog_ccn = .false. .false.
    mono_prof gfdl_cloud_microphys_mod \e true to turn on terminal fall with monotonic PPM scheme. This is used together with \p use_ppm=.true. .true. @@ -433,6 +482,68 @@ and how stochastic perturbations are used in the Noah Land Surface Model.
    de_ice gfdl_cloud_microphys_mod \e true to convert excessive cloud ice to snow to prevent ice over-built from other sources like convection scheme (not supported in GFS physics) .false.
    fix_negative gfdl_cloud_microphys_mod \e true to fix negative water species using nearby points .false.
    icloud_f gfdl_cloud_microphys_mod flag (0,1,or 2) for cloud fraction diagnostic scheme 0 -
    mp_time gfdl_cloud_microphys_mod time step of GFDL cloud microphysics 150. +
    irain_f gfdl_cloud_microphys_mod flag (0 or 1) for cloud water autoconversion to rain scheme. 0: with subgrid variability; 1: no subgrid variability 0 +
    mp_time gfdl_cloud_microphys_mod time step of GFDL cloud microphysics (MP). If \p mp_time isn't divisible by physics time step or is larger than physics time step, the actual MP time step becomes \p dt/NINT[dt/MIN(dt,mp_time)] 150. +
    alin gfdl_cloud_microphys_mod parameter \a a in Lin et al.(1983). Constant in empirical formula for \f$U_R\f$. Increasing(decreasing) \p alin can boost(decrease) accretion of cloud water by rain and rain evaporation 842. +
    clin gfdl_cloud_microphys_mod parameter \a c in Lin et al.(1983). Constant in empirical formula for \f$U_S\f$. Increasing(decreasing) \p clin can boost(decrease) accretion of cloud water by snow, accretion of cloud ice by snow, snow sublimation and deposition, and snow melting 4.8 +
    t_min gfdl_cloud_microphys_mod temperature threshold for instant deposition. Deposit all water vapor to cloud ice when temperature is lower than \p t_min 178. +
    t_sub gfdl_cloud_microphys_mod temperature threshold for sublimation. Cloud ice, snow or graupel stops(starts) sublimation when temperature is lower(higher) then \p t_sub 184. +
    mp_print gfdl_cloud_microphys_mod \a .true. to turn on GFDL cloud microphysics debugging print out. (not supported in GFS physics) .false. +
    \b &cires_ugwp_nml +
    knob_ugwp_version cires_ugwp_module parameter selects a version of the UGWP implementation in FV3GFS-127L \n +
      +
    • 0: default version delivered to EMC in Jan 2019 for implementation +
    • 1: version of UGWP under development that plans to consider the physics-based sources of NGWs (\b knob_ugwp_wvspec [2:4]), options for stochastic and deterministic excitation of waves (\b knob_ugwp_stoch), and switches between different UGWP schemes (\b knob_ugwp_solver) +
    +     		0 +
    knob_ugwp_doaxyz cires_ugwp_module parameter controls application of the momentum deposition for NGW-schemes \n +
      +
    • 0: the momentum tendencies due to NGWs are calculated, but tendencies do not change the horizontal winds +
    • 1: default value; it changes the horizontal momentum tendencies and horizontal winds +
    +     		1 +
    knob_ugwp_doheat cires_ugwp_module parameter controls application of the heat deposition for NGW-schemes \n +
      +
    • 0: the temperature tendencies due to NGWs are calculated but tendencies do not change the temperature state +
    • 1: default value; it changes the temperature tendencies and kinetic temperature +
    +     		1 +
    knob_ugwp_dokdis cires_ugwp_module parameter controls application of the eddy diffusion due to instability of NGWs \n +
      +
    • 0: the eddy diffusion tendencies due to NGWs are calculated but tendencies do not change the model state vector +
    • 1: it computes eddy diffusion coefficient due to instability of NGWs; in UGWP v0, eddy viscosity, heat conductivity and tracer diffusion are not activated +
    +     		0 +
    knob_ugwp_solver cires_ugwp_module parameter controls the selection of UGWP-solvers(wave propagation, dissipation and wave breaking) for NGWs \n +
      +
    • 1: represents the discrete multi-wave solver with background dissipation and linear wave saturation +
    • 2: represents the spectral deterministic solver with background dissipation and spectral saturation +
    • 3: represents the discrete multi-wave solver with the background dissipation, extension of Alexander sand Dunkerton (1999) +
    • 4: represents the spectral solver with background dissipation, extension of Doppler Spread Theory of Hines (1997) +
    +     		1 +
    knob_ugwp_ndx4lh cires_ugwp_module parameter controls the selection of the horizontal wavenumber(wavelength) for NGW schemes \n +
      +
    • 1: selects the \f$4xdx\f$ sub-grid wavelength, where dx is the horizontal resolution of the model configuration (C96-400km; C768-52km) +
    +     		2 +
    knob_ugwp_wvspec cires_ugwp_module four-dimensional array defines number of waves in each arimuthal propagation (as defined by knob_ugwp_azdir) for GWs excited due to the following four sources: \n + (1) sub-grid orography (\b knob_ugwp_wvspec[1]=1), \n + (2) convective (\b knob_ugwp_wvspec[2]=25), \n + (3) frontal (\b knob_ugwp_wvspec[3]=25) activity, \n + (4) \b knob_ugwp_wvspec[4] represents number of wave excited by dynamical imbalances that may mimic both convective and front-jet mechanisms of GW triggering. \n + In UGWP v0, first two elements of the array, \b knob_ugwp_wvspec(1:2), control number of waves for stationary (OGW) and nonstationary waves (NGWs). + 1,32,32,32 +
    knob_ugwp_azdir cires_ugwp_module four-dimensional array that defines number of azimuths for propagation of GWs triggered by four types of physics-based sources (orography, convection, front-jets, and dynamical imbalance). In UGWP v0, first two elements of the array, \b knob_ugwp_azdir(1:2), control number of azimuths for OGW and NGWs respectively. + 2,4,4,4 +
    knob_ugwp_stoch cires_ugwp_module four-dimensional array that control stochastic selection of GWs triggered by four types of physics-based sources. \n + Default values:0,0,0,0 - reflect determinstic selection of GW parameters without stochastic selection + 0,0,0,0 +
    knob_ugwp_effac cires_ugwp_module four-dimensional array that control efficiency of GWs triggerd by four types of physics-based sources. \n + Default values: 1.,1.,1.,1. - reflect that calculated GW-tendencies will be applied for the model state. + 1.,1.,1.,1. +
    launch_level cires_ugwp_module parameter has been introduced by EMC during implementation. It defines the interface model level from the surface at which NGWs are launched. \n + Default value for FV3GFS-64L, launch_level=25 and for FV3GFS-128L, launch_level=52. + 55
    */ diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index 080bee156..0189785e3 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -90,7 +90,7 @@ end subroutine drag_suite_init !! the GWD scheme has the same physical basis as in Alpert (1987) with the addition !! of enhancement factors for the amplitude, G, and mountain shape details !! in G(Fr) to account for effects from the mountain blocking. A factor, -!! E m’, is an enhancement factor on the stress in the Alpert '87 scheme. +!! E m', is an enhancement factor on the stress in the Alpert '87 scheme. !! The E ranges from no enhancement to an upper limit of 3, E=E(OA)[1-3], !! and is a function of OA, the Orographic Asymmetry defined in KA (1995) as !! @@ -105,9 +105,9 @@ end subroutine drag_suite_init !! !! !! where Nx is the number of grid intervals for the large scale domain being -!! considered. So the term, E(OA)m’/ \f$ \Delta X \f$ in Kim's scheme represents -!! a multiplier on G shown in Alpert's eq (1), where m’ is the number of mountains -!! in a sub-grid scale box. Kim increased the complexity of m’ making it a +!! considered. So the term, E(OA)m'/ \f$ \Delta X \f$ in Kim's scheme represents +!! a multiplier on G shown in Alpert's eq (1), where m' is the number of mountains +!! in a sub-grid scale box. Kim increased the complexity of m' making it a !! function of the fractional area of the sub-grid mountain and the asymmetry !! and convexity statistics which are found from running a gravity wave !! model for a large number of cases: diff --git a/physics/gcm_shoc.F90 b/physics/gcm_shoc.F90 index 1f466c50d..b32843bc1 100644 --- a/physics/gcm_shoc.F90 +++ b/physics/gcm_shoc.F90 @@ -24,29 +24,24 @@ end subroutine shoc_finalize !! \htmlinclude shoc_run.html !! #endif -subroutine shoc_run (ix, nx, nzm, do_shoc, shocaftcnv, mg3_as_mg2, imp_physics, imp_physics_gfdl, imp_physics_zhao_carr, & - imp_physics_zhao_carr_pdf, imp_physics_mg, fprcp, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, & - con_fvirt, gq0_cloud_ice, gq0_rain, gq0_snow, gq0_graupel, dtp, me, prsl, phii, phil, u, v, omega, rhc, supice, pcrit, & - cefac, cesfac, tkef1, dis_opt, hflx, evap, prnum, & - skip_macro, clw_ice, clw_liquid, gq0_cloud_liquid, ncpl, ncpi, gt0, gq0_water_vapor, cld_sgs, tke, tkh, wthv_sec, & - errmsg, errflg) +subroutine shoc_run (ix, nx, nzm, tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, & + con_pi, con_fvirt, dtp, prsl, delp, phii, phil, u, v, omega, rhc, & + supice, pcrit, cefac, cesfac, tkef1, dis_opt, hflx, evap, prnum, & + gt0, gq0, ntrac, ntqv, ntcw, ntiw, ntrw, ntsw, ntgl, ntlnc, ntinc, & + cld_sgs, tke, tkh, wthv_sec, errmsg, errflg) implicit none - integer, intent(in) :: ix, nx, nzm, imp_physics, imp_physics_gfdl, imp_physics_zhao_carr, imp_physics_zhao_carr_pdf, & - imp_physics_mg, fprcp, me - logical, intent(in) :: do_shoc, shocaftcnv, mg3_as_mg2 + integer, intent(in) :: ix, nx, nzm, ntrac, ntqv, ntcw, ntiw, ntrw, ntsw, ntgl, ntlnc, ntinc real(kind=kind_phys), intent(in) :: tcr, tcrf, con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, con_fvirt, & - dtp, supice, pcrit, cefac, cesfac, tkef1, dis_opt + dtp, supice, pcrit, cefac, cesfac, tkef1, dis_opt ! - real(kind=kind_phys), intent(in), dimension(nx) :: hflx, evap - real(kind=kind_phys), intent(in), dimension(nx,nzm) :: gq0_cloud_ice, gq0_rain, gq0_snow, gq0_graupel, prsl, phil, & - u, v, omega, rhc, prnum + real(kind=kind_phys), intent(in), dimension(nx) :: hflx, evap + real(kind=kind_phys), intent(in), dimension(nx,nzm) :: prsl, delp, phil, u, v, omega, rhc, prnum real(kind=kind_phys), intent(in), dimension(nx,nzm+1) :: phii ! - logical, intent(inout) :: skip_macro - real(kind=kind_phys), intent(inout), dimension(nx,nzm) :: clw_ice, clw_liquid, gq0_cloud_liquid, ncpl, ncpi, gt0, & - gq0_water_vapor, cld_sgs, tke, tkh, wthv_sec + real(kind=kind_phys), intent(inout), dimension(nx,nzm) :: gt0, cld_sgs, tke, tkh, wthv_sec + real(kind=kind_phys), intent(inout), dimension(nx,nzm,ntrac) :: gq0 character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg @@ -56,129 +51,98 @@ subroutine shoc_run (ix, nx, nzm, do_shoc, shocaftcnv, mg3_as_mg2, imp_physics, integer :: i, k real(kind=kind_phys) :: tem - real(kind=kind_phys), dimension(nx,nzm) :: qsnw ! qsnw can be local to this routine - real(kind=kind_phys), dimension(nx,nzm) :: qgl ! qgl can be local to this routine + real(kind=kind_phys), dimension(nx,nzm) :: qi ! local array of suspended cloud ice + real(kind=kind_phys), dimension(nx,nzm) :: qc ! local array of suspended cloud water + real(kind=kind_phys), dimension(nx,nzm) :: qsnw ! local array of suspended snowq + real(kind=kind_phys), dimension(nx,nzm) :: qrn ! local array of suepended rain + real(kind=kind_phys), dimension(nx,nzm) :: qgl ! local array of suspended graupel + real(kind=kind_phys), dimension(nx,nzm) :: ncpl ! local array of cloud water number concentration + real(kind=kind_phys), dimension(nx,nzm) :: ncpi ! local array of cloud ice number concentration ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - if (shocaftcnv) then - if (imp_physics == imp_physics_mg) then - if (abs(fprcp) == 1 .or. mg3_as_mg2) then - do k=1,nzm - do i=1,nx - !GF - gq0(ntrw) is passed in directly, no need to copy - !qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) - qgl(i,k) = 0.0 - enddo - enddo - elseif (fprcp > 1) then - do k=1,nzm - do i=1,nx - !qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) + gq0_graupel(i,k) - qgl(i,k) = 0.0 - enddo - enddo - endif - endif - else - if (imp_physics == imp_physics_mg) then - do k=1,nzm + if (ntiw < 0) then ! this is valid only for Zhao-Carr scheme + do k=1,nzm do i=1,nx - !clw_ice(i,k) = gq0_cloud_ice(i,k) ! ice - !clw_liquid(i,k) = gq0_cloud_liquid(i,k) ! water - !GF - since gq0(ntlnc/ntinc) are passed in directly, no need to copy - !ncpl(i,k) = Stateout%gq0(i,k,ntlnc) - !ncpi(i,k) = Stateout%gq0(i,k,ntinc) + qc(i,k) = gq0(i,k,ntcw) + if (abs(qc(i,k)) < epsq) then + qc(i,k) = 0.0 + endif + tem = qc(i,k) * max(0.0, MIN(1.0, (tcr-gt0(i,k))*tcrf)) + qi(i,k) = tem ! ice + qc(i,k) = qc(i,k) - tem ! water + qrn(i,k) = 0.0 + qsnw(i,k) = 0.0 + ncpl(i,k) = 0 + ncpi(i,k) = 0 enddo enddo - if (abs(fprcp) == 1 .or. mg3_as_mg2) then - do k=1,nzm - do i=1,nx - !GF - gq0(ntrw) is passed in directly, no need to copy - !qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) - qgl(i,k) = 0.0 + else + if (ntgl > 0) then ! graupel exists - combine graupel with snow + do k=1,nzm + do i=1,nx + qc(i,k) = gq0(i,k,ntcw) + qi(i,k) = gq0(i,k,ntiw) + qrn(i,k) = gq0(i,k,ntrw) + qsnw(i,k) = gq0(i,k,ntsw) + gq0(i,k,ntgl) enddo enddo - elseif (fprcp > 1) then - do k=1,nzm - do i=1,nx - !qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) + gq0_graupel(i,k) - qgl(i,k) = 0.0 - !clw_ice(i,k) = clw_ice(i,k) + gq0_graupel(i,k) + else ! no graupel + do k=1,nzm + do i=1,nx + qc(i,k) = gq0(i,k,ntcw) + qi(i,k) = gq0(i,k,ntiw) + qrn(i,k) = gq0(i,k,ntrw) + qsnw(i,k) = gq0(i,k,ntsw) enddo enddo - endif - elseif (imp_physics == imp_physics_gfdl) then ! GFDL MP - needs modify for condensation - do k=1,nzm - do i=1,nx - clw_ice(i,k) = gq0_cloud_ice(i,k) ! ice - clw_liquid(i,k) = gq0_cloud_liquid(i,k) ! water - !qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) - qgl(i,k) = 0.0 - enddo - enddo - elseif (imp_physics == imp_physics_zhao_carr .or. imp_physics == imp_physics_zhao_carr_pdf) then - do k=1,nzm - do i=1,nx - if (abs(gq0_cloud_liquid(i,k)) < epsq) then - gq0_cloud_liquid(i,k) = 0.0 - endif - tem = gq0_cloud_liquid(i,k) * max(0.0, MIN(1.0, (tcr-gt0(i,k))*tcrf)) - clw_ice(i,k) = tem ! ice - clw_liquid(i,k) = gq0_cloud_liquid(i,k) - tem ! water - qsnw(i,k) = 0.0 - qgl(i,k) = 0.0 - enddo - enddo endif - endif !shocaftcnv + if (ntlnc > 0) then + do k=1,nzm + do i=1,nx + ncpl(i,k) = gq0(i,k,ntlnc) + ncpi(i,k) = gq0(i,k,ntinc) + enddo + enddo + endif + endif ! phy_f3d(1,1,ntot3d-2) - shoc determined sgs clouds ! phy_f3d(1,1,ntot3d-1) - shoc determined diffusion coefficients ! phy_f3d(1,1,ntot3d ) - shoc determined w'theta' - !GFDL lat has no meaning inside of shoc - changed to "1" - - - ! DH* can we pass in gq0_graupel? is that zero? the original code - ! passes in qgl which is zero (always? sometimes?), in shoc_work - ! this qgl gets added to qpi, qpi = qpi_i + qgl with qpi_i = qsnw; - ! - with the above qsnw(i,k) = gq0_snow(i,k) + gq0_graupel(i,k), - ! would that be double counting? *DH - call shoc_work (ix, nx, 1, nzm, nzm+1, dtp, me, 1, prsl, & - phii, phil, u, v, omega, gt0, & - gq0_water_vapor, clw_ice, clw_liquid, qsnw, gq0_rain, & - qgl, rhc, supice, pcrit, cefac, cesfac, tkef1, dis_opt, & - cld_sgs, tke, hflx, evap, prnum, tkh, wthv_sec, .false., 1, ncpl, ncpi, & - con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, con_fvirt) - - !if (.not.shocaftcnv) then - ! if (imp_physics == imp_physics_mg .and. fprcp > 1) then - ! do k=1,nzm - ! do i=1,nx - ! clw_ice(i,k) = clw_ice(i,k) - gq0_graupel(i,k) - ! enddo - ! enddo - ! endif - !endif ! .not. shocaftcnv - - !GF since gq0(ntlnc/ntinc) are passed in directly, no need to copy back - ! if (imp_physics == Model%imp_physics_mg) then - ! do k=1,nzm - ! do i=1,nx - ! Stateout%gq0(i,k,ntlnc) = ncpl(i,k) - ! Stateout%gq0(i,k,ntinc) = ncpi(i,k) - ! enddo - ! enddo - ! endif + call shoc_work (ix, nx, nzm, nzm+1, dtp, prsl, delp, & + phii, phil, u, v, omega, gt0, gq0(:,:,1), qi, qc, qsnw, qrn, & + rhc, supice, pcrit, cefac, cesfac, tkef1, dis_opt, & + cld_sgs, tke, hflx, evap, prnum, tkh, wthv_sec, & + ntlnc, ncpl, ncpi, & + con_cp, con_g, con_hvap, con_hfus, con_rv, con_rd, con_pi, con_fvirt) + + if (ntiw < 0) then ! this is valid only for Zhao-Carr scheme + do k=1,nzm + do i=1,nx + gq0(i,k,ntcw) = qc(i,k) + qi(i,k) + enddo + enddo + else + do k=1,nzm + do i=1,nx + gq0(i,k,ntcw) = qc(i,k) + gq0(i,k,ntiw) = qi(i,k) + enddo + enddo + if (ntlnc > 0) then + do k=1,nzm + do i=1,nx + gq0(i,k,ntlnc) = ncpl(i,k) + gq0(i,k,ntinc) = ncpi(i,k) + enddo + enddo + endif + endif end subroutine shoc_run @@ -197,27 +161,25 @@ end subroutine shoc_run ! replacing fac_fus by fac_sub ! S.Moorthi - 00-00-17 - added an alternate option for near boundary cek following ! Scipion et. al., from U. Oklahoma. - subroutine shoc_work (ix, nx, ny, nzm, nz, dtn, me, lat, & - prsl, phii, phil, u, v, omega, tabs, & - qwv, qi, qc, qpi_i, qpl, qgl, rhc, supice, & - pcrit, cefac, cesfac, tkef1, dis_opt, & - cld_sgs, tke, hflx, evap, prnum, tkh, & - wthv_sec, lprnt, ipr, ncpl, ncpi, & - cp, ggr, lcond, lfus, rv, rgas, pi, epsv) + subroutine shoc_work (ix, nx, nzm, nz, dtn, & + prsl, delp, phii, phil, u, v, omega, tabs, & + qwv, qi, qc, qpi, qpl, rhc, supice, & + pcrit, cefac, cesfac, tkef1, dis_opt, & + cld_sgs, tke, hflx, evap, prnum, tkh, & + wthv_sec, ntlnc, ncpl, ncpi, & + cp, ggr, lcond, lfus, rv, rgas, pi, epsv) use funcphys , only : fpvsl, fpvsi, fpvs ! saturation vapor pressure for water & ice implicit none - real, intent(in) :: cp, ggr, lcond, lfus, rv, rgas, pi, epsv + real, intent(in) :: cp, ggr, lcond, lfus, rv, rgas, pi, epsv integer, intent(in) :: ix ! max number of points in the physics window in the x integer, intent(in) :: nx ! Number of points in the physics window in the x - integer, intent(in) :: ny ! and y directions - integer, intent(in) :: me ! MPI rank - integer, intent(in) :: lat ! latitude integer, intent(in) :: nzm ! Number of vertical layers integer, intent(in) :: nz ! Number of layer interfaces (= nzm + 1) + integer, intent(in) :: ntlnc ! index of liquid water number concentration real, intent(in) :: dtn ! Physics time step, s real, intent(in) :: pcrit ! pressure in Pa below which additional tke dissipation is applied @@ -231,58 +193,61 @@ subroutine shoc_work (ix, nx, ny, nzm, nz, dtn, me, lat, & ! The interface is talored to GFS in a sense that input variables are 2D - real, intent(in) :: prsl (ix,ny,nzm) ! mean layer presure - real, intent(in) :: phii (ix,ny,nz ) ! interface geopotential height - real, intent(in) :: phil (ix,ny,nzm) ! layer geopotential height - real, intent(in) :: u (ix,ny,nzm) ! u-wind, m/s - real, intent(in) :: v (ix,ny,nzm) ! v-wind, m/s - real, intent(in) :: omega (ix,ny,nzm) ! omega, Pa/s - real, intent(inout) :: tabs (ix,ny,nzm) ! temperature, K - real, intent(inout) :: qwv (ix,ny,nzm) ! water vapor mixing ratio, kg/kg - real, intent(inout) :: qc (ix,ny,nzm) ! cloud water mixing ratio, kg/kg - real, intent(inout) :: qi (ix,ny,nzm) ! cloud ice mixing ratio, kg/kg + real, intent(in) :: prsl (ix,nzm) ! mean layer presure + real, intent(in) :: delp (ix,nzm) ! layer presure depth + real, intent(in) :: phii (ix,nz ) ! interface geopotential height + real, intent(in) :: phil (ix,nzm) ! layer geopotential height + real, intent(in) :: u (ix,nzm) ! u-wind, m/s + real, intent(in) :: v (ix,nzm) ! v-wind, m/s + real, intent(in) :: omega (ix,nzm) ! omega, Pa/s + real, intent(inout) :: tabs (ix,nzm) ! temperature, K + real, intent(inout) :: qwv (ix,nzm) ! water vapor mixing ratio, kg/kg + real, intent(inout) :: qc (ix,nzm) ! cloud water mixing ratio, kg/kg + real, intent(inout) :: qi (ix,nzm) ! cloud ice mixing ratio, kg/kg ! Anning Cheng 03/11/2016 SHOC feedback to number concentration - real, intent(inout) :: ncpl (nx,ny,nzm) ! cloud water number concentration,/m^3 - real, intent(inout) :: ncpi (nx,ny,nzm) ! cloud ice number concentration,/m^3 - real, intent(in) :: qpl (nx,ny,nzm) ! rain mixing ratio, kg/kg - not used at this time - real, intent(in) :: qpi_i (nx,ny,nzm) ! snow mixing ratio, kg/kg - not used at this time - real, intent(in) :: qgl (nx,ny,nzm) ! graupel mixing ratio, kg/kg - not used at this time - real, intent(in) :: rhc (nx,ny,nzm) ! critical relative humidity - real, intent(in) :: supice ! ice supersaturation parameter - real, intent(inout) :: cld_sgs(ix,ny,nzm) ! sgs cloud fraction -! real, intent(inout) :: cld_sgs(nx,ny,nzm) ! sgs cloud fraction - real, intent(inout) :: tke (ix,ny,nzm) ! turbulent kinetic energy. m**2/s**2 -! real, intent(inout) :: tk (nx,ny,nzm) ! eddy viscosity - real, intent(inout) :: tkh (ix,ny,nzm) ! eddy diffusivity - real, intent(in) :: prnum (nx,ny,nzm) ! turbulent Prandtl number - real, intent(inout) :: wthv_sec (ix,ny,nzm) ! Buoyancy flux, K*m/s - - real, parameter :: zero=0.0, one=1.0, half=0.5, two=2.0, eps=0.622, & - three=3.0, oneb3=one/three, twoby3=two/three - real, parameter :: sqrt2 = sqrt(two), twoby15 = two / 15.0, & - skew_facw=1.2, skew_fact=0.0, & - tkhmax=300.0 - real :: lsub, fac_cond, fac_fus, cpolv, fac_sub, ggri, kapa, gocp, rog, sqrtpii, & - epsterm, onebeps, onebrvcp + real, intent(inout) :: ncpl (nx,nzm) ! cloud water number concentration,/m^3 + real, intent(inout) :: ncpi (nx,nzm) ! cloud ice number concentration,/m^3 + real, intent(in) :: qpl (nx,nzm) ! rain mixing ratio, kg/kg + real, intent(in) :: qpi (nx,nzm) ! snow mixing ratio, kg/kg + + real, intent(in) :: rhc (nx,nzm) ! critical relative humidity + real, intent(in) :: supice ! ice supersaturation parameter + real, intent(out) :: cld_sgs(ix,nzm) ! sgs cloud fraction +! real, intent(inout) :: cld_sgs(nx,nzm) ! sgs cloud fraction + real, intent(inout) :: tke (ix,nzm) ! turbulent kinetic energy. m**2/s**2 +! real, intent(inout) :: tk (nx,nzm) ! eddy viscosity + real, intent(inout) :: tkh (ix,nzm) ! eddy diffusivity + real, intent(in) :: prnum (nx,nzm) ! turbulent Prandtl number + real, intent(inout) :: wthv_sec (ix,nzm) ! Buoyancy flux, K*m/s + + real, parameter :: zero=0.0d0, one=1.0d0, half=0.5d0, two=2.0d0, eps=0.622d0, & + three=3.0d0, oneb3=one/three, twoby3=two/three, fourb3=twoby3+twoby3 + real, parameter :: sqrt2 = sqrt(two), twoby15 = two / 15.d0, & + nmin = 1.0d0, RI_cub = 6.4d-14, RL_cub = 1.0d-15, & + skew_facw=1.2d0, skew_fact=0.d0, & + tkhmax=300.d0, qcmin=1.0d-9 + real :: lsub, fac_cond, fac_fus, cpolv, fac_sub, ggri, kapa, gocp, & + rog, sqrtpii, epsterm, onebeps, onebrvcp ! SHOC tunable parameters - real, parameter :: lambda = 0.04 -! real, parameter :: min_tke = 1e-6 ! Minumum TKE value, m**2/s**2 - real, parameter :: min_tke = 1e-4 ! Minumum TKE value, m**2/s**2 -! real, parameter :: max_tke = 100.0 ! Maximum TKE value, m**2/s**2 - real, parameter :: max_tke = 40.0 ! Maximum TKE value, m**2/s**2 + real, parameter :: lambda = 0.04d0 +! real, parameter :: min_tke = 1.0d-6 ! Minumum TKE value, m**2/s**2 + real, parameter :: min_tke = 1.0d-4 ! Minumum TKE value, m**2/s**2 +! real, parameter :: max_tke = 100.0d0 ! Maximum TKE value, m**2/s**2 + real, parameter :: max_tke = 40.0d0 ! Maximum TKE value, m**2/s**2 ! Maximum turbulent eddy length scale, m -! real, parameter :: max_eddy_length_scale = 2000. - real, parameter :: max_eddy_length_scale = 1000. +! real, parameter :: max_eddy_length_scale = 2000.0d0 + real, parameter :: max_eddy_length_scale = 1000.0d0 ! Maximum "return-to-isotropy" time scale, s - real, parameter :: max_eddy_dissipation_time_scale = 2000. - real, parameter :: Pr = 1.0 ! Prandtl number + real, parameter :: max_eddy_dissipation_time_scale = 2000.d0 + real, parameter :: Pr = 1.0d0 ! Prandtl number ! Constants for the TKE dissipation term based on Deardorff (1980) - real, parameter :: pt19=0.19, pt51=0.51, pt01=0.01, atmin=0.01, atmax=one-atmin - real, parameter :: Cs = 0.15, epsln=1.0e-6 - real, parameter :: Ck = 0.1 ! Coeff in the eddy diffusivity - TKE relationship, see Eq. 7 in BK13 + real, parameter :: pt19=0.19d0, pt51=0.51d0, pt01=0.01d0, atmin=0.01d0, atmax=one-atmin + real, parameter :: Cs = 0.15d0, epsln=1.0d-6 +! real, parameter :: Ck = 0.2d0 ! Coeff in the eddy diffusivity - TKE relationship, see Eq. 7 in BK13 + real, parameter :: Ck = 0.1d0 ! Coeff in the eddy diffusivity - TKE relationship, see Eq. 7 in BK13 ! real, parameter :: Ce = Ck**3/(0.7*Cs**4) ! real, parameter :: Ce = Ck**3/(0.7*Cs**4) * 2.2 @@ -295,79 +260,75 @@ subroutine shoc_work (ix, nx, ny, nzm, nz, dtn, me, lat, & real, parameter :: Ce = Ck**3/Cs**4, Ces = Ce ! real, parameter :: Ce = Ck**3/Cs**4, Ces = Ce*3.0/0.7 -! real, parameter :: vonk=0.35 ! Von Karman constant - real, parameter :: vonk=0.4 ! Von Karman constant Moorthi - as in GFS - real, parameter :: tscale=400.! time scale set based off of similarity results of BK13, s - real, parameter :: w_tol_sqd = 4.0e-04 ! Min vlaue of second moment of w +! real, parameter :: vonk=0.35 ! Von Karman constant + real, parameter :: vonk=0.4d0 ! Von Karman constant Moorthi - as in GFS + real, parameter :: tscale=400.0d0 ! time scale set based off of similarity results of BK13, s + real, parameter :: w_tol_sqd = 4.0d-04 ! Min vlaue of second moment of w ! real, parameter :: w_tol_sqd = 1.0e-04 ! Min vlaue of second moment of w - real, parameter :: w_thresh = 0.0, thresh = 0.0 - real, parameter :: w3_tol = 1.0e-20 ! Min vlaue of third moment of w + real, parameter :: w_thresh = 0.0d0, thresh = 0.0d0 + real, parameter :: w3_tol = 1.0d-20 ! Min vlaue of third moment of w ! These parameters are a tie-in with a microphysical scheme ! Double check their values for the Zhao-Carr scheme. - real, parameter :: tbgmin = 233.16 ! Minimum temperature for cloud water., K (ZC) -! real, parameter :: tbgmin = 258.16 ! Minimum temperature for cloud water., K (ZC) -! real, parameter :: tbgmin = 253.16 ! Minimum temperature for cloud water., K - real, parameter :: tbgmax = 273.16 ! Maximum temperature for cloud ice, K + real, parameter :: tbgmin = 233.16d0 ! Minimum temperature for cloud water., K (ZC) +! real, parameter :: tbgmin = 258.16d0 ! Minimum temperature for cloud water., K (ZC) +! real, parameter :: tbgmin = 253.16d0 ! Minimum temperature for cloud water., K + real, parameter :: tbgmax = 273.16d0 ! Maximum temperature for cloud ice, K real, parameter :: a_bg = one/(tbgmax-tbgmin) ! ! Parameters to tune the second order moments- No tuning is performed currently - real, parameter :: thl2tune = 1.0, qw2tune = 1.0, qwthl2tune = 1.0, & -! thl_tol = 1.e-4, rt_tol = 1.e-8, basetemp = 300.0 - thl_tol = 1.e-2, rt_tol = 1.e-4, basetemp = 300.0 +! real, parameter :: thl2tune = 2.0d0, qw2tune = 2.0d0, qwthl2tune = 2.0d0, & + real, parameter :: thl2tune = 1.0d0, qw2tune = 1.0d0, qwthl2tune = 1.0d0, & +! thl_tol = 1.0d-4, rt_tol = 1.0d-8, basetemp = 300.0d0 + thl_tol = 1.0d-2, rt_tol = 1.0d-4 integer, parameter :: nitr=6 ! Local variables. Note that pressure is in millibars in the SHOC code. - logical lprnt - integer ipr - - real zl (nx,ny,nzm) ! height of the pressure levels above surface, m - real zi (nx,ny,nz) ! height of the interface levels, m - real adzl (nx,ny,nzm) ! layer thickness i.e. zi(k+1)-zi(k) - defined at levels - real adzi (nx,ny,nz) ! level thickness i.e. zl(k)-zl(k-1) - defined at interface + real zl (nx,nzm) ! height of the pressure levels above surface, m + real zi (nx,nz) ! height of the interface levels, m + real adzl (nx,nzm) ! layer thickness i.e. zi(k+1)-zi(k) - defined at levels + real adzi (nx,nz) ! level thickness i.e. zl(k)-zl(k-1) - defined at interface - real hl (nx,ny,nzm) ! liquid/ice water static energy , K - real qv (nx,ny,nzm) ! water vapor, kg/kg - real qcl (nx,ny,nzm) ! liquid water (condensate), kg/kg - real qci (nx,ny,nzm) ! ice water (condensate), kg/kg - real w (nx,ny,nzm) ! z-wind, m/s - real bet (nx,ny,nzm) ! ggr/tv0 - real gamaz (nx,ny,nzm) ! ggr/cp*z - real qpi (nx,ny,nzm) ! snow + graupel mixing ratio, kg/kg -! real qpl (nx,ny,nzm) ! rain mixing ratio, kg/kg + real hl (nx,nzm) ! liquid/ice water static energy , K + real qv (nx,nzm) ! water vapor, kg/kg + real qcl (nx,nzm) ! liquid water (condensate), kg/kg + real qci (nx,nzm) ! ice water (condensate), kg/kg + real w (nx,nzm) ! z-wind, m/s + real bet (nx,nzm) ! ggr/tv0 + real gamaz (nx,nzm) ! ggr/cp*z ! Moments of the trivariate double Gaussian PDF for the SGS total water mixing ratio ! SGS liquid/ice static energy, and vertical velocity - real qw_sec (nx,ny,nzm) ! Second moment total water mixing ratio, kg^2/kg^2 - real thl_sec (nx,ny,nzm) ! Second moment liquid/ice static energy, K^2 - real qwthl_sec(nx,ny,nzm) ! Covariance tot. wat. mix. ratio and static energy, K*kg/kg - real wqw_sec (nx,ny,nzm) ! Turbulent flux of tot. wat. mix., kg/kg*m/s - real wthl_sec (nx,ny,nzm) ! Turbulent flux of liquid/ice static energy, K*m/s - real w_sec (nx,ny,nzm) ! Second moment of vertical velocity, m**2/s**2 - real w3 (nx,ny,nzm) ! Third moment of vertical velocity, m**3/s**3 - real wqp_sec (nx,ny,nzm) ! Turbulent flux of precipitation, kg/kg*m/s + real qw_sec (nx,nzm) ! Second moment total water mixing ratio, kg^2/kg^2 + real thl_sec (nx,nzm) ! Second moment liquid/ice static energy, K^2 + real qwthl_sec(nx,nzm) ! Covariance tot. wat. mix. ratio and static energy, K*kg/kg + real wqw_sec (nx,nzm) ! Turbulent flux of tot. wat. mix., kg/kg*m/s + real wthl_sec (nx,nzm) ! Turbulent flux of liquid/ice static energy, K*m/s + real w_sec (nx,nzm) ! Second moment of vertical velocity, m**2/s**2 + real w3 (nx,nzm) ! Third moment of vertical velocity, m**3/s**3 + real wqp_sec (nx,nzm) ! Turbulent flux of precipitation, kg/kg*m/s ! Eddy length formulation - real smixt (nx,ny,nzm) ! Turbulent length scale, m - real isotropy (nx,ny,nzm) ! "Return-to-isotropy" eddy dissipation time scale, s -! real isotropy_debug (nx,ny,nzm) ! Return to isotropy scale, s without artificial limits - real brunt (nx,ny,nzm) ! Moist Brunt-Vaisalla frequency, s^-1 - real conv_vel2(nx,ny,nzm) ! Convective velocity scale cubed, m^3/s^3 + real smixt (nx,nzm) ! Turbulent length scale, m + real isotropy (nx,nzm) ! "Return-to-isotropy" eddy dissipation time scale, s +! real isotropy_debug (nx,nzm) ! Return to isotropy scale, s without artificial limits + real brunt (nx,nzm) ! Moist Brunt-Vaisalla frequency, s^-1 + real conv_vel2(nx,nzm) ! Convective velocity scale cubed, m^3/s^3 - real cek(nx,ny) + real cek(nx) ! Output of SHOC real diag_frac, diag_qn, diag_qi, diag_ql -! real diag_frac(nx,ny,nzm) ! SGS cloud fraction -! real diag_qn (nx,ny,nzm) ! SGS cloud+ice condensate, kg/kg -! real diag_qi (nx,ny,nzm) ! SGS ice condensate, kg/kg -! real diag_ql (nx,ny,nzm) ! SGS liquid condensate, kg/kg +! real diag_frac(nx,nzm) ! SGS cloud fraction +! real diag_qn (nx,nzm) ! SGS cloud+ice condensate, kg/kg +! real diag_qi (nx,nzm) ! SGS ice condensate, kg/kg +! real diag_ql (nx,nzm) ! SGS liquid condensate, kg/kg ! Horizontally averaged variables @@ -380,156 +341,149 @@ subroutine shoc_work (ix, nx, ny, nzm, nz, dtn, me, lat, & ! Local variables -! real, dimension(nx,ny,nzm) :: tkesbbuoy, tkesbshear, tkesbdiss, tkesbbuoy_debug & +! real, dimension(nx,nzm) :: tkesbbuoy, tkesbshear, tkesbdiss, tkesbbuoy_debug & ! tkebuoy_sgs, total_water, tscale1_debug, brunt2 - real, dimension(nx,ny,nzm) :: total_water, brunt2, thv, tkesbdiss - real, dimension(nx,ny,nzm) :: def2 - real, dimension(nx,ny) :: denom, numer, l_inf, cldarr, thedz, thedz2 + real, dimension(nx,nzm) :: total_water, brunt2, thv, tkesbdiss + real, dimension(nx,nzm) :: def2 + real, dimension(nx) :: denom, numer, l_inf, cldarr, thedz, thedz2 real lstarn, depth, omn, betdz, bbb, term, qsatt, dqsat, & - conv_var, tkes, skew_w, skew_qw, aterm, w1_1, w1_2, w2_1, & + conv_var, tkes, skew_w, skew_qw, aterm, w1_1, w1_2, w2_1, & w2_2, w3var, thl1_1, thl1_2, thl2_1, thl2_2, qw1_1, qw1_2, qw2_1, & qw2_2, ql1, ql2, w_ql1, w_ql2, & - r_qwthl_1, r_wqw_1, r_wthl_1, testvar, s1, s2, std_s1, std_s2, C1, C2, & + r_qwthl_1, r_wqw_1, r_wthl_1, testvar, s1, s2, std_s1, std_s2, C1, C2, & thl_first, qw_first, w_first, Tl1_1, Tl1_2, betatest, pval, pkap, & w2thl, w2qw,w2ql, w2ql_1, w2ql_2, & thec, thlsec, qwsec, qwthlsec, wqwsec, wthlsec, thestd,dum, & cqt1, cthl1, cqt2, cthl2, qn1, qn2, qi1, qi2, omn1, omn2, & basetemp2, beta1, beta2, qs1, qs2, & - esval1_1, esval2_1, esval1_2, esval2_2, om1, om2, & + esval, esval2, om1, om2, epss, & lstarn1, lstarn2, sqrtw2, sqrtthl, sqrtqt, & - sqrtstd1, sqrtstd2, tsign, tvar, sqrtw2t, wqls, wqis, & - sqrtqw2_1, sqrtqw2_2, sqrtthl2_1, sqrtthl2_2, sm, prespot, & - corrtest1, corrtest2, wrk, wrk1, wrk2, wrk3, onema, pfac + sqrtstd1, sqrtstd2, tsign, tvar, sqrtw2t, wqls, wqis, & + sqrtqw2_1, sqrtqw2_2, sqrtthl2_1, sqrtthl2_2, sm, prespot, & + corrtest1, corrtest2, wrk, wrk1, wrk2, wrk3, onema, pfac - integer i,j,k,km1,ku,kd,ka,kb + integer i,k,km1,ku,kd,ka,kb + !calculate derived constants - lsub = lcond+lfus + lsub = lcond+lfus fac_cond = lcond/cp - fac_fus = lfus/cp - cpolv = cp/lcond - fac_sub = lsub/cp - ggri = 1.0/ggr - kapa = rgas/cp - gocp = ggr/cp - rog = rgas*ggri - sqrtpii = one/sqrt(pi+pi) - epsterm = rgas/rv - onebeps = one/epsterm - onebrvcp= one/(rv*cp) + fac_fus = lfus/cp + cpolv = cp/lcond + fac_sub = lsub/cp + ggri = one/ggr + kapa = rgas/cp + gocp = ggr/cp + rog = rgas*ggri + sqrtpii = one/sqrt(pi+pi) + epsterm = rgas/rv + onebeps = one/epsterm + onebrvcp = one/(rv*cp) + epss = eps * supice ! Map GFS variables to those of SHOC - SHOC operates on 3D fields ! Here a Y-dimension is added to the input variables, along with some unit conversions do k=1,nz - do j=1,ny - do i=1,nx - zi(i,j,k) = phii(i,j,k) * ggri - enddo + do i=1,nx + zi(i,k) = phii(i,k) * ggri enddo enddo -! if (lprnt) write(0,*)' tabsin=',tabs(ipr,1,1:40) -! if (lprnt) write(0,*)' qcin=',qc(ipr,1,1:40) -! if (lprnt) write(0,*)' qwvin=',qwv(ipr,1,1:40) -! if (lprnt) write(0,*)' qiin=',qi(ipr,1,1:40) -! if (lprnt) write(0,*)' qplin=',qpl(ipr,1,1:40) -! if (lprnt) write(0,*)' qpiin=',qpi(ipr,1,1:40) ! ! move water from vapor to condensate if the condensate is negative ! do k=1,nzm - do j=1,ny - do i=1,nx - if (qc(i,j,k) < zero) then - wrk = qwv(i,j,k) + qc(i,j,k) - if (wrk >= zero) then - qwv(i,j,k) = wrk - tabs(i,j,k) = tabs(i,j,k) - fac_cond * qc(i,j,k) - qc(i,j,k) = zero - else - qc(i,j,k) = zero - tabs(i,j,k) = tabs(i,j,k) + fac_cond * qwv(i,j,k) - qwv(i,j,k) = zero - endif - endif - if (qi(i,j,k) < zero) then - wrk = qwv(i,j,k) + qi(i,j,k) - if (wrk >= zero) then - qwv(i,j,k) = wrk - tabs(i,j,k) = tabs(i,j,k) - fac_sub * qi(i,j,k) - qi(i,j,k) = zero - else - qi(i,j,k) = zero - tabs(i,j,k) = tabs(i,j,k) + fac_sub * qwv(i,j,k) - qwv(i,j,k) = zero - endif - endif - enddo + do i=1,nx + if (qc(i,k) < zero) then + qwv(i,k) = qwv(i,k) + qc(i,k) + tabs(i,k) = tabs(i,k) - fac_cond * qc(i,k) + qc(i,k) = zero + endif + if (qi(i,k) < zero) then + qwv(i,k) = qwv(i,k) + qi(i,k) + tabs(i,k) = tabs(i,k) - fac_sub * qi(i,k) + qi(i,k) = zero + endif +! +! testing removal of ice when too warm to sustain ice +! +! if (qi(i,k) > zero .and. tabs(i,k) > 273.16) then +! wrk = (tabs(i,k) - 273.16) / fac_sub +! if (wrk < qi(i,k)) then +! wrk = qi(i,k) - wrk +! qi(i,k) = wrk +! qwv(i,k) = qwv(i,k) + wrk +! tabs(i,k) = 273.16 +! else +! tabs(i,k) = tabs(i,k) - qi(i,k) / fac_sub +! qwv(i,k) = qwv(i,k) + qi(i,k) +! qi(i,k) = 0.0 +! endif +! endif + + enddo + enddo +! fill negative water vapor from below + do k=nzm,2,-1 + km1 = k - 1 + do i=1,nx + if (qwv(i,k) < zero) then + qwv(i,k) = qwv(i,km1) + qwv(i,k) * delp(i,k) / delp(i,km1) + endif enddo enddo - -! if (lprnt) write(0,*)' tabsin2=',tabs(ipr,1,1:40) do k=1,nzm - do j=1,ny - do i=1,nx - zl(i,j,k) = phil(i,j,k) * ggri - wrk = one / prsl(i,j,k) - qv(i,j,k) = max(qwv(i,j,k), zero) - thv(i,j,k) = tabs(i,j,k) * (one+epsv*qv(i,j,k)) - w(i,j,k) = - rog * omega(i,j,k) * thv(i,j,k) * wrk - qcl(i,j,k) = max(qc(i,j,k), zero) - qci(i,j,k) = max(qi(i,j,k), zero) - qpi(i,j,k) = qpi_i(i,j,k) + qgl(i,j,k) ! add snow and graupel together + do i=1,nx + zl(i,k) = phil(i,k) * ggri + wrk = one / prsl(i,k) + qv(i,k) = max(qwv(i,k), zero) + thv(i,k) = tabs(i,k) * (one+epsv*qv(i,k)) + w(i,k) = - rog * omega(i,k) * thv(i,k) * wrk + qcl(i,k) = max(qc(i,k), zero) + qci(i,k) = max(qi(i,k), zero) ! -! qpl(i,j,k) = zero ! comment or remove when using with prognostic rain/snow -! qpi(i,j,k) = zero ! comment or remove when using with prognostic rain/snow +! qpl(i,k) = zero ! comment or remove when using with prognostic rain/snow +! qpi(i,k) = zero ! comment or remove when using with prognostic rain/snow - wqp_sec(i,j,k) = zero ! Turbulent flux of precipiation + wqp_sec(i,k) = zero ! Turbulent flux of precipiation ! - total_water(i,j,k) = qcl(i,j,k) + qci(i,j,k) + qv(i,j,k) + total_water(i,k) = qcl(i,k) + qci(i,k) + qv(i,k) - prespot = (100000.0*wrk) ** kapa ! Exner function - bet(i,j,k) = ggr/(tabs(i,j,k)*prespot) ! Moorthi - thv(i,j,k) = thv(i,j,k)*prespot ! Moorthi + prespot = (100000.0d0*wrk) ** kapa ! Exner function + bet(i,k) = ggr/(tabs(i,k)*prespot) ! Moorthi + thv(i,k) = thv(i,k)*prespot ! Moorthi ! ! Lapse rate * height = reference temperature - gamaz(i,j,k) = gocp * zl(i,j,k) + gamaz(i,k) = gocp * zl(i,k) ! Liquid/ice water static energy - ! Note the the units are degrees K - hl(i,j,k) = tabs(i,j,k) + gamaz(i,j,k) - fac_cond*(qcl(i,j,k)+qpl(i,j,k)) & - - fac_sub *(qci(i,j,k)+qpi(i,j,k)) - w3(i,j,k) = zero - enddo + hl(i,k) = tabs(i,k) + gamaz(i,k) - fac_cond*(qcl(i,k)+qpl(i,k)) & + - fac_sub *(qci(i,k)+qpi(i,k)) + w3(i,k) = zero enddo enddo -! if (lprnt) write(0,*)' hlin=',hl(ipr,1,1:40) - ! Define vertical grid increments for later use in the vertical differentiation do k=2,nzm km1 = k - 1 - do j=1,ny - do i=1,nx - adzi(i,j,k) = zl(i,j,k) - zl(i,j,km1) - adzl(i,j,km1) = zi(i,j,k) - zi(i,j,km1) - enddo + do i=1,nx + adzi(i,k) = zl(i,k) - zl(i,km1) + adzl(i,km1) = zi(i,k) - zi(i,km1) enddo enddo - do j=1,ny - do i=1,nx - adzi(i,j,1) = (zl(i,j,1)-zi(i,j,1)) ! unused in the code - adzi(i,j,nz) = adzi(i,j,nzm) ! at the top - probably unused - adzl(i,j,nzm) = zi(i,j,nz) - zi(i,j,nzm) + do i=1,nx + adzi(i,1) = (zl(i,1)-zi(i,1)) ! unused in the code + adzi(i,nz) = adzi(i,nzm) ! at the top - probably unused + adzl(i,nzm) = zi(i,nz) - zi(i,nzm) ! - wthl_sec(i,j,1) = hflx(i) - wqw_sec(i,j,1) = evap(i) - enddo + wthl_sec(i,1) = hflx(i) + wqw_sec(i,1) = evap(i) enddo @@ -558,77 +512,69 @@ subroutine shoc_work (ix, nx, ny, nzm, nz, dtn, me, lat, & ku = k ka = kb endif - do j=1,ny - do i=1,nx - if (tke(i,j,k) > zero) then -! wrk = half*(tkh(i,j,ka)+tkh(i,j,kb))*(w(i,j,ku) - w(i,j,kd)) & - wrk = half*(tkh(i,j,ka)*prnum(i,j,ka)+tkh(i,j,kb)*prnum(i,j,kb))*(w(i,j,ku) - w(i,j,kd)) & - * sqrt(tke(i,j,k)) / (zl(i,j,ku) - zl(i,j,kd)) - w_sec(i,j,k) = max(twoby3 * tke(i,j,k) - twoby15 * wrk, zero) -! w_sec(i,j,k) = max(twoby3 * tke(i,j,k), zero) -! if(lprnt .and. i == ipr .and. k <40) write(0,*)' w_sec=',w_sec(i,j,k),' tke=r',tke(i,j,k),& -! ' tkh=',tkh(i,j,ka),tkh(i,j,kb),' w=',w(i,j,ku),w(i,j,kd),' prnum=',prnum(i,j,ka),prnum(i,j,kb) - else - w_sec(i,j,k) = zero - endif - enddo + do i=1,nx + if (tke(i,k) > zero) then +! wrk = half*(tkh(i,ka)+tkh(i,kb))*(w(i,ku) - w(i,kd)) & + wrk = half*(tkh(i,ka)*prnum(i,ka)+tkh(i,kb)*prnum(i,kb))*(w(i,ku) - w(i,kd)) & + * sqrt(tke(i,k)) / (zl(i,ku) - zl(i,kd)) + w_sec(i,k) = max(twoby3 * tke(i,k) - twoby15 * wrk, zero) +! w_sec(i,k) = max(twoby3 * tke(i,k), zero) + else + w_sec(i,k) = zero + endif enddo enddo do k=2,nzm km1 = k - 1 - do j=1,ny - do i=1,nx + do i=1,nx ! Use backward difference in the vertical, use averaged values of "return-to-isotropy" ! time scale and diffusion coefficient - wrk1 = one / adzi(i,j,k) ! adzi(k) = (zl(k)-zl(km1)) -! wrk3 = max(tkh(i,j,k),pt01) * wrk1 - wrk3 = max(tkh(i,j,k),epsln) * wrk1 + wrk1 = one / adzi(i,k) ! adzi(k) = (zl(k)-zl(km1)) +! wrk3 = max(tkh(i,k),pt01) * wrk1 + wrk3 = max(tkh(i,k),epsln) * wrk1 - sm = half*(isotropy(i,j,k)+isotropy(i,j,km1))*wrk1*wrk3 ! Tau*Kh/dz^2 + sm = half*(isotropy(i,k)+isotropy(i,km1))*wrk1*wrk3 ! Tau*Kh/dz^2 ! SGS vertical flux liquid/ice water static energy. Eq 1 in BK13 ! No rain, snow or graupel in pdf (Annig, 08/29/2018) - wrk1 = hl(i,j,k) - hl(i,j,km1) & - + (qpl(i,j,k) - qpl(i,j,km1)) * fac_cond & - + (qpi(i,j,k) - qpi(i,j,km1)) * fac_sub - wthl_sec(i,j,k) = - wrk3 * wrk1 + wrk1 = hl(i,k) - hl(i,km1) & + + (qpl(i,k) - qpl(i,km1)) * fac_cond & + + (qpi(i,k) - qpi(i,km1)) * fac_sub + wthl_sec(i,k) = - wrk3 * wrk1 ! SGS vertical flux of total water. Eq 2 in BK13 - wrk2 = total_water(i,j,k) - total_water(i,j,km1) - wqw_sec(i,j,k) = - wrk3 * wrk2 + wrk2 = total_water(i,k) - total_water(i,km1) + wqw_sec(i,k) = - wrk3 * wrk2 ! Second moment of liquid/ice water static energy. Eq 4 in BK13 - thl_sec(i,j,k) = thl2tune * sm * wrk1 * wrk1 + thl_sec(i,k) = thl2tune * sm * wrk1 * wrk1 ! Second moment of total water mixing ratio. Eq 3 in BK13 - qw_sec(i,j,k) = qw2tune * sm * wrk2 * wrk2 + qw_sec(i,k) = qw2tune * sm * wrk2 * wrk2 ! Covariance of total water mixing ratio and liquid/ice water static energy. ! Eq 5 in BK13 - qwthl_sec(i,j,k) = qwthl2tune * sm * wrk1 * wrk2 + qwthl_sec(i,k) = qwthl2tune * sm * wrk1 * wrk2 - enddo ! i loop - enddo ! j loop + enddo ! i loop enddo ! k loop ! These would be at the surface - do we need them? - do j=1,ny - do i=1,nx -! wthl_sec(i,j,1) = wthl_sec(i,j,2) -! wqw_sec(i,j,1) = wqw_sec(i,j,2) - thl_sec(i,j,1) = thl_sec(i,j,2) - qw_sec(i,j,1) = qw_sec(i,j,2) - qwthl_sec(i,j,1) = qwthl_sec(i,j,2) - enddo + do i=1,nx +! wthl_sec(i,1) = wthl_sec(i,2) +! wqw_sec(i,1) = wqw_sec(i,2) + thl_sec(i,1) = thl_sec(i,2) + qw_sec(i,1) = qw_sec(i,2) + qwthl_sec(i,1) = qwthl_sec(i,2) enddo ! Diagnose the third moment of SGS vertical velocity @@ -648,10 +594,10 @@ subroutine tke_shoc() ! This subroutine solves the TKE equation, ! Heavily based on SAM's tke_full.f90 by Marat Khairoutdinov - real grd,betdz,Cee,lstarn, lstarp, bbb, omn, omp,qsatt,dqsat, smix, & + real grd,betdz,Cee,lstarn, lstarp, bbb, omn, omp,qsatt,dqsat, smix, & buoy_sgs,ratio,a_prod_sh,a_prod_bu,a_diss,a_prod_bu_debug, buoy_sgs_debug, & tscale1, wrk, wrk1, wtke, wtk2, rdtn, tkef2 - integer i,j,k,ku,kd,itr,k1 + integer i,k,ku,kd,itr,k1 rdtn = one / dtn @@ -660,13 +606,11 @@ subroutine tke_shoc() ! Ensure values of TKE are reasonable do k=1,nzm - do j=1,ny - do i=1,nx - tke(i,j,k) = max(min_tke,tke(i,j,k)) - tkesbdiss(i,j,k) = zero -! tkesbshear(i,j,k) = zero -! tkesbbuoy(i,j,k) = zero - enddo + do i=1,nx + tke(i,k) = max(min_tke,tke(i,k)) + tkesbdiss(i,k) = zero +! tkesbshear(i,k) = zero +! tkesbbuoy(i,k) = zero enddo enddo @@ -691,11 +635,9 @@ subroutine tke_shoc() endif if (dis_opt > 0) then - do j=1,ny - do i=1,nx - wrk = (zl(i,j,k)-zi(i,j,1)) / adzl(i,j,1) + 1.5 - cek(i,j) = 1.0 + 2.0 / max((wrk*wrk - 3.3), 0.5) - enddo + do i=1,nx + wrk = (zl(i,k)-zi(i,1)) / adzl(i,1) + 1.5d0 + cek(i) = (one + two / max((wrk*wrk - 3.3d0), 0.5d0)) * cefac enddo else if (k == 1) then @@ -705,111 +647,95 @@ subroutine tke_shoc() endif endif - do j=1,ny - do i=1,nx - grd = adzl(i,j,k) ! adzl(k) = zi(k+1)-zi(k) + do i=1,nx + grd = adzl(i,k) ! adzl(k) = zi(k+1)-zi(k) ! TKE boyancy production term. wthv_sec (buoyancy flux) is calculated in ! assumed_pdf(). The value used here is from the previous time step - a_prod_bu = ggr / thv(i,j,k) * wthv_sec(i,j,k) + a_prod_bu = ggr / thv(i,k) * wthv_sec(i,k) ! If wthv_sec from subgrid PDF is not available use Brunt-Vaisalla frequency from eddy_length() !Obtain Brunt-Vaisalla frequency from diagnosed SGS buoyancy flux !Presumably it is more precise than BV freq. calculated in eddy_length()? - buoy_sgs = - (a_prod_bu+a_prod_bu) / (tkh(i,j,ku)+tkh(i,j,kd) + 0.0001) ! tkh is eddy thermal diffussivity + buoy_sgs = - (a_prod_bu+a_prod_bu) / (tkh(i,ku)+tkh(i,kd) + 0.0001) ! tkh is eddy thermal diffussivity !Compute $c_k$ (variable Cee) for the TKE dissipation term following Deardorff (1980) - if (buoy_sgs <= zero) then - smix = grd - else - smix = min(grd,max(0.1*grd, 0.76*sqrt(tke(i,j,k)/(buoy_sgs+1.e-10)))) - endif + if (buoy_sgs <= zero) then + smix = grd + else + smix = min(grd,max(0.1d0*grd, 0.76d0*sqrt(tke(i,k)/(buoy_sgs+1.0d-10)))) + endif - ratio = smix/grd - Cee = Cek(i,j) * (pt19 + pt51*ratio) * max(one, sqrt(pcrit/prsl(i,j,k))) + ratio = smix/grd + Cee = Cek(i) * (pt19 + pt51*ratio) * max(one, sqrt(pcrit/prsl(i,k))) ! TKE shear production term - a_prod_sh = half*(def2(i,j,ku)*tkh(i,j,ku)*prnum(i,j,ku) & - + def2(i,j,kd)*tkh(i,j,kd)*prnum(i,j,kd)) + a_prod_sh = half*(def2(i,ku)*tkh(i,ku)*prnum(i,ku) & + + def2(i,kd)*tkh(i,kd)*prnum(i,kd)) -! smixt (turb. mixing lenght) is calculated in eddy_length() +! smixt (turb. mixing lenght) is calculated in eddy_length() ! Explicitly integrate TKE equation forward in time -! a_diss = Cee/smixt(i,j,k)*tke(i,j,k)**1.5 ! TKE dissipation term -! tke(i,j,k) = max(zero,tke(i,j,k)+dtn*(max(zero,a_prod_sh+a_prod_bu)-a_diss)) +! a_diss = Cee/smixt(i,k)*tke(i,k)**1.5 ! TKE dissipation term +! tke(i,k) = max(zero,tke(i,k)+dtn*(max(zero,a_prod_sh+a_prod_bu)-a_diss)) ! Semi-implicitly integrate TKE equation forward in time - wtke = tke(i,j,k) - wtk2 = wtke -! wrk = (dtn*Cee)/smixt(i,j,k) - wrk = (dtn*Cee) / smixt(i,j,k) - wrk1 = wtke + dtn*(a_prod_sh+a_prod_bu) - -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' wtke=',wtke,' wrk1=',wrk1,& -! ' a_prod_sh=',a_prod_sh,' a_prod_bu=',a_prod_bu,' dtn=',dtn,' smixt=',& -! smixt(i,j,k),' tkh=',tkh(i,j,ku),tkh(i,j,kd),' def2=',def2(i,j,ku),def2(i,j,kd)& -! ,' prnum=',prnum(i,j,ku),prnum(i,j,kd),' wthv_sec=',wthv_sec(i,j,k),' thv=',thv(i,j,k) - - do itr=1,nitr ! iterate for implicit solution - wtke = min(max(min_tke, wtke), max_tke) - a_diss = wrk*sqrt(wtke) ! Coefficient in the TKE dissipation term - wtke = wrk1 / (one+a_diss) - wtke = tkef1*wtke + tkef2*wtk2 ! tkef1+tkef2 = 1.0 - -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' wtke=',wtke,' wtk2=',wtk2,& -! ' a_diss=',a_diss,' a_prod_sh=',a_prod_sh,' a_prod_bu=',a_prod_bu,& -! ' wrk1=',wrk1,' itr=',itr,' k=',k - - wtk2 = wtke - - enddo + wtke = tke(i,k) + wtk2 = wtke +! wrk = (dtn*Cee)/smixt(i,k) + wrk = (dtn*Cee) / smixt(i,k) + wrk1 = wtke + dtn*(a_prod_sh+a_prod_bu) + + do itr=1,nitr ! iterate for implicit solution + wtke = min(max(min_tke, wtke), max_tke) + a_diss = wrk*sqrt(wtke) ! Coefficient in the TKE dissipation term + wtke = wrk1 / (one+a_diss) + wtke = tkef1*wtke + tkef2*wtk2 ! tkef1+tkef2 = 1.0 + wtk2 = wtke + enddo - tke(i,j,k) = min(max(min_tke, wtke), max_tke) - a_diss = wrk*sqrt(tke(i,j,k)) + tke(i,k) = min(max(min_tke, wtke), max_tke) + a_diss = wrk*sqrt(tke(i,k)) - tscale1 = (dtn+dtn) / a_diss ! corrected Eq 8 in BK13 -- tau = 2*tke/eps + tscale1 = (dtn+dtn) / a_diss ! corrected Eq 8 in BK13 -- tau = 2*tke/eps - tkesbdiss(i,j,k) = rdtn*a_diss*tke(i,j,k) ! TKE dissipation term, epsilon + tkesbdiss(i,k) = rdtn*a_diss*tke(i,k) ! TKE dissipation term, epsilon ! Calculate "return-to-isotropy" eddy dissipation time scale, see Eq. 8 in BK13 - if (buoy_sgs <= zero) then - isotropy(i,j,k) = min(max_eddy_dissipation_time_scale,tscale1) - else - isotropy(i,j,k) = min(max_eddy_dissipation_time_scale, & - tscale1/(one+lambda*buoy_sgs*tscale1*tscale1)) - endif + if (buoy_sgs <= zero) then + isotropy(i,k) = min(max_eddy_dissipation_time_scale, tscale1) + else + isotropy(i,k) = min(max_eddy_dissipation_time_scale, & + tscale1/(one+lambda*buoy_sgs*tscale1*tscale1)) + endif ! TKE budget terms -! tkesbdiss(i,j,k) = a_diss -! tkesbshear(i,j,k) = a_prod_sh -! tkesbbuoy(i,j,k) = a_prod_bu -! tkesbbuoy_debug(i,j,k) = a_prod_bu_debug -! tkebuoy_sgs(i,j,k) = buoy_sgs +! tkesbdiss(i,k) = a_diss +! tkesbshear(i,k) = a_prod_sh +! tkesbbuoy(i,k) = a_prod_bu +! tkesbbuoy_debug(i,k) = a_prod_bu_debug +! tkebuoy_sgs(i,k) = buoy_sgs - enddo ! i loop - enddo ! j loop - enddo ! k -! + enddo ! i loop + enddo ! k loop wrk = half * ck do k=2,nzm k1 = k - 1 - do j=1,ny - do i=1,nx - tkh(i,j,k) = min(tkhmax, wrk * (isotropy(i,j,k) * tke(i,j,k) & - + isotropy(i,j,k1) * tke(i,j,k1))) ! Eddy thermal diffusivity - enddo ! i - enddo ! j - enddo ! k + do i=1,nx + tkh(i,k) = min(tkhmax, wrk * (isotropy(i,k) * tke(i,k) & + + isotropy(i,k1) * tke(i,k1))) ! Eddy thermal diffusivity + enddo ! i + enddo ! k end subroutine tke_shoc @@ -819,31 +745,26 @@ subroutine tke_shear_prod(def2) ! Calculate TKE shear production term - real, intent(out) :: def2(nx,ny,nzm) + real, intent(out) :: def2(nx,nzm) real rdzw, wrku, wrkv, wrkw - integer i,j,k,k1 + integer i,k,k1 ! Calculate TKE shear production term at layer interface do k=2,nzm k1 = k - 1 - do j=1,ny - do i=1,nx - rdzw = one / adzi(i,j,k) - wrku = (u(i,j,k)-u(i,j,k1)) * rdzw - wrkv = (v(i,j,k)-v(i,j,k1)) * rdzw -! wrkw = (w(i,j,k)-w(i,j,k1)) * rdzw - def2(i,j,k) = wrku*wrku + wrkv*wrkv !+ 2*wrkw(1) * wrkw(1) - enddo - enddo - enddo ! k loop - do j=1,ny do i=1,nx -! def2(i,j,1) = def2(i,j,2) - def2(i,j,1) = (u(i,j,1)*u(i,j,1) + v(i,j,1)*v(i,j,1)) & - / (zl(i,j,1)*zl(i,j,1)) + rdzw = one / adzi(i,k) + wrku = (u(i,k)-u(i,k1)) * rdzw + wrkv = (v(i,k)-v(i,k1)) * rdzw +! wrkw = (w(i,k)-w(i,k1)) * rdzw + def2(i,k) = wrku*wrku + wrkv*wrkv !+ 2*wrkw(1) * wrkw(1) enddo + enddo ! k loop + do i=1,nx +! def2(i,1) = def2(i,2) + def2(i,1) = (u(i,1)*u(i,1) + v(i,1)*v(i,1)) / (zl(i,1)*zl(i,1)) enddo end subroutine tke_shear_prod @@ -855,51 +776,45 @@ subroutine eddy_length() ! Local variables real wrk, wrk1, wrk2, wrk3 - integer i, j, k, kk, kl, ku, kb, kc, kli, kui + integer i, k, kk, kl, ku, kb, kc, kli, kui - do j=1,ny - do i=1,nx - cldarr(i,j) = zero - numer(i,j) = zero - denom(i,j) = zero - enddo + do i=1,nx + cldarr(i) = zero + numer(i) = zero + denom(i) = zero enddo ! Find the length scale outside of clouds, that includes boundary layers. do k=1,nzm - do j=1,ny - do i=1,nx + do i=1,nx ! Reinitialize the mixing length related arrays to zero -! smixt(i,j,k) = one ! shoc_mod module variable smixt - smixt(i,j,k) = epsln ! shoc_mod module variable smixt - brunt(i,j,k) = zero +! smixt(i,k) = one ! shoc_mod module variable smixt + smixt(i,k) = epsln ! shoc_mod module variable smixt + brunt(i,k) = zero !Eq. 11 in BK13 (Eq. 4.13 in Pete's dissertation) !Outside of cloud, integrate from the surface to the cloud base !Should the 'if' below check if the cloud liquid < a small constant instead? - if (qcl(i,j,k)+qci(i,j,k) <= zero) then - tkes = sqrt(tke(i,j,k)) * adzl(i,j,k) - numer(i,j) = numer(i,j) + tkes*zl(i,j,k) ! Numerator in Eq. 11 in BK13 - denom(i,j) = denom(i,j) + tkes ! Denominator in Eq. 11 in BK13 - else - cldarr(i,j) = one ! Take note of columns containing cloud. - endif - enddo + if (qcl(i,k)+qci(i,k) <= qcmin) then + tkes = sqrt(tke(i,k)) * adzl(i,k) + numer(i) = numer(i) + tkes*zl(i,k) ! Numerator in Eq. 11 in BK13 + denom(i) = denom(i) + tkes ! Denominator in Eq. 11 in BK13 + else + cldarr(i) = one ! Take note of columns containing cloud. + endif enddo enddo ! Calculate the measure of PBL depth, Eq. 11 in BK13 (Is this really PBL depth?) - do j=1,ny - do i=1,nx - if (denom(i,j) > zero .and. numer(i,j) > zero) then - l_inf(i,j) = min(0.1 * (numer(i,j)/denom(i,j)), 100.0) - else - l_inf(i,j) = 100.0 - endif - enddo + do i=1,nx + if (denom(i) > zero .and. numer(i) > zero) then + l_inf(i) = min(0.1d0 * (numer(i)/denom(i)), 100.0d0) + else + l_inf(i) = 100.0d0 + endif enddo !Calculate length scale outside of cloud, Eq. 10 in BK13 (Eq. 4.12 in Pete's dissertation) @@ -910,81 +825,80 @@ subroutine eddy_length() if (k == 1) then kb = 1 kc = 2 - thedz(:,:) = adzi(:,:,kc) + thedz(:) = adzi(:,kc) elseif (k == nzm) then kb = nzm-1 kc = nzm - thedz(:,:) = adzi(:,:,k) + thedz(:) = adzi(:,k) else - thedz(:,:) = adzi(:,:,kc) + adzi(:,:,k) ! = (z(k+1)-z(k-1)) + thedz(:) = adzi(:,kc) + adzi(:,k) ! = (z(k+1)-z(k-1)) endif - do j=1,ny - do i=1,nx + do i=1,nx ! vars module variable bet (=ggr/tv0) ; grid module variable adzi - betdz = bet(i,j,k) / thedz(i,j) + betdz = bet(i,k) / thedz(i) - tkes = sqrt(tke(i,j,k)) + tkes = sqrt(tke(i,k)) ! Compute local Brunt-Vaisalla frequency - wrk = qcl(i,j,k) + qci(i,j,k) - if (wrk > zero) then ! If in the cloud + wrk = qcl(i,k) + qci(i,k) + if (wrk > zero) then ! If in the cloud ! Find the in-cloud Brunt-Vaisalla frequency - omn = qcl(i,j,k) / (wrk+1.e-20) ! Ratio of liquid water to total water + omn = qcl(i,k) / (wrk+1.e-20) ! Ratio of liquid water to total water ! Latent heat of phase transformation based on relative water phase content ! fac_cond = lcond/cp, fac_fus = lfus/cp - lstarn = fac_cond + (one-omn)*fac_fus + lstarn = fac_cond + (one-omn)*fac_fus ! Derivative of saturation mixing ratio over water/ice wrt temp. based on relative water phase content - dqsat = omn * dtqsatw(tabs(i,j,k),prsl(i,j,k)) & - + (one-omn) * dtqsati(tabs(i,j,k),prsl(i,j,k)) + dqsat = omn * dtqsatw(tabs(i,k),prsl(i,k)) & + + (one-omn) * dtqsati(tabs(i,k),prsl(i,k)) ! Saturation mixing ratio over water/ice wrt temp based on relative water phase content - qsatt = omn * qsatw(tabs(i,j,k),prsl(i,j,k)) & - + (one-omn) * qsati(tabs(i,j,k),prsl(i,j,k)) + qsatt = omn * qsatw(tabs(i,k),prsl(i,k)) & + + (one-omn) * qsati(tabs(i,k),prsl(i,k)) ! liquid/ice moist static energy static energy divided by cp? - bbb = (one + epsv*qsatt-wrk-qpl(i,j,k)-qpi(i,j,k) & - + 1.61*tabs(i,j,k)*dqsat) / (one+lstarn*dqsat) + bbb = (one + epsv*qsatt-wrk-qpl(i,k)-qpi(i,k) & + + 1.61d0*tabs(i,k)*dqsat) / (one+lstarn*dqsat) ! Calculate Brunt-Vaisalla frequency using centered differences in the vertical - brunt(i,j,k) = betdz*(bbb*(hl(i,j,kc)-hl(i,j,kb)) & - + (bbb*lstarn - (one+lstarn*dqsat)*tabs(i,j,k)) & - * (total_water(i,j,kc)-total_water(i,j,kb)) & - + (bbb*fac_cond - (one+fac_cond*dqsat)*tabs(i,j,k))*(qpl(i,j,kc)-qpl(i,j,kb)) & - + (bbb*fac_sub - (one+fac_sub*dqsat)*tabs(i,j,k))*(qpi(i,j,kc)-qpi(i,j,kb)) ) + brunt(i,k) = betdz*(bbb*(hl(i,kc)-hl(i,kb)) & + + (bbb*lstarn - (one+lstarn*dqsat)*tabs(i,k)) & + * (total_water(i,kc)-total_water(i,kb)) & + + (bbb*fac_cond - (one+fac_cond*dqsat)*tabs(i,k))*(qpl(i,kc)-qpl(i,kb)) & + + (bbb*fac_sub - (one+fac_sub*dqsat)*tabs(i,k))*(qpi(i,kc)-qpi(i,kb)) ) - else ! outside of cloud + else ! outside of cloud ! Find outside-of-cloud Brunt-Vaisalla frequency ! Only unsaturated air, rain and snow contribute to virt. pot. temp. ! liquid/ice moist static energy divided by cp? - bbb = one + epsv*qv(i,j,k) - qpl(i,j,k) - qpi(i,j,k) - brunt(i,j,k) = betdz*( bbb*(hl(i,j,kc)-hl(i,j,kb)) & - + epsv*tabs(i,j,k)*(total_water(i,j,kc)-total_water(i,j,kb)) & - + (bbb*fac_cond-tabs(i,j,k))*(qpl(i,j,kc)-qpl(i,j,kb)) & - + (bbb*fac_sub -tabs(i,j,k))*(qpi(i,j,kc)-qpi(i,j,kb)) ) - endif + bbb = one + epsv*qv(i,k) - qpl(i,k) - qpi(i,k) + brunt(i,k) = betdz*( bbb*(hl(i,kc)-hl(i,kb)) & + + epsv*tabs(i,k)*(total_water(i,kc)-total_water(i,kb)) & + + (bbb*fac_cond-tabs(i,k))*(qpl(i,kc)-qpl(i,kb)) & + + (bbb*fac_sub -tabs(i,k))*(qpi(i,kc)-qpi(i,kb)) ) + endif ! Reduction of mixing length in the stable regions (where B.-V. freq. > 0) is required. ! Here we find regions of Brunt-Vaisalla freq. > 0 for later use. - if (brunt(i,j,k) >= zero) then - brunt2(i,j,k) = brunt(i,j,k) - else - brunt2(i,j,k) = zero - endif + if (brunt(i,k) >= zero) then + brunt2(i,k) = brunt(i,k) + else + brunt2(i,k) = zero + endif ! Calculate turbulent length scale in the boundary layer. ! See Eq. 10 in BK13 (Eq. 4.12 in Pete's dissertation) @@ -992,36 +906,34 @@ subroutine eddy_length() ! Keep the length scale adequately small near the surface following Blackadar (1984) ! Note that this is not documented in BK13 and was added later for SP-CAM runs -! if (k == 1) then -! term = 600.*tkes -! smixt(i,j,k) = term + (0.4*zl(i,j,k)-term)*exp(-zl(i,j,k)*0.01) -! else +! if (k == 1) then +! term = 600.*tkes +! smixt(i,k) = term + (0.4*zl(i,k)-term)*exp(-zl(i,k)*0.01) +! else ! tscale is the eddy turnover time scale in the boundary layer and is ! an empirically derived constant - if (tkes > zero .and. l_inf(i,j) > zero) then - wrk1 = one / (tscale*tkes*vonk*zl(i,j,k)) - wrk2 = one / (tscale*tkes*l_inf(i,j)) - wrk1 = wrk1 + wrk2 + pt01 * brunt2(i,j,k) / tke(i,j,k) - wrk1 = sqrt(one / max(wrk1,1.0e-8)) * (one/0.3) -! smixt(i,j,k) = min(max_eddy_length_scale, 2.8284*sqrt(wrk1)/0.3) - smixt(i,j,k) = min(max_eddy_length_scale, wrk1) - -! smixt(i,j,k) = min(max_eddy_length_scale,(2.8284*sqrt(1./((1./(tscale*tkes*vonk*zl(i,j,k))) & -! + (1./(tscale*tkes*l_inf(i,j)))+0.01*(brunt2(i,j,k)/tke(i,j,k)))))/0.3) -! else -! smixt(i,j,k) = zero - endif + if (tkes > zero .and. l_inf(i) > zero) then + wrk1 = one / (tscale*tkes*vonk*zl(i,k)) + wrk2 = one / (tscale*tkes*l_inf(i)) + wrk1 = wrk1 + wrk2 + pt01 * brunt2(i,k) / tke(i,k) + wrk1 = sqrt(one / max(wrk1,1.0d-8)) * (one/0.3d0) +! smixt(i,k) = min(max_eddy_length_scale, 2.8284*sqrt(wrk1)/0.3) + smixt(i,k) = min(max_eddy_length_scale, wrk1) + +! smixt(i,k) = min(max_eddy_length_scale,(2.8284*sqrt(1./((1./(tscale*tkes*vonk*zl(i,k))) & +! + (1./(tscale*tkes*l_inf(i)))+0.01*(brunt2(i,k)/tke(i,k)))))/0.3) +! else +! smixt(i,k) = zero + endif ! endif - enddo enddo enddo - ! Now find the in-cloud turbulence length scale ! See Eq. 13 in BK13 (Eq. 4.18 in Pete's disseration) @@ -1034,83 +946,78 @@ subroutine eddy_length() ! call conv_scale() ! inlining the relevant code -! do j=1,ny -! do i=1,nx -! conv_vel2(i,j,1) = zero ! Convective velocity scale cubed -! enddo +! do i=1,nx +! conv_vel2(i,1) = zero ! Convective velocity scale cubed ! enddo ! Integrate velocity scale in the vertical ! do k=2,nzm -! do j=1,ny -! do i=1,nx -! conv_vel2(i,j,k) = conv_vel2(i,j,k-1) & -! + 2.5*adzi(i,j,k)*bet(i,j,k)*wthv_sec(i,j,k) -! enddo +! do i=1,nx +! conv_vel2(i,k) = conv_vel2(i,k-1) & +! + 2.5*adzi(i,k)*bet(i,k)*wthv_sec(i,k) ! enddo ! enddo - do j=1,ny - do i=1,nx + do i=1,nx - if (cldarr(i,j) == 1) then ! If there's a cloud in this column + if (cldarr(i) == 1) then ! If there's a cloud in this column - kl = 0 - ku = 0 - do k=2,nzm-3 + kl = 0 + ku = 0 + do k=2,nzm-3 -! Look for the cloud base in this column +! Look for the cloud base in this column ! thresh (=0) is a variable local to eddy_length(). Should be a module constant. - wrk = qcl(i,j,k) + qci(i,j,k) - if (wrk > thresh .and. kl == 0) then - kl = k + wrk = qcl(i,k) + qci(i,k) + if (wrk > qcmin) then + if (kl == 0) then + kl = k endif ! Look for the cloud top in this column - if (wrk > thresh .and. qcl(i,j,k+1)+qci(i,j,k+1) <= thresh) then + if (qcl(i,k+1)+qci(i,k+1) <= qcmin) then ku = k ! conv_vel2 (Cubed convective velocity scale) is calculated in conv_scale() -! Use the value of conv_vel2 at the top of the cloud. -! conv_var = conv_vel2(i,j,k)**(oneb3) +! Use the value of conv_vel2 at the top of the cloud. +! conv_var = conv_vel2(i,k)** oneb3 endif + endif ! Compute the mixing length scale for the cloud layer that we just found -! if (kl > 0 .and. ku > 0 .and. ku-kl > 1) then - if (kl > 0 .and. ku > 0 .and. ku-kl > 0) then - +! if (kl > 0 .and. ku > 0 .and. ku-kl > 1) then +! if (kl > 0 .and. ku > 0 .and. ku-kl > 0) then + if (kl > 0 .and. ku >= kl) then ! The calculation below finds the integral in the Eq. 10 in BK13 for the current cloud - conv_var = zero - do kk=kl,ku - conv_var = conv_var+ 2.5*adzi(i,j,kk)*bet(i,j,kk)*wthv_sec(i,j,kk) - enddo - conv_var = conv_var ** oneb3 - - if (conv_var > 0) then ! If convective vertical velocity scale > 0 + conv_var = zero + do kk=kl,ku + conv_var = conv_var+ 2.5d0*adzi(i,kk)*bet(i,kk)*wthv_sec(i,kk) + enddo + conv_var = conv_var ** oneb3 - depth = (zl(i,j,ku)-zl(i,j,kl)) + adzl(i,j,kl) + if (conv_var > 0) then ! If convective vertical velocity scale > 0 + depth = (zl(i,ku)-zl(i,kl)) + adzl(i,kl) - do kk=kl,ku + do kk=kl,ku ! in-cloud turbulence length scale, Eq. 13 in BK13 (Eq. 4.18) -! wrk = conv_var/(depth*sqrt(tke(i,j,kk))) -! wrk = wrk * wrk + pt01*brunt2(i,j,kk)/tke(i,j,kk) +! wrk = conv_var/(depth*sqrt(tke(i,kk))) +! wrk = wrk * wrk + pt01*brunt2(i,kk)/tke(i,kk) - wrk = conv_var/(depth*depth*sqrt(tke(i,j,kk))) & - + pt01*brunt2(i,j,kk)/tke(i,j,kk) + wrk = conv_var/(depth*depth*sqrt(tke(i,kk))) & + + pt01*brunt2(i,kk)/tke(i,kk) - smixt(i,j,kk) = min(max_eddy_length_scale, (one/0.3)*sqrt(one/wrk)) + smixt(i,kk) = min(max_eddy_length_scale, (one/0.3d0)*sqrt(one/wrk)) - enddo + enddo - endif ! If convective vertical velocity scale > 0 - kl = zero - ku = zero - endif ! if inside the cloud layer + endif ! If convective vertical velocity scale > 0 + kl = zero + ku = zero + endif ! if inside the cloud layer - enddo ! k=2,nzm-3 - endif ! if in the cloudy column - enddo ! i=1,nx - enddo ! j=1,ny + enddo ! k=2,nzm-3 + endif ! if in the cloudy column + enddo ! i=1,nx end subroutine eddy_length @@ -1122,7 +1029,7 @@ subroutine conv_scale() ! for the definition of the length scale in clouds ! See Eq. 16 in BK13 (Eq. 4.21 in Pete's dissertation) - integer i, j, k + integer i, k !!!!!!!!! !! A bug in formulation of conv_vel @@ -1130,27 +1037,23 @@ subroutine conv_scale() !!!!!!!!!! ! conv_vel(1)=zero ! Horizontally averaged convective velocity scale cubed - do j=1,ny - do i=1,nx - conv_vel2(i,j,1) = zero ! Convective velocity scale cubed - enddo + do i=1,nx + conv_vel2(i,1) = zero ! Convective velocity scale cubed enddo ! Integrate velocity scale in the vertical do k=2,nzm ! conv_vel(k)=conv_vel(k-1) - do j=1,ny - do i=1,nx + do i=1,nx !********************************************************************** !Do not include grid-scale contribution to convective velocity scale in GCM applications -! conv_vel(k)=conv_vel(k-1)+2.5*adzi(k)*bet(k)*(tvwle(k)+tvws(k)) -! conv_vel(k)=conv_vel(k)+2.5*adzi(i,j,k)*bet(i,j,k)*(tvws(k)) +! conv_vel(k)=conv_vel(k-1)+2.5*adzi(k)*bet(k)*(tvwle(k)+tvws(k)) +! conv_vel(k)=conv_vel(k)+2.5*adzi(i,k)*bet(i,k)*(tvws(k)) !Do not include grid-scale contribution to convective velocity scale in GCM applications -! conv_vel2(i,j,k)=conv_vel2(i,j,k-1)+2.5*adzi(k)*bet(k)*(tvwle(k)+wthv_sec(i,j,k)) +! conv_vel2(i,k)=conv_vel2(i,k-1)+2.5*adzi(k)*bet(k)*(tvwle(k)+wthv_sec(i,k)) !********************************************************************** - conv_vel2(i,j,k) = conv_vel2(i,j,k-1) & - + 2.5*adzi(i,j,k)*bet(i,j,k)*wthv_sec(i,j,k) - enddo + conv_vel2(i,k) = conv_vel2(i,k-1) & + + 2.5*adzi(i,k)*bet(i,k)*wthv_sec(i,k) enddo enddo @@ -1161,7 +1064,7 @@ subroutine check_eddy() ! This subroutine checks eddy length values - integer i, j, k, kb, ks, zend + integer i, k, kb, ks, zend real wrk ! real zstart, zthresh, qthresh @@ -1179,25 +1082,23 @@ subroutine check_eddy() kb = k+1 endif - do j=1,ny - do i=1,nx + do i=1,nx - wrk = 0.1*adzl(i,j,k) + wrk = 0.1*adzl(i,k) ! Minimum 0.1 of local dz - smixt(i,j,k) = max(wrk, min(max_eddy_length_scale,smixt(i,j,k))) + smixt(i,k) = max(wrk, min(max_eddy_length_scale,smixt(i,k))) -! If chracteristic grid dimension in the horizontal< 1000m, set lengthscale to +! If chracteristic grid dimension in the horizontal< 1000m, set lengthscale to ! be not larger that that. -! if (sqrt(dx*dy) .le. 1000.) smixt(i,j,k)=min(sqrt(dx*dy),smixt(i,j,k)) +! if (sqrt(dx*dy) .le. 1000.) smixt(i,k)=min(sqrt(dx*dy),smixt(i,k)) - if (qcl(i,j,kb) == 0 .and. qcl(i,j,k) > 0 .and. brunt(i,j,k) > 1.e-4) then + if (qcl(i,kb) == 0 .and. qcl(i,k) > 0 .and. brunt(i,k) > 1.0d-4) then !If just above the cloud top and atmosphere is stable, set to 0.1 of local dz - smixt(i,j,k) = wrk - endif + smixt(i,k) = wrk + endif - enddo ! i - enddo ! j - enddo ! k + enddo ! i + enddo ! k end subroutine check_eddy @@ -1209,7 +1110,7 @@ subroutine canuto() ! Result is returned in a global variable w3 defined at the interface levels. ! Local variables - integer i, j, k, kb, kc + integer i, k, kb, kc real bet2, f0, f1, f2, f3, f4, f5, iso, isosqr, & omega0, omega1, omega2, X0, Y0, X1, Y1, AA0, AA1, buoy_sgs2, & @@ -1217,10 +1118,10 @@ subroutine canuto() ! cond, wrk, wrk1, wrk2, wrk3, avew ! ! See Eq. 7 in C01 (B.7 in Pete's dissertation) - real, parameter :: c=7.0, a0=0.52/(c*c*(c-2.)), a1=0.87/(c*c), & - a2=0.5/c, a3=0.6/(c*(c-2.)), a4=2.4/(3.*c+5.), & - a5=0.6/(c*(3.*c+5)) -!Moorthi a5=0.6/(c*(3.+5.*c)) + real, parameter :: c=7.0d0, a0=0.52d0/(c*c*(c-2.0d0)), a1=0.87d0/(c*c), & + a2=0.5d0/c, a3=0.6d0/(c*(c-2.0d0)), a4=2.4d0/(3.0d0*c+5.0d0), & + a5=0.6d0/(c*(3.0d0*c+5.0d0)) +!Moorthi a5=0.6d0/(c*(3.0d0+5.0d0*c)) ! do k=1,nzm do k=2,nzm @@ -1231,51 +1132,43 @@ subroutine canuto() ! if(k == 1) then ! kb = 1 ! kc = 2 -! do j=1,ny -! do i=1,nx -! thedz(i,j) = one / adzl(i,j,kc) -! thedz2(i,j) = thedz(i,j) -! enddo +! do i=1,nx +! thedz(i) = one / adzl(i,kc) +! thedz2(i) = thedz(i) ! enddo ! elseif(k == nzm) then - if (k == nzm) then + if(k == nzm) then kb = nzm-1 kc = nzm - do j=1,ny - do i=1,nx - thedz(i,j) = one / adzi(i,j,k) - thedz2(i,j) = one / adzl(i,j,kb) - enddo + do i=1,nx + thedz(i) = one / adzi(i,k) + thedz2(i) = one / adzl(i,kb) enddo else - do j=1,ny - do i=1,nx - thedz(i,j) = one / adzi(i,j,k) - thedz2(i,j) = one / (adzl(i,j,k)+adzl(i,j,kb)) - enddo + do i=1,nx + thedz(i) = one / adzi(i,k) + thedz2(i) = one / (adzl(i,k)+adzl(i,kb)) enddo endif + do i=1,nx - do j=1,ny - do i=1,nx - - iso = half*(isotropy(i,j,k)+isotropy(i,j,kb)) - isosqr = iso*iso ! Two-level average of "return-to-isotropy" time scale squared - buoy_sgs2 = isosqr*half*(brunt(i,j,k)+brunt(i,j,kb)) - bet2 = half*(bet(i,j,k)+bet(i,j,kb)) !Two-level average of BV frequency squared + iso = half*(isotropy(i,k)+isotropy(i,kb)) + isosqr = iso*iso ! Two-level average of "return-to-isotropy" time scale squared + buoy_sgs2 = isosqr*half*(brunt(i,k)+brunt(i,kb)) + bet2 = half*(bet(i,k)+bet(i,kb)) !Two-level average of BV frequency squared ! Compute functions f0-f5, see Eq, 8 in C01 (B.8 in Pete's dissertation) - avew = half*(w_sec(i,j,k)+w_sec(i,j,kb)) + avew = half*(w_sec(i,k)+w_sec(i,kb)) + !aab ! - wrk1 = bet2*iso - wrk2 = thedz2(i,j)*wrk1*wrk1*iso - wrk3 = thl_sec(i,j,kc) - thl_sec(i,j,kb) - f0 = wrk2 * wrk1 * wthl_sec(i,j,k) * wrk3 + wrk1 = bet2*iso + wrk2 = thedz2(i)*wrk1*wrk1*iso + wrk3 = thl_sec(i,kc) - thl_sec(i,kb) - wrk = wthl_sec(i,j,kc) - wthl_sec(i,j,kb) + f0 = wrk2 * wrk1 * wthl_sec(i,k) * wrk3 - f1 = wrk2 * (wrk*wthl_sec(i,j,k) + half*avew*wrk3) + wrk = wthl_sec(i,kc) - wthl_sec(i,kb) - wrk1 = bet2*isosqr - f2 = thedz(i,j)*wrk1*wthl_sec(i,j,k)*(w_sec(i,j,k)-w_sec(i,j,kb)) & - + (thedz2(i,j)+thedz2(i,j))*bet(i,j,k)*isosqr*wrk + f1 = wrk2 * (wrk*wthl_sec(i,k) + half*avew*wrk3) - f3 = thedz2(i,j)*wrk1*wrk + thedz(i,j)*bet2*isosqr*(wthl_sec(i,j,k)*(tke(i,j,k)-tke(i,j,kb))) + wrk1 = bet2*isosqr + f2 = thedz(i)*wrk1*wthl_sec(i,k)*(w_sec(i,k)-w_sec(i,kb)) & + + (thedz2(i)+thedz2(i))*bet(i,k)*isosqr*wrk - wrk1 = thedz(i,j)*iso*avew - f4 = wrk1*(w_sec(i,j,k)-w_sec(i,j,kb) + tke(i,j,k)-tke(i,j,kb)) + f3 = thedz2(i)*wrk1*wrk + thedz(i)*bet2*isosqr*(wthl_sec(i,k)*(tke(i,k)-tke(i,kb))) - f5 = wrk1*(w_sec(i,j,k)-w_sec(i,j,kb)) + wrk1 = thedz(i)*iso*avew + f4 = wrk1*(w_sec(i,k)-w_sec(i,kb) + tke(i,k)-tke(i,kb)) + + f5 = wrk1*(w_sec(i,k)-w_sec(i,kb)) ! Compute the "omega" terms, see Eq. 6 in C01 (B.6 in Pete's dissertation) - omega0 = a4 / (one-a5*buoy_sgs2) - omega1 = omega0 / (c+c) - omega2 = omega1*f3+(5./4.)*omega0*f4 + omega0 = a4 / (one-a5*buoy_sgs2) + omega1 = omega0 / (c+c) + omega2 = omega1*f3+(5./4.)*omega0*f4 ! Compute the X0, Y0, X1, Y1 terms, see Eq. 5 a-b in C01 (B.5 in Pete's dissertation) - wrk1 = one / (one-(a1+a3)*buoy_sgs2) - wrk2 = one / (one-a3*buoy_sgs2) - X0 = wrk1 * (a2*buoy_sgs2*(one-a3*buoy_sgs2)) - Y0 = wrk2 * (two*a2*buoy_sgs2*X0) - X1 = wrk1 * (a0*f0+a1*f1+a2*(one-a3*buoy_sgs2)*f2) - Y1 = wrk2 * (two*a2*(buoy_sgs2*X1+(a0/a1)*f0+f1)) + wrk1 = one / (one-(a1+a3)*buoy_sgs2) + wrk2 = one / (one-a3*buoy_sgs2) + X0 = wrk1 * (a2*buoy_sgs2*(one-a3*buoy_sgs2)) + Y0 = wrk2 * (two*a2*buoy_sgs2*X0) + X1 = wrk1 * (a0*f0+a1*f1+a2*(one-a3*buoy_sgs2)*f2) + Y1 = wrk2 * (two*a2*(buoy_sgs2*X1+(a0/a1)*f0+f1)) ! Compute the A0, A1 terms, see Eq. 5d in C01 (B.5 in Pete's dissertation) - AA0 = omega0*X0 + omega1*Y0 - AA1 = omega0*X1 + omega1*Y1 + omega2 + AA0 = omega0*X0 + omega1*Y0 + AA1 = omega0*X1 + omega1*Y1 + omega2 ! Finally, we have the third moment of w, see Eq. 4c in C01 (B.4 in Pete's dissertation) -! cond is an estimate of third moment from second oment - If the third moment is larger +! cond_w is an estimate of third moment from second oment - If the third moment is larger ! than the estimate - limit w3. !aab ! Implemetation of the C01 approach in this subroutine is nearly complete ! (the missing part are Eqs. 5c and 5e which are very simple) -! therefore it's easy to diagnose other third order moments obtained in C01 using this code. +! therefore it's easy to diagnose other third order moments obtained in C01 using this code. - enddo enddo enddo - do j=1,ny - do i=1,nx - w3(i,j,1) = w3(i,j,2) - enddo + do i=1,nx + w3(i,1) = w3(i,2) enddo end subroutine canuto @@ -1370,7 +1261,7 @@ subroutine assumed_pdf() ! Local variables - integer i,j,k,ku,kd + integer i,k,ku,kd real wrk, wrk1, wrk2, wrk3, wrk4, bastoeps, eps_ss1, eps_ss2, cond_w ! bastoeps = basetemp / epsterm @@ -1388,477 +1279,441 @@ subroutine assumed_pdf() ku = k + 1 ! if (k == nzm) ku = k - DO j=1,ny - DO i=1,nx + DO i=1,nx ! Initialize cloud variables to zero - diag_qn = zero - diag_frac = zero - diag_ql = zero - diag_qi = zero + diag_qn = zero + diag_frac = zero + diag_ql = zero + diag_qi = zero - pval = prsl(i,j,k) - pfac = pval * 1.0e-5 - pkap = pfac ** kapa + pval = prsl(i,k) + pfac = pval * 1.0d-5 + pkap = pfac ** kapa -! Read in liquid/ice static energy, total water mixing ratio, +! Read in liquid/ice static energy, total water mixing ratio, ! and vertical velocity to variables PDF needs - - thl_first = hl(i,j,k) + fac_cond*qpl(i,j,k) & - + fac_sub*qpi(i,j,k) - - qw_first = total_water(i,j,k) -! w_first = half*(w(i,j,kd)+w(i,j,ku)) - w_first = w(i,j,k) + thl_first = hl(i,k) + fac_cond*qpl(i,k) + fac_sub*qpi(i,k) + qw_first = total_water(i,k) +! w_first = half*(w(i,kd)+w(i,ku)) + w_first = w(i,k) ! GET ALL INPUT VARIABLES ON THE SAME GRID ! Points to be computed with relation to thermo point ! Read in points that need to be averaged - if (k < nzm) then - w3var = half*(w3(i,j,kd)+w3(i,j,ku)) - thlsec = max(zero, half*(thl_sec(i,j,kd)+thl_sec(i,j,ku)) ) - qwsec = max(zero, half*(qw_sec(i,j,kd)+qw_sec(i,j,ku)) ) - qwthlsec = half * (qwthl_sec(i,j,kd) + qwthl_sec(i,j,ku)) - wqwsec = half * (wqw_sec(i,j,kd) + wqw_sec(i,j,ku)) - wthlsec = half * (wthl_sec(i,j,kd) + wthl_sec(i,j,ku)) - else ! at the model top assuming zeros - w3var = half*w3(i,j,k) - thlsec = max(zero, half*thl_sec(i,j,k)) - qwsec = max(zero, half*qw_sec(i,j,k)) - qwthlsec = half * qwthl_sec(i,j,k) - wqwsec = half * wqw_sec(i,j,k) - wthlsec = half * wthl_sec(i,j,k) - endif + if (k < nzm) then + w3var = half*(w3(i,kd)+w3(i,ku)) + thlsec = max(zero, half*(thl_sec(i,kd)+thl_sec(i,ku)) ) + qwsec = max(zero, half*(qw_sec(i,kd)+qw_sec(i,ku)) ) + qwthlsec = half * (qwthl_sec(i,kd) + qwthl_sec(i,ku)) + wqwsec = half * (wqw_sec(i,kd) + wqw_sec(i,ku)) + wthlsec = half * (wthl_sec(i,kd) + wthl_sec(i,ku)) + else ! at the model top assuming zeros + w3var = half*w3(i,k) + thlsec = max(zero, half*thl_sec(i,k)) + qwsec = max(zero, half*qw_sec(i,k)) + qwthlsec = half * qwthl_sec(i,k) + wqwsec = half * wqw_sec(i,k) + wthlsec = half * wthl_sec(i,k) + endif -! w3var = w3(i,j,k) -! thlsec = max(zero,thl_sec(i,j,k)) -! qwsec = max(zero,qw_sec(i,j,k)) -! qwthlsec = qwthl_sec(i,j,k) -! wqwsec = wqw_sec(i,j,k) -! wthlsec = wthl_sec(i,j,k) +! w3var = w3(i,k) +! thlsec = max(zero,thl_sec(i,k)) +! qwsec = max(zero,qw_sec(i,k)) +! qwthlsec = qwthl_sec(i,k) +! wqwsec = wqw_sec(i,k) +! wthlsec = wthl_sec(i,k) ! Compute square roots of some variables so we don't have to do it again -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' w_sec=',w_sec(i,j,k),' k=',k - if (w_sec(i,j,k) > zero) then - sqrtw2 = sqrt(w_sec(i,j,k)) - else - sqrtw2 = zero - endif - if (thlsec > zero) then - sqrtthl = sqrt(thlsec) - else - sqrtthl = zero - endif - if (qwsec > zero) then - sqrtqt = sqrt(qwsec) - else - sqrtqt = zero - endif + if (w_sec(i,k) > zero) then + sqrtw2 = sqrt(w_sec(i,k)) + else + sqrtw2 = zero + endif + if (thlsec > zero) then + sqrtthl = sqrt(thlsec) + else + sqrtthl = zero + endif + if (qwsec > zero) then + sqrtqt = sqrt(qwsec) + else + sqrtqt = zero + endif ! Find parameters of the double Gaussian PDF of vertical velocity ! Skewness of vertical velocity -! Skew_w = w3var / w_sec(i,j,k)**(3./2.) -! Skew_w = w3var / (sqrtw2*sqrtw2*sqrtw2) ! Moorthi - - IF (w_sec(i,j,k) <= w_tol_sqd) THEN ! If variance of w is too small then - ! PDF is a sum of two delta functions - Skew_w = zero - w1_1 = w_first - w1_2 = w_first - w2_1 = zero - w2_2 = zero - aterm = half - onema = half - ELSE - +! Skew_w = w3var / w_sec(i,k)**(3./2.) +! Skew_w = w3var / (sqrtw2*sqrtw2*sqrtw2) ! Moorthi + + IF (w_sec(i,k) <= w_tol_sqd) THEN ! If variance of w is too small then + ! PDF is a sum of two delta functions + Skew_w = zero + w1_1 = w_first + w1_2 = w_first + w2_1 = zero + w2_2 = zero + aterm = half + onema = half + ELSE !aab - - Skew_w = w3var / (sqrtw2*sqrtw2*sqrtw2) ! Moorthi -! Proportionality coefficients between widths of each vertical velocity + + Skew_w = w3var / (sqrtw2*sqrtw2*sqrtw2) ! Moorthi +! Proportionality coefficients between widths of each vertical velocity ! gaussian and the sqrt of the second moment of w - w2_1 = 0.4 - w2_2 = 0.4 + w2_1 = 0.4 + w2_2 = 0.4 -! Compute realtive weight of the first PDF "plume" +! Compute realtive weight of the first PDF "plume" ! See Eq A4 in Pete's dissertaion - Ensure 0.01 < a < 0.99 - wrk = one - w2_1 - aterm = max(atmin,min(half*(one-Skew_w*sqrt(one/(4.*wrk*wrk*wrk+Skew_w*Skew_w))),atmax)) - onema = one - aterm + wrk = one - w2_1 + aterm = max(atmin,min(half*(one-Skew_w*sqrt(one/(4.*wrk*wrk*wrk+Skew_w*Skew_w))),atmax)) + onema = one - aterm - sqrtw2t = sqrt(wrk) + sqrtw2t = sqrt(wrk) ! Eq. A.5-A.6 - wrk = sqrt(onema/aterm) - w1_1 = sqrtw2t * wrk - w1_2 = - sqrtw2t / wrk + wrk = sqrt(onema/aterm) + w1_1 = sqrtw2t * wrk + w1_2 = - sqrtw2t / wrk - w2_1 = w2_1 * w_sec(i,j,k) - w2_2 = w2_2 * w_sec(i,j,k) + w2_1 = w2_1 * w_sec(i,k) + w2_2 = w2_2 * w_sec(i,k) - ENDIF + ENDIF ! Find parameters of the PDF of liquid/ice static energy -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' thlsec=',thlsec,' w1_2=',w1_2,' w1_1=',w1_1,& -! ' thl_first=',thl_first,' k=',k,' wthlsec=',wthlsec,sqrtw2,sqrtthl - IF (thlsec <= thl_tol*thl_tol .or. abs(w1_2-w1_1) <= w_thresh) THEN - thl1_1 = thl_first - thl1_2 = thl_first - thl2_1 = zero - thl2_2 = zero - sqrtthl2_1 = zero - sqrtthl2_2 = zero - ELSE - - corrtest1 = max(-one,min(one,wthlsec/(sqrtw2*sqrtthl))) - - thl1_1 = -corrtest1 / w1_2 ! A.7 - thl1_2 = -corrtest1 / w1_1 ! A.8 - - wrk1 = thl1_1 * thl1_1 - wrk2 = thl1_2 * thl1_2 - wrk3 = three * (one - aterm*wrk1 - onema*wrk2) - wrk4 = -skew_facw*Skew_w - aterm*wrk1*thl1_1 - onema*wrk2*thl1_2 ! testing - Moorthi -! wrk4 = -skew_fact*Skew_w - aterm*wrk1*thl1_1 - onema*wrk2*thl1_2 ! testing - Moorthi -! wrk4 = - aterm*wrk1*thl1_1 - onema*wrk2*thl1_2 - wrk = three * (thl1_2-thl1_1) - if (wrk /= zero) then - thl2_1 = thlsec * min(100.,max(zero,( thl1_2*wrk3-wrk4)/(aterm*wrk))) ! A.10 - thl2_2 = thlsec * min(100.,max(zero,(-thl1_1*wrk3+wrk4)/(onema*wrk))) ! A.11 - else - thl2_1 = zero - thl2_2 = zero - endif + IF (thlsec <= thl_tol*thl_tol .or. abs(w1_2-w1_1) <= w_thresh) THEN + thl1_1 = thl_first + thl1_2 = thl_first + thl2_1 = zero + thl2_2 = zero + sqrtthl2_1 = zero + sqrtthl2_2 = zero + ELSE + + corrtest1 = max(-one,min(one,wthlsec/(sqrtw2*sqrtthl))) + + thl1_1 = -corrtest1 / w1_2 ! A.7 + thl1_2 = -corrtest1 / w1_1 ! A.8 + + wrk1 = thl1_1 * thl1_1 + wrk2 = thl1_2 * thl1_2 + wrk3 = three * (one - aterm*wrk1 - onema*wrk2) + wrk4 = -skew_facw*Skew_w - aterm*wrk1*thl1_1 - onema*wrk2*thl1_2 ! testing - Moorthi +! wrk4 = -skew_fact*Skew_w - aterm*wrk1*thl1_1 - onema*wrk2*thl1_2 ! testing - Moorthi +! wrk4 = - aterm*wrk1*thl1_1 - onema*wrk2*thl1_2 + wrk = three * (thl1_2-thl1_1) + if (wrk /= zero) then + thl2_1 = thlsec * min(100.0d0,max(zero,(thl1_2*wrk3-wrk4)/(aterm*wrk))) ! A.10 + thl2_2 = thlsec * min(100.0d0,max(zero,(-thl1_1*wrk3+wrk4)/(onema*wrk))) ! A.11 + else + thl2_1 = zero + thl2_2 = zero + endif ! -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' thl1_1=',thl1_1,' sqrtthl=',sqrtthl,' thl_first=',thl_first,& -! ' thl1_2=',thl1_2,' corrtest1=',corrtest1,' w1_2=',w1_2,' w1_1=',w1_1 - - thl1_1 = thl1_1*sqrtthl + thl_first - thl1_2 = thl1_2*sqrtthl + thl_first + thl1_1 = thl1_1*sqrtthl + thl_first + thl1_2 = thl1_2*sqrtthl + thl_first -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' thl1_1=',thl1_1,' thl1_2=',thl1_2 + sqrtthl2_1 = sqrt(thl2_1) + sqrtthl2_2 = sqrt(thl2_2) - sqrtthl2_1 = sqrt(thl2_1) - sqrtthl2_2 = sqrt(thl2_2) - - ENDIF + ENDIF ! FIND PARAMETERS FOR TOTAL WATER MIXING RATIO - IF (qwsec <= rt_tol*rt_tol .or. abs(w1_2-w1_1) <= w_thresh) THEN - qw1_1 = qw_first - qw1_2 = qw_first - qw2_1 = zero - qw2_2 = zero - sqrtqw2_1 = zero - sqrtqw2_2 = zero - ELSE + IF (qwsec <= rt_tol*rt_tol .or. abs(w1_2-w1_1) <= w_thresh) THEN + qw1_1 = qw_first + qw1_2 = qw_first + qw2_1 = zero + qw2_2 = zero + sqrtqw2_1 = zero + sqrtqw2_2 = zero + ELSE - corrtest2 = max(-one,min(one,wqwsec/(sqrtw2*sqrtqt))) + corrtest2 = max(-one,min(one,wqwsec/(sqrtw2*sqrtqt))) - qw1_1 = - corrtest2 / w1_2 ! A.7 - qw1_2 = - corrtest2 / w1_1 ! A.8 + qw1_1 = - corrtest2 / w1_2 ! A.7 + qw1_2 = - corrtest2 / w1_1 ! A.8 - tsign = abs(qw1_2-qw1_1) + tsign = abs(qw1_2-qw1_1) -! Skew_qw = skew_facw*Skew_w +! Skew_qw = skew_facw*Skew_w - IF (tsign > 0.4) THEN - Skew_qw = skew_facw*Skew_w - ELSEIF (tsign <= 0.2) THEN - Skew_qw = zero - ELSE - Skew_qw = (skew_facw/0.2) * Skew_w * (tsign-0.2) - ENDIF + IF (tsign > 0.4) THEN + Skew_qw = skew_facw*Skew_w + ELSEIF (tsign <= 0.2) THEN + Skew_qw = zero + ELSE + Skew_qw = (skew_facw/0.2) * Skew_w * (tsign-0.2) + ENDIF - wrk1 = qw1_1 * qw1_1 - wrk2 = qw1_2 * qw1_2 - wrk3 = three * (one - aterm*wrk1 - onema*wrk2) - wrk4 = Skew_qw - aterm*wrk1*qw1_1 - onema*wrk2*qw1_2 - wrk = three * (qw1_2-qw1_1) + wrk1 = qw1_1 * qw1_1 + wrk2 = qw1_2 * qw1_2 + wrk3 = three * (one - aterm*wrk1 - onema*wrk2) + wrk4 = Skew_qw - aterm*wrk1*qw1_1 - onema*wrk2*qw1_2 + wrk = three * (qw1_2-qw1_1) - if (wrk /= zero) then - qw2_1 = qwsec * min(100.,max(zero,( qw1_2*wrk3-wrk4)/(aterm*wrk))) ! A.10 - qw2_2 = qwsec * min(100.,max(zero,(-qw1_1*wrk3+wrk4)/(onema*wrk))) ! A.11 - else - qw2_1 = zero - qw2_2 = zero - endif + if (wrk /= zero) then + qw2_1 = qwsec * min(100.0d0,max(zero,( qw1_2*wrk3-wrk4)/(aterm*wrk))) ! A.10 + qw2_2 = qwsec * min(100.0d0,max(zero,(-qw1_1*wrk3+wrk4)/(onema*wrk))) ! A.11 + else + qw2_1 = zero + qw2_2 = zero + endif ! - qw1_1 = qw1_1*sqrtqt + qw_first - qw1_2 = qw1_2*sqrtqt + qw_first + qw1_1 = qw1_1*sqrtqt + qw_first + qw1_2 = qw1_2*sqrtqt + qw_first - sqrtqw2_1 = sqrt(qw2_1) - sqrtqw2_2 = sqrt(qw2_2) + sqrtqw2_1 = sqrt(qw2_1) + sqrtqw2_2 = sqrt(qw2_2) - ENDIF + ENDIF ! CONVERT FROM TILDA VARIABLES TO "REAL" VARIABLES - w1_1 = w1_1*sqrtw2 + w_first - w1_2 = w1_2*sqrtw2 + w_first + w1_1 = w1_1*sqrtw2 + w_first + w1_2 = w1_2*sqrtw2 + w_first -! FIND WITHIN-PLUME CORRELATIONS +! FIND WITHIN-PLUME CORRELATIONS - testvar = aterm*sqrtqw2_1*sqrtthl2_1 + onema*sqrtqw2_2*sqrtthl2_2 + testvar = aterm*sqrtqw2_1*sqrtthl2_1 + onema*sqrtqw2_2*sqrtthl2_2 - IF (testvar == 0) THEN - r_qwthl_1 = zero - ELSE - r_qwthl_1 = max(-one,min(one,(qwthlsec-aterm*(qw1_1-qw_first)*(thl1_1-thl_first) & - -onema*(qw1_2-qw_first)*(thl1_2-thl_first))/testvar)) ! A.12 - ENDIF + IF (testvar == 0) THEN + r_qwthl_1 = zero + ELSE + r_qwthl_1 = max(-one,min(one,(qwthlsec-aterm*(qw1_1-qw_first)*(thl1_1-thl_first) & + -onema*(qw1_2-qw_first)*(thl1_2-thl_first))/testvar)) ! A.12 + ENDIF ! BEGIN TO COMPUTE CLOUD PROPERTY STATISTICS -! wrk1 = gamaz(i,j,k) - fac_cond * qpl(i,j,k) - fac_sub * qpi(i,j,k) -! Tl1_1 = thl1_1 - wrk1 -! Tl1_2 = thl1_2 - wrk1 +! wrk1 = gamaz(i,k) - fac_cond*qpl(i,k) - fac_sub*qpi(i,k) +! Tl1_1 = thl1_1 - wrk1 +! Tl1_2 = thl1_2 - wrk1 - Tl1_1 = thl1_1 - gamaz(i,j,k) - Tl1_2 = thl1_2 - gamaz(i,j,k) - -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' Tl1_1=',Tl1_1,' Tl1_2=',Tl1_2,& -! ' wrk1=',wrk1,' thl1_1=',thl1_1,' thl1_2=',thl1_2,' qpl=',qpl(i,j,k),' qpi=',qpi(i,j,k) + Tl1_1 = thl1_1 - gamaz(i,k) + Tl1_2 = thl1_2 - gamaz(i,k) ! Now compute qs - esval1_1 = zero - esval2_1 = zero - eps_ss1 = eps - eps_ss2 = eps - om1 = one - ! Partition based on temperature for the first plume - IF (Tl1_1 >= tbgmax) THEN - esval1_1 = min(fpvsl(Tl1_1), pval) -! esval1_1 = esatw(Tl1_1) - lstarn1 = lcond - ELSE IF (Tl1_1 <= tbgmin) THEN - esval1_1 = min(fpvsi(Tl1_1), pval) -! esval1_1 = esati(Tl1_1) - lstarn1 = lsub - eps_ss1 = eps * supice - ELSE - esval1_1 = min(fpvsl(Tl1_1), pval) - esval2_1 = min(fpvsi(Tl1_1), pval) -! esval1_1 = esatw(Tl1_1) -! esval2_1 = esati(Tl1_1) - om1 = max(zero, min(one, a_bg*(Tl1_1-tbgmin))) - lstarn1 = lcond + (one-om1)*lfus - eps_ss2 = eps * supice - - ENDIF - qs1 = om1 * eps_ss1*esval1_1/(pval-0.378*esval1_1) & - + (one-om1) * eps_ss2*esval2_1/(pval-0.378*esval2_1) - -! beta1 = (rgas/rv)*(lstarn1/(rgas*Tl1_1))*(lstarn1/(cp*Tl1_1)) - beta1 = (lstarn1*lstarn1*onebrvcp) / (Tl1_1*Tl1_1) ! A.18 + IF (Tl1_1 >= tbgmax) THEN + lstarn1 = lcond + esval = min(fpvsl(Tl1_1), pval) + qs1 = eps * esval / (pval-0.378d0*esval) + ELSE IF (Tl1_1 <= tbgmin) THEN + lstarn1 = lsub + esval = min(fpvsi(Tl1_1), pval) + qs1 = epss * esval / (pval-0.378d0*esval) + ELSE + om1 = max(zero, min(one, a_bg*(Tl1_1-tbgmin))) + lstarn1 = lcond + (one-om1)*lfus + esval = min(fpvsl(Tl1_1), pval) + esval2 = min(fpvsi(Tl1_1), pval) + qs1 = om1 * eps * esval / (pval-0.378d0*esval) & + + (one-om1) * epss * esval2 / (pval-0.378d0*esval2) + ENDIF + +! beta1 = (rgas/rv)*(lstarn1/(rgas*Tl1_1))*(lstarn1/(cp*Tl1_1)) +! beta1 = (lstarn1*lstarn1*onebrvcp) / (Tl1_1*Tl1_1) ! A.18 + + beta1 = lstarn1 / Tl1_1 + beta1 = beta1 * beta1 * onebrvcp ! Are the two plumes equal? If so then set qs and beta ! in each column to each other to save computation - IF (Tl1_1 == Tl1_2) THEN - qs2 = qs1 - beta2 = beta1 + IF (Tl1_1 == Tl1_2) THEN + qs2 = qs1 + beta2 = beta1 + ELSE + IF (Tl1_2 >= tbgmax) THEN + lstarn2 = lcond + esval = min(fpvsl(Tl1_2), pval) + qs2 = eps * esval / (pval-0.378d0*esval) + ELSE IF (Tl1_2 <= tbgmin) THEN + lstarn2 = lsub + esval = min(fpvsi(Tl1_2), pval) + qs2 = epss * esval / (pval-0.378d0*esval) ELSE - - esval1_2 = zero - esval2_2 = zero - eps_ss1 = eps - eps_ss2 = eps - om2 = one - - IF (Tl1_2 >= tbgmax) THEN - esval1_2 = min(fpvsl(Tl1_2), pval) -! esval1_2 = esatw(Tl1_2) - lstarn2 = lcond - ELSE IF (Tl1_2 <= tbgmin) THEN - esval1_2 = min(fpvsi(Tl1_2), pval) -! esval1_2 = esati(Tl1_2) - lstarn2 = lsub - eps_ss1 = eps * supice - ELSE - esval1_2 = min(fpvsl(Tl1_2), pval) - esval2_2 = min(fpvsi(Tl1_2), pval) -! esval1_2 = esatw(Tl1_2) -! esval2_2 = esati(Tl1_2) - om2 = max(zero, min(one, a_bg*(Tl1_2-tbgmin))) - lstarn2 = lcond + (one-om2)*lfus - eps_ss2 = eps * supice - ENDIF - - qs2 = om2 * eps_ss1*esval1_2/(pval-0.378*esval1_2) & - + (one-om2) * eps_ss2*esval2_2/(pval-0.378*esval2_2) - -! beta2 = (rgas/rv)*(lstarn2/(rgas*Tl1_2))*(lstarn2/(cp*Tl1_2)) ! A.18 - beta2 = (lstarn2*lstarn2*onebrvcp) / (Tl1_2*Tl1_2) ! A.18 - + om2 = max(zero, min(one, a_bg*(Tl1_2-tbgmin))) + lstarn2 = lcond + (one-om2)*lfus + esval = min(fpvsl(Tl1_2), pval) + esval2 = min(fpvsi(Tl1_2), pval) + qs2 = om2 * eps * esval / (pval-0.378d0*esval) & + + (one-om2) * epss * esval2 / (pval-0.378d0*esval2) ENDIF - qs1 = qs1 * rhc(i,j,k) - qs2 = qs2 * rhc(i,j,k) +! beta2 = (rgas/rv)*(lstarn2/(rgas*Tl1_2))*(lstarn2/(cp*Tl1_2)) ! A.18 +! beta2 = (lstarn2*lstarn2*onebrvcp) / (Tl1_2*Tl1_2) ! A.18 -! Now compute cloud stuff - compute s term + beta2 = lstarn2 / Tl1_2 + beta2 = beta2 * beta2 * onebrvcp - cqt1 = one / (one+beta1*qs1) ! A.19 - wrk = qs1 * (one+beta1*qw1_1) * cqt1 - s1 = qw1_1 - wrk ! A.17 - cthl1 = cqt1*wrk*cpolv*beta1*pkap ! A.20 - wrk1 = cthl1 * cthl1 - wrk2 = cqt1 * cqt1 -! std_s1 = sqrt(max(zero,wrk1*thl2_1+wrk2*qw2_1-2.*cthl1*sqrtthl2_1*cqt1*sqrtqw2_1*r_qwthl_1)) - std_s1 = sqrt(max(zero, wrk1*thl2_1+wrk2*qw2_1 & - - two*cthl1*sqrtthl2_1*cqt1*sqrtqw2_1*r_qwthl_1)) + ENDIF - qn1 = zero - C1 = zero + qs1 = qs1 * rhc(i,k) + qs2 = qs2 * rhc(i,k) - IF (std_s1 > zero) THEN - wrk = s1 / (std_s1*sqrt2) - C1 = max(zero, min(one, half*(one+erf(wrk)))) ! A.15 +! Now compute cloud stuff - compute s term -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' in shoc wrk=',wrk,' s1=','std=',std_s1,& -! ' c1=',c1*100,' qs1=',qs1,' qw1_1=',qw1_1,' k=',k + cqt1 = one / (one+beta1*qs1) ! A.19 + wrk = qs1 * (one+beta1*qw1_1) * cqt1 + s1 = qw1_1 - wrk ! A.17 + cthl1 = cqt1*wrk*cpolv*beta1*pkap ! A.20 -! IF (C1 > zero) qn1 = s1*C1 + (std_s1*sqrtpii)*exp(-wrk*wrk) ! A.16 - qn1 = max(zero, s1*C1 + (std_s1*sqrtpii)*exp(-wrk*wrk)) ! A.16 - ELSEIF (s1 > zero) THEN - C1 = one - qn1 = s1 - ENDIF + wrk1 = cthl1 * cthl1 + wrk2 = cqt1 * cqt1 +! std_s1 = sqrt(max(zero,wrk1*thl2_1+wrk2*qw2_1-2.*cthl1*sqrtthl2_1*cqt1*sqrtqw2_1*r_qwthl_1)) + std_s1 = sqrt(max(zero, wrk1*thl2_1+wrk2*qw2_1 & + - two*cthl1*sqrtthl2_1*cqt1*sqrtqw2_1*r_qwthl_1)) -! now compute non-precipitating cloud condensate + qn1 = zero + C1 = zero -! If two plumes exactly equal, then just set many of these -! variables to themselves to save on computation. - IF (qw1_1 == qw1_2 .and. thl2_1 == thl2_2 .and. qs1 == qs2) THEN - s2 = s1 - cthl2 = cthl1 - cqt2 = cqt1 - std_s2 = std_s1 - C2 = C1 - qn2 = qn1 - ELSE + IF (std_s1 > zero) THEN + wrk = s1 / (std_s1*sqrt2) + C1 = max(zero, min(one, half*(one+erf(wrk)))) ! A.15 - cqt2 = one / (one+beta2*qs2) - wrk = qs2 * (one+beta2*qw1_2) * cqt2 - s2 = qw1_2 - wrk - cthl2 = wrk*cqt2*cpolv*beta2*pkap - wrk1 = cthl2 * cthl2 - wrk2 = cqt2 * cqt2 -! std_s2 = sqrt(max(zero,wrk1*thl2_2+wrk2*qw2_2-2.*cthl2*sqrtthl2_2*cqt2*sqrtqw2_2*r_qwthl_1)) - std_s2 = sqrt(max(zero, wrk1*thl2_2+wrk2*qw2_2 & - - two*cthl2*sqrtthl2_2*cqt2*sqrtqw2_2*r_qwthl_1)) - - qn2 = zero - C2 = zero - - IF (std_s2 > zero) THEN - wrk = s2 / (std_s2*sqrt2) - C2 = max(zero, min(one, half*(one+erf(wrk)))) -! IF (C2 > zero) qn2 = s2*C2 + (std_s2*sqrtpii)*exp(-wrk*wrk) - qn2 = max(zero, s2*C2 + (std_s2*sqrtpii)*exp(-wrk*wrk)) - ELSEIF (s2 > zero) THEN - C2 = one - qn2 = s2 - ENDIF + IF (C1 > zero) qn1 = s1*C1 + (std_s1*sqrtpii)*exp(-wrk*wrk) ! A.16 + ELSEIF (s1 >= qcmin) THEN + C1 = one + qn1 = s1 + ENDIF - ENDIF +! now compute non-precipitating cloud condensate -! finally, compute the SGS cloud fraction - diag_frac = aterm*C1 + onema*C2 +! If two plumes exactly equal, then just set many of these +! variables to themselves to save on computation. + IF (qw1_1 == qw1_2 .and. thl2_1 == thl2_2 .and. qs1 == qs2) THEN + s2 = s1 + cthl2 = cthl1 + cqt2 = cqt1 + std_s2 = std_s1 + C2 = C1 + qn2 = qn1 + ELSE + + cqt2 = one / (one+beta2*qs2) + wrk = qs2 * (one+beta2*qw1_2) * cqt2 + s2 = qw1_2 - wrk + cthl2 = wrk*cqt2*cpolv*beta2*pkap + wrk1 = cthl2 * cthl2 + wrk2 = cqt2 * cqt2 +! std_s2 = sqrt(max(zero,wrk1*thl2_2+wrk2*qw2_2-2.*cthl2*sqrtthl2_2*cqt2*sqrtqw2_2*r_qwthl_1)) + std_s2 = sqrt(max(zero, wrk1*thl2_2+wrk2*qw2_2 & + - two*cthl2*sqrtthl2_2*cqt2*sqrtqw2_2*r_qwthl_1)) + + qn2 = zero + C2 = zero + + IF (std_s2 > zero) THEN + wrk = s2 / (std_s2*sqrt2) + C2 = max(zero, min(one, half*(one+erf(wrk)))) + IF (C2 > zero) qn2 = s2*C2 + (std_s2*sqrtpii)*exp(-wrk*wrk) + ELSEIF (s2 >= qcmin) THEN + C2 = one + qn2 = s2 + ENDIF - om1 = max(zero, min(one, (Tl1_1-tbgmin)*a_bg)) - om2 = max(zero, min(one, (Tl1_2-tbgmin)*a_bg)) + ENDIF - qn1 = min(qn1,qw1_1) - qn2 = min(qn2,qw1_2) +! finally, compute the SGS cloud fraction + diag_frac = aterm*C1 + onema*C2 - ql1 = qn1*om1 - ql2 = qn2*om2 + om1 = max(zero, min(one, (Tl1_1-tbgmin)*a_bg)) + om2 = max(zero, min(one, (Tl1_2-tbgmin)*a_bg)) - qi1 = qn1 - ql1 - qi2 = qn2 - ql2 + qn1 = min(qn1,qw1_1) + qn2 = min(qn2,qw1_2) -! if (lprnt .and. i == ipr .and. k<40) write(0,*)' in shoc qi=',qi1,qi2,' ql=',ql1,ql2,& -! ' c1=',c1,' c2=',c2,' s1=',s1,' s2=',s2,' k=',k,' tl1=',tl1_1,tl1_2,' om1=',om1,'om2=',om2& -! ,' tbgmin=',tbgmin,'a_bg=',a_bg + ql1 = qn1*om1 + ql2 = qn2*om2 + qi1 = qn1 - ql1 + qi2 = qn2 - ql2 - diag_qn = min(max(zero, aterm*qn1 + onema*qn2), total_water(i,j,k)) - diag_ql = min(max(zero, aterm*ql1 + onema*ql2), diag_qn) - diag_qi = diag_qn - diag_ql + diag_qn = min(max(zero, aterm*qn1 + onema*qn2), total_water(i,k)) + diag_ql = min(max(zero, aterm*ql1 + onema*ql2), diag_qn) + diag_qi = diag_qn - diag_ql ! Update temperature variable based on diagnosed cloud properties - om1 = max(zero, min(one, (tabs(i,j,k)-tbgmin)*a_bg)) - lstarn1 = lcond + (one-om1)*lfus - tabs(i,j,k) = hl(i,j,k) - gamaz(i,j,k) + fac_cond*(diag_ql+qpl(i,j,k)) & - + fac_sub *(diag_qi+qpi(i,j,k)) & - + tkesbdiss(i,j,k) * (dtn/cp) ! tke dissipative heating - -! if (lprnt .and. i == ipr .and. k < 40) write(0,*)' tabsout=',tabs(ipr,1,k),' k=',k& -! ,' hl=',hl(i,j,k),' gamaz=',gamaz(i,j,k),' diag_ql=',diag_ql,' qpl=',qpl(i,j,k)& -! ,' diag_qi=',diag_qi,' qpi=',qpi(i,j,k),' diag_qn =',diag_qn ,' aterm=',aterm,' onema=',onema& -! ,' qn1=',qn1 ,' qn2=',qn2,' ql1=',ql1,' ql2=',ql2 + om1 = max(zero, min(one, (tabs(i,k)-tbgmin)*a_bg)) + lstarn1 = lcond + (one-om1)*lfus + tabs(i,k) = hl(i,k) - gamaz(i,k) + fac_cond*(diag_ql+qpl(i,k)) & + + fac_sub *(diag_qi+qpi(i,k)) & + + tkesbdiss(i,k) * (dtn/cp) ! tke dissipative heating + ! Update moisture fields ! Update ncpl and ncpi Anning Cheng 03/11/2016 -! ncpl(i,j,k) = diag_ql/max(qc(i,j,k),1.e-10)*ncpl(i,j,k) -! The following commneted by Moorthi on April 26, 2017 to test blowing up -! ncpl(i,j,k) = (1.0-diag_ql/max(qc(i,j,k),1.e-10)) * ncpl(i,j,k) -! ncpi(i,j,k) = (1.0-diag_qi/max(qi(i,j,k),1.e-10)) * ncpi(i,j,k) - qc(i,j,k) = diag_ql - qi(i,j,k) = diag_qi - qwv(i,j,k) = total_water(i,j,k) - diag_qn - cld_sgs(i,j,k) = diag_frac +! ncpl(i,k) = diag_ql/max(qc(i,k),1.e-10)*ncpl(i,k) + qc(i,k) = diag_ql + qi(i,k) = diag_qi + qwv(i,k) = total_water(i,k) - diag_qn + cld_sgs(i,k) = diag_frac + +! Update ncpl and ncpi Moorthi 12/12/2018 + if (ntlnc > 0) then ! liquid and ice number concentrations predicted + if (ncpl(i,k) > nmin) then + ncpl(i,k) = diag_ql/max(qc(i,k),1.0d-10)*ncpl(i,k) + else + ncpl(i,k) = max(diag_ql/(fourb3*pi*RL_cub*997.0d0), nmin) + endif + if (ncpi(i,k) > nmin) then + ncpi(i,k) = diag_qi/max(qi(i,k),1.0d-10)*ncpi(i,k) + else + ncpi(i,k) = max(diag_qi/(fourb3*pi*RI_cub*500.0d0), nmin) + endif + endif ! Compute the liquid water flux - wqls = aterm * ((w1_1-w_first)*ql1) + onema * ((w1_2-w_first)*ql2) - wqis = aterm * ((w1_1-w_first)*qi1) + onema * ((w1_2-w_first)*qi2) + wqls = aterm * ((w1_1-w_first)*ql1) + onema * ((w1_2-w_first)*ql2) + wqis = aterm * ((w1_1-w_first)*qi1) + onema * ((w1_2-w_first)*qi2) ! Compute statistics for the fluxes so we don't have to save these variables - wqlsb(k) = wqlsb(k) + wqls - wqisb(k) = wqisb(k) + wqis + wqlsb(k) = wqlsb(k) + wqls + wqisb(k) = wqisb(k) + wqis ! diagnostic buoyancy flux. Includes effects from liquid water, ice ! condensate, liquid & ice precipitation -! wrk = epsv * basetemp - wrk = epsv * thv(i,j,k) +! wrk = epsv * basetemp + wrk = epsv * thv(i,k) - bastoeps = onebeps * thv(i,j,k) + bastoeps = onebeps * thv(i,k) - if (k < nzm) then - wthv_sec(i,j,k) = wthlsec + wrk*wqwsec & - + (fac_cond-bastoeps)*wqls & - + (fac_sub-bastoeps) *wqis & - + ((lstarn1/cp)-thv(i,j,k))*half*(wqp_sec(i,j,kd)+wqp_sec(i,j,ku)) - else - wthv_sec(i,j,k) = wthlsec + wrk*wqwsec & - + (fac_cond-bastoeps)*wqls & - + (fac_sub-bastoeps) *wqis & - + ((lstarn1/cp)-thv(i,j,k))*half*wqp_sec(i,j,k) - endif + if (k < nzm) then + wthv_sec(i,k) = wthlsec + wrk*wqwsec & + + (fac_cond-bastoeps)*wqls & + + (fac_sub-bastoeps) *wqis & + + ((lstarn1/cp)-thv(i,k))*half*(wqp_sec(i,kd)+wqp_sec(i,ku)) + else + wthv_sec(i,k) = wthlsec + wrk*wqwsec & + + (fac_cond-bastoeps)*wqls & + + (fac_sub-bastoeps) *wqis & + + ((lstarn1/cp)-thv(i,k))*half*wqp_sec(i,k) + endif -! wthv_sec(i,j,k) = wthlsec + wrk*wqwsec & -! + (fac_cond-bastoeps)*wqls & -! + (fac_sub-bastoeps)*wqis & -! + ((lstarn1/cp)-basetemp)*half*(wqp_sec(i,j,kd)+wqp_sec(i,j,ku)) +! wthv_sec(i,k) = wthlsec + wrk*wqwsec & +! + (fac_cond-bastoeps)*wqls & +! + (fac_sub-bastoeps)*wqis & +! + ((lstarn1/cp)-basetemp)*half*(wqp_sec(i,kd)+wqp_sec(i,ku)) - ENDDO ENDDO ENDDO diff --git a/physics/gcm_shoc.meta b/physics/gcm_shoc.meta index 9fb5cb38d..f4d2f3ae9 100644 --- a/physics/gcm_shoc.meta +++ b/physics/gcm_shoc.meta @@ -25,78 +25,6 @@ type = integer intent = in optional = F -[do_shoc] - standard_name = flag_for_shoc - long_name = flag for SHOC - units = flag - dimensions = () - type = logical - intent = in - optional = F -[shocaftcnv] - standard_name = flag_for_shoc_after_convection - long_name = flag to execute SHOC after convection - units = flag - dimensions = () - type = logical - intent = in - optional = F -[mg3_as_mg2] - standard_name = flag_mg3_as_mg2 - long_name = flag for controlling prep for Morrison-Gettelman microphysics - units = flag - dimensions = () - type = logical - intent = in - optional = F -[imp_physics] - standard_name = flag_for_microphysics_scheme - long_name = choice of microphysics scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F -[imp_physics_gfdl] - standard_name = flag_for_gfdl_microphysics_scheme - long_name = choice of GFDL microphysics scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F -[imp_physics_zhao_carr] - standard_name = flag_for_zhao_carr_microphysics_scheme - long_name = choice of Zhao-Carr microphysics scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F -[imp_physics_zhao_carr_pdf] - standard_name = flag_for_zhao_carr_pdf_microphysics_scheme - long_name = choice of Zhao-Carr microphysics scheme with PDF clouds - units = flag - dimensions = () - type = integer - intent = in - optional = F -[imp_physics_mg] - standard_name = flag_for_morrison_gettelman_microphysics_scheme - long_name = choice of Morrison-Gettelman microphysics scheme - units = flag - dimensions = () - type = integer - intent = in - optional = F -[fprcp] - standard_name = number_of_frozen_precipitation_species - long_name = number of frozen precipitation species - units = count - dimensions = () - type = integer - intent = in - optional = F [tcr] standard_name = cloud_phase_transition_threshold_temperature long_name = threshold temperature below which cloud starts to freeze @@ -187,42 +115,6 @@ kind = kind_phys intent = in optional = F -[gq0_cloud_ice] - standard_name = ice_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water updated by physics - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[gq0_rain] - standard_name = rain_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of rain water updated by physics - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[gq0_snow] - standard_name = snow_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of snow water updated by physics - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[gq0_graupel] - standard_name = graupel_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of graupel updated by physics - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = F [dtp] standard_name = time_step_for_physics long_name = time step for physics @@ -232,14 +124,6 @@ kind = kind_phys intent = in optional = F -[me] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F [prsl] standard_name = air_pressure long_name = mean layer pressure @@ -249,6 +133,15 @@ kind = kind_phys intent = in optional = F +[delp] + standard_name = air_pressure_difference_between_midlayers + long_name = pres(k) - pres(k+1) + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F [phii] standard_name = geopotential_at_interface long_name = geopotential at model layer interfaces @@ -358,7 +251,7 @@ intent = in optional = F [hflx] - standard_name = kinematic_surface_upward_sensible_heat_flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 dimensions = (horizontal_dimension) @@ -367,7 +260,7 @@ intent = in optional = F [evap] - standard_name = kinematic_surface_upward_latent_heat_flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 dimensions = (horizontal_dimension) @@ -384,76 +277,95 @@ kind = kind_phys intent = in optional = F -[skip_macro] - standard_name = flag_skip_macro - long_name = flag to skip cloud macrophysics in Morrison scheme - units = flag - dimensions = () - type = logical - intent = inout - optional = F -[clw_ice] - standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array - units = kg kg-1 +[gt0] + standard_name = air_temperature_updated_by_physics + long_name = temperature updated by physics + units = K dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = inout optional = F -[clw_liquid] - standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) in the convectively transported tracer array +[gq0] + standard_name = tracer_concentration_updated_by_physics + long_name = tracer concentration updated by physics units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) type = real kind = kind_phys intent = inout optional = F -[gq0_cloud_liquid] - standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud condensed water updated by physics - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[ntrac] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in optional = F -[ncpl] - standard_name = cloud_droplet_number_concentration_updated_by_physics - long_name = number concentration of cloud droplets updated by physics - units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[ntqv] + standard_name = index_for_water_vapor + long_name = tracer index for water vapor (specific humidity) + units = index + dimensions = () + type = integer + intent = in optional = F -[ncpi] - standard_name = ice_number_concentration_updated_by_physics - long_name = number concentration of ice updated by physics - units = kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = tracer index for cloud condensate (or liquid water) + units = index + dimensions = () + type = integer + intent = in optional = F -[gt0] - standard_name = air_temperature_updated_by_physics - long_name = temperature updated by physics - units = K - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[ntiw] + standard_name = index_for_ice_cloud_condensate + long_name = tracer index for ice water + units = index + dimensions = () + type = integer + intent = in optional = F -[gq0_water_vapor] - standard_name = water_vapor_specific_humidity_updated_by_physics - long_name = water vapor specific humidity updated by physics - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout +[ntrw] + standard_name = index_for_rain_water + long_name = tracer index for rain water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntsw] + standard_name = index_for_snow_water + long_name = tracer index for snow water + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntgl] + standard_name = index_for_graupel + long_name = tracer index for graupel + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntlnc] + standard_name = index_for_liquid_cloud_number_concentration + long_name = tracer index for liquid number concentration + units = index + dimensions = () + type = integer + intent = in + optional = F +[ntinc] + standard_name = index_for_ice_cloud_number_concentration + long_name = tracer index for ice number concentration + units = index + dimensions = () + type = integer + intent = in optional = F [cld_sgs] standard_name = subgrid_scale_cloud_fraction_from_shoc diff --git a/physics/gcycle.F90 b/physics/gcycle.F90 index 411d41004..8c5dd041a 100644 --- a/physics/gcycle.F90 +++ b/physics/gcycle.F90 @@ -1,5 +1,5 @@ !>\file gcycle.F90 -!! This file repopulates specific time-varying surface properties for +!! This file repopulates specific time-varying surface properties for !! atmospheric forecast runs. !>\ingroup mod_GFS_phys_time_vary @@ -41,7 +41,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) TG3FCS (Model%nx*Model%ny), & CNPFCS (Model%nx*Model%ny), & AISFCS (Model%nx*Model%ny), & -! F10MFCS(Model%nx*Model%ny), & +! F10MFCS(Model%nx*Model%ny), & VEGFCS (Model%nx*Model%ny), & VETFCS (Model%nx*Model%ny), & SOTFCS (Model%nx*Model%ny), & @@ -64,7 +64,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) character(len=6) :: tile_num_ch real(kind=kind_phys), parameter :: pifac=180.0/pi - real(kind=kind_phys) :: sig1t + real(kind=kind_phys) :: sig1t, dt_warm integer :: npts, len, nb, ix, jx, ls, ios logical :: exists ! @@ -110,7 +110,7 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) ZORFCS (len) = Sfcprop(nb)%zorl (ix) TG3FCS (len) = Sfcprop(nb)%tg3 (ix) CNPFCS (len) = Sfcprop(nb)%canopy (ix) -! F10MFCS (len) = Sfcprop(nb)%f10m (ix) +! F10MFCS (len) = Sfcprop(nb)%f10m (ix) VEGFCS (len) = Sfcprop(nb)%vfrac (ix) VETFCS (len) = Sfcprop(nb)%vtype (ix) SOTFCS (len) = Sfcprop(nb)%stype (ix) @@ -191,21 +191,28 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) close (Model%nlunit) #endif - len = 0 + len = 0 do nb = 1,nblks do ix = 1,size(Grid(nb)%xlat,1) len = len + 1 Sfcprop(nb)%slmsk (ix) = SLIFCS (len) if ( Model%nstf_name(1) > 0 ) then Sfcprop(nb)%tref(ix) = TSFFCS (len) +! if ( Model%nstf_name(2) == 0 ) then +! dt_warm = (Sfcprop(nb)%xt(ix) + Sfcprop(nb)%xt(ix) ) & +! / Sfcprop(nb)%xz(ix) +! Sfcprop(nb)%tsfco(ix) = Sfcprop(nb)%tref(ix) & +! + dt_warm - Sfcprop(nb)%dt_cool(ix) +! endif else - Sfcprop(nb)%tsfc(ix) = TSFFCS (len) + Sfcprop(nb)%tsfc(ix) = TSFFCS (len) + Sfcprop(nb)%tsfco(ix) = TSFFCS (len) endif Sfcprop(nb)%weasd (ix) = SNOFCS (len) Sfcprop(nb)%zorl (ix) = ZORFCS (len) Sfcprop(nb)%tg3 (ix) = TG3FCS (len) Sfcprop(nb)%canopy (ix) = CNPFCS (len) -! Sfcprop(nb)%f10m (ix) = F10MFCS (len) +! Sfcprop(nb)%f10m (ix) = F10MFCS (len) Sfcprop(nb)%vfrac (ix) = VEGFCS (len) Sfcprop(nb)%vtype (ix) = VETFCS (len) Sfcprop(nb)%stype (ix) = SOTFCS (len) @@ -240,6 +247,6 @@ SUBROUTINE GCYCLE (nblks, Model, Grid, Sfcprop, Cldprop) ! call mymaxmin(slifcs,len,len,1,'slifcs') ! ! if (Model%me .eq. 0) print*,'executed gcycle during hour=',fhour - + RETURN END diff --git a/physics/gfdl_cloud_microphys.meta b/physics/gfdl_cloud_microphys.meta index 7f31637bf..3d202722b 100644 --- a/physics/gfdl_cloud_microphys.meta +++ b/physics/gfdl_cloud_microphys.meta @@ -235,7 +235,7 @@ optional = F [gq0_ntgl] standard_name = graupel_mixing_ratio_updated_by_physics - long_name = moist mixing ratio of graupel updated by physics + long_name = moist ratio of mass of graupel to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/gfdl_fv_sat_adj.F90 b/physics/gfdl_fv_sat_adj.F90 index f5c84cd99..025ee1c34 100644 --- a/physics/gfdl_fv_sat_adj.F90 +++ b/physics/gfdl_fv_sat_adj.F90 @@ -150,6 +150,12 @@ subroutine fv_sat_adj_init(do_sat_adj, kmp, nwat, ngas, rilist, cpilist, & return end if + if (.not.nwat==6) then + write(errmsg,'(a)') 'Logic error: fv_sat_adj requires six water species (nwat=6)' + errflg = 1 + return + end if + if (is_initialized) return ! generate es table (dt = 0.1 deg c) diff --git a/physics/gscond.meta b/physics/gscond.meta index a317b8529..f2046df0a 100644 --- a/physics/gscond.meta +++ b/physics/gscond.meta @@ -82,7 +82,7 @@ optional = F [clw1] standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -91,7 +91,7 @@ optional = F [clw2] standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) in the convectively transported tracer array + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/gwdps.f b/physics/gwdps.f index 9454b967d..96ce0205b 100644 --- a/physics/gwdps.f +++ b/physics/gwdps.f @@ -87,7 +87,7 @@ end subroutine gwdps_init !! the GWD scheme has the same physical basis as in Alpert (1987) with the addition !! of enhancement factors for the amplitude, G, and mountain shape details !! in G(Fr) to account for effects from the mountain blocking. A factor, -!! E m’, is an enhancement factor on the stress in the Alpert '87 scheme. +!! E m', is an enhancement factor on the stress in the Alpert '87 scheme. !! The E ranges from no enhancement to an upper limit of 3, E=E(OA)[1-3], !! and is a function of OA, the Orographic Asymmetry defined in Kim and Arakawa (1995) !! \cite kim_and_arakawa_1995 as @@ -103,9 +103,9 @@ end subroutine gwdps_init !! \; (x_{j} \; - \; \bar{x} )^2}{N_{x}} } !!\f] !! where \f$N_{x}\f$ is the number of grid intervals for the large scale domain being -!! considered. So the term, E(OA)m’/ \f$ \Delta X \f$ in Kim's scheme represents -!! a multiplier on G shown in Alpert's eq (1), where m’ is the number of mountains -!! in a sub-grid scale box. Kim increased the complexity of m’ making it a +!! considered. So the term, E(OA)m'/ \f$ \Delta X \f$ in Kim's scheme represents +!! a multiplier on G shown in Alpert's eq (1), where m' is the number of mountains +!! in a sub-grid scale box. Kim increased the complexity of m' making it a !! function of the fractional area of the sub-grid mountain and the asymmetry !! and convexity statistics which are found from running a gravity wave !! model for a large number of cases: diff --git a/physics/iccninterp.F90 b/physics/iccninterp.F90 index cd4586d89..a3a08dee8 100644 --- a/physics/iccninterp.F90 +++ b/physics/iccninterp.F90 @@ -50,7 +50,7 @@ SUBROUTINE read_cidata (me, master) end do end do call nf_close(ncid) - call nf_open("INPUT/cam5_4_143_NPCCN_monclimo2.nc", NF90_NOWRITE, ncid) + call nf_open("cam5_4_143_NPCCN_monclimo2.nc", NF90_NOWRITE, ncid) call nf_inq_varid(ncid, "NPCCN", varid) call nf_get_var(ncid, varid, ccnin) call nf_close(ncid) diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index 40025a898..8b2b4c99f 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -14,17 +14,16 @@ module m_micro contains -!>\ingroup mg_driver -!! This subroutine is the MG initialization. +!> This subroutine is the MG initialization. !> \section arg_table_m_micro_init Argument Table !! \htmlinclude m_micro_init.html !! -subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, cpair,& - tmelt, latvap, latice, mg_dcs, mg_qcvar, mg_ts_auto_ice, & - mg_rhmini, microp_uniform, do_cldice, hetfrz_classnuc, & - mg_precip_frac_method, mg_berg_eff_factor, sed_supersat, & - do_sb_physics, mg_do_hail, mg_do_graupel, mg_nccons, & - mg_nicons, mg_ngcons, mg_ncnst, mg_ninst, mg_ngnst, & +subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, cpair, & + eps, tmelt, latvap, latice, mg_dcs, mg_qcvar, mg_ts_auto_ice, & + mg_rhmini, microp_uniform, do_cldice, hetfrz_classnuc, & + mg_precip_frac_method, mg_berg_eff_factor, sed_supersat, & + do_sb_physics, mg_do_hail, mg_do_graupel, mg_nccons, & + mg_nicons, mg_ngcons, mg_ncnst, mg_ninst, mg_ngnst, & mg_do_ice_gmao, mg_do_liq_liu, errmsg, errflg) use machine, only: kind_phys @@ -38,7 +37,7 @@ subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, sed_supersat, do_sb_physics, mg_do_hail, & mg_do_graupel, mg_nccons, mg_nicons, mg_ngcons, & mg_do_ice_gmao, mg_do_liq_liu - real(kind=kind_phys), intent(in) :: gravit, rair, rh2o, cpair, tmelt, latvap, latice + real(kind=kind_phys), intent(in) :: gravit, rair, rh2o, cpair, eps, tmelt, latvap, latice real(kind=kind_phys), intent(in) :: mg_dcs, mg_qcvar, mg_ts_auto_ice(2), mg_rhmini, & mg_berg_eff_factor, mg_ncnst, mg_ninst, mg_ngnst character(len=16), intent(in) :: mg_precip_frac_method @@ -50,7 +49,7 @@ subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, if (is_initialized) return - if (imp_physics/=imp_physics_mg) then + if (imp_physics /= imp_physics_mg) then write(errmsg,'(*(a))') "Logic error: namelist choice of microphysics is different from Morrison-Gettelman MP" errflg = 1 return @@ -60,20 +59,20 @@ subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, call ini_micro (mg_dcs, mg_qcvar, mg_ts_auto_ice(1)) elseif (fprcp == 1) then call micro_mg_init2_0(kind_phys, gravit, rair, rh2o, cpair, & - tmelt, latvap, latice, mg_rhmini, & + eps, tmelt, latvap, latice, mg_rhmini,& mg_dcs, mg_ts_auto_ice, & mg_qcvar, & microp_uniform, do_cldice, & hetfrz_classnuc, & mg_precip_frac_method, & mg_berg_eff_factor, & - sed_supersat, do_sb_physics, & + sed_supersat, do_sb_physics, & mg_do_ice_gmao, mg_do_liq_liu, & - mg_nccons, mg_nicons, & - mg_ncnst, mg_ninst) + mg_nccons, mg_nicons, & + mg_ncnst, mg_ninst) elseif (fprcp == 2) then call micro_mg_init3_0(kind_phys, gravit, rair, rh2o, cpair, & - tmelt, latvap, latice, mg_rhmini, & + eps, tmelt, latvap, latice, mg_rhmini,& mg_dcs, mg_ts_auto_ice, & mg_qcvar, & mg_do_hail, mg_do_graupel, & @@ -81,11 +80,11 @@ subroutine m_micro_init(imp_physics, imp_physics_mg, fprcp, gravit, rair, rh2o, hetfrz_classnuc, & mg_precip_frac_method, & mg_berg_eff_factor, & - sed_supersat, do_sb_physics, & + sed_supersat, do_sb_physics, & mg_do_ice_gmao, mg_do_liq_liu, & - mg_nccons, mg_nicons, & - mg_ncnst, mg_ninst, & - mg_ngcons, mg_ngnst) + mg_nccons, mg_nicons, & + mg_ncnst, mg_ninst, & + mg_ngcons, mg_ngnst) else write(0,*)' fprcp = ',fprcp,' is not a valid option - aborting' stop @@ -103,20 +102,13 @@ end subroutine m_micro_init subroutine m_micro_finalize end subroutine m_micro_finalize -!> \defgroup mg2mg3 Morrison-Gettelman MP scheme Module -!! This module contains the the entity of MG2 and MG3 schemes. -!> @{ -!> \defgroup mg_driver Morrison-Gettelman MP Driver Module +!> \defgroup mg2mg3 Morrison-Gettelman MP Driver Module !! \brief This subroutine is the Morrison-Gettelman MP driver, which computes !! grid-scale condensation and evaporation of cloud condensate. - -#if 0 - +!! !> \section arg_table_m_micro_run Argument Table !! \htmlinclude m_micro_run.html !! -#endif -!>\ingroup mg_driver !>\section detail_m_micro_run MG m_micro_run Detailed Algorithm !> @{ subroutine m_micro_run( im, ix, lm, flipv, dt_i & @@ -134,10 +126,10 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & &, CLLS_io, KCBL & &, CLDREFFL, CLDREFFI, CLDREFFR, CLDREFFS & &, CLDREFFG, aerfld_i & - &, aero_in, naai_i, npccn_i, iccn & + &, naai_i, npccn_i, iccn & &, skip_macro & - &, lprnt, alf_fac, qc_min, pdfflag & - &, ipr, kdt, xlat, xlon, rhc_i, & + &, alf_fac, qc_min, pdfflag & + &, kdt, xlat, xlon, rhc_i, & & errmsg, errflg) use machine , only: kind_phys @@ -182,8 +174,9 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & & fourb3=4.0/3.0, RL_cub=1.0e-15, nmin=1.0 integer, parameter :: ncolmicro = 1 - integer,intent(in) :: im, ix,lm, ipr, kdt, fprcp, pdfflag - logical,intent(in) :: flipv, aero_in, skip_macro, lprnt, iccn + integer,intent(in) :: im, ix,lm, kdt, fprcp, pdfflag + logical,intent(in) :: flipv, skip_macro + integer,intent(in) :: iccn real (kind=kind_phys), intent(in):: dt_i, alf_fac, qc_min(2) real (kind=kind_phys), dimension(ix,lm),intent(in) :: & @@ -234,7 +227,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & integer kcldtopcvn,i,k,ll, kbmin, NAUX, nbincontactdust,l integer, dimension(im) :: kct real (kind=kind_phys) T_ICE_ALL, USE_AV_V,BKGTAU,LCCIRRUS, & - & NPRE_FRAC, Nct, Wct, fcn, ksa1, tauxr8, DT_Moist, dt_r8, & + & NPRE_FRAC, Nct, Wct, fcn, ksa1, tauxr8, DT_Moist, dt_r8, tem, & & TMAXLL, USURF,LTS_UP, LTS_LOW, MIN_EXP, fracover, c2_gw, est3 real(kind=kind_phys), allocatable, dimension(:,:) :: & @@ -379,7 +372,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & type (AerProps) :: AeroAux, AeroAux_b real, allocatable, dimension(:,:,:) :: AERMASSMIX - logical :: use_average_v, ltrue, lprint + logical :: use_average_v, ltrue, lprint, lprnt + integer :: ipr !================================== !====2-moment Microhysics= @@ -407,6 +401,9 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & errmsg = '' errflg = 0 + lprnt = .false. + ipr = 1 + ! rhr8 = 1.0 if(flipv) then DO K=1, LM @@ -439,7 +436,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & temp(i,k) = t_io(i,ll) radheat(i,k) = lwheat_i(i,ll) + swheat_i(i,ll) rhc(i,k) = rhc_i(i,ll) - if (iccn) then + if (iccn == 1) then CDNC_NUC(i,k) = npccn_i(i,ll) INC_NUC(i,k) = naai_i (i,ll) endif @@ -500,7 +497,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & temp(i,k) = t_io(i,k) radheat(i,k) = lwheat_i(i,k) + swheat_i(i,k) rhc(i,k) = rhc_i(i,k) - if (iccn) then + if (iccn == 1) then CDNC_NUC(i,k) = npccn_i(i,k) INC_NUC(i,k) = naai_i (i,k) endif @@ -528,6 +525,12 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & enddo endif endif +! if (lprnt) then +! write(0,*)' inmic qlcn=',qlcn(ipr,:) +! write(0,*)' inmic qlls=',qlls(ipr,:) +! write(0,*)' inmic qicn=',qicn(ipr,:) +! write(0,*)' inmic qils=',qils(ipr,:) +! endif ! DT_MOIST = dt_i dt_r8 = dt_i @@ -540,12 +543,12 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & & QICN(I,K), CLCN(I,K), NCPL(I,K), & & NCPI(I,K), qc_min) if (rnw(i,k) <= qc_min(1)) then - ncpl(i,k) = 0.0 - elseif (ncpl(i,k) <= nmin) then ! make sure NL > 0 if Q >0 - ncpl(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0), nmin) + ncpr(i,k) = 0.0 + elseif (ncpr(i,k) <= nmin) then ! make sure NL > 0 if Q >0 + ncpr(i,k) = max(rnw(i,k) / (fourb3 * PI *RL_cub*997.0), nmin) endif if (snw(i,k) <= qc_min(2)) then - ncpl(i,k) = 0.0 + ncps(i,k) = 0.0 elseif (ncps(i,k) <= nmin) then ncps(i,k) = max(snw(i,k) / (fourb3 * PI *RL_cub*500.0), nmin) endif @@ -558,6 +561,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & enddo enddo endif + do i=1,im KCBL(i) = max(LM-KCBL(i),10) KCT(i) = 10 @@ -643,7 +647,6 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! deallocate (vmip) ! endif - do l=lm-1,1,-1 do i=1,im tx1 = 0.5 * (temp(i,l+1) + temp(i,l)) @@ -663,7 +666,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & NCPL(i,l) = MAX( NCPL(i,l), 0.) NCPI(i,l) = MAX( NCPI(i,l), 0.) RAD_CF(i,l) = max(0.0, min(CLLS(i,l)+CLCN(i,l), 1.0)) - if (.not. iccn) then + if (iccn .ne. 1) then CDNC_NUC(i,l) = 0.0 INC_NUC(i,l) = 0.0 endif @@ -719,7 +722,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! allocate(AERMASSMIX(IM,LM,15)) - if ( aero_in ) then + if (iccn == 2) then AERMASSMIX(:,:,1:ntrcaer) = aerfld_i(:,:,1:ntrcaer) else AERMASSMIX(:,:,1:5) = 1.e-6 @@ -972,19 +975,21 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! if(temp(i,k) > T_ICE_ALL) SC_ICE(i,k) = 1.0 ! if(temp(i,k) > TICE) SC_ICE(i,k) = rhc(i,k) ! - if(temp(i,k) < T_ICE_ALL) then -! SC_ICE(i,k) = max(SC_ICE(I,k), 1.2) - SC_ICE(i,k) = max(SC_ICE(I,k), 1.5) - elseif(temp(i,k) > TICE) then - SC_ICE(i,k) = rhc(i,k) - else -! SC_ICE(i,k) = 1.0 -! tx1 = max(SC_ICE(I,k), 1.2) - tx1 = max(SC_ICE(I,k), 1.5) - SC_ICE(i,k) = ((tice-temp(i,k))*tx1 + (temp(i,k)-t_ice_all)*rhc(i,k)) & - * t_ice_denom + if(iccn == 0) then + if(temp(i,k) < T_ICE_ALL) then +! SC_ICE(i,k) = max(SC_ICE(I,k), 1.2) + SC_ICE(i,k) = max(SC_ICE(I,k), 1.5) + elseif(temp(i,k) > TICE) then + SC_ICE(i,k) = rhc(i,k) + else +! SC_ICE(i,k) = 1.0 +! tx1 = max(SC_ICE(I,k), 1.2) + tx1 = max(SC_ICE(I,k), 1.5) + SC_ICE(i,k) = ((tice-temp(i,k))*tx1 + (temp(i,k)-t_ice_all)*rhc(i,k)) & + * t_ice_denom + endif endif - if (.not. iccn) then + if (iccn .ne. 1) then CDNC_NUC(I,k) = npccninr8(k) INC_NUC (I,k) = naair8(k) endif @@ -1119,7 +1124,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! temp(i,k) = th1(i,k) * PK(i,k) RAD_CF(i,k) = min(CLLS(i,k)+CLCN(i,k), 1.0) ! - if (.not. iccn) then + if (iccn .ne. 1) then if (PFRZ(i,k) > 0.0) then INC_NUC(i,k) = INC_NUC(i,k) * PFRZ(i,k) NHET_NUC(i,k) = NHET_NUC(i,k) * PFRZ(i,k) @@ -1490,7 +1495,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & & drout2, dsout2, & & freqs, freqr, & & nfice, qcrat, & - & prer_evap, xlat(i), xlon(i), lprint, iccn, aero_in, & + & prer_evap, xlat(i), xlon(i), lprint, iccn, & & lev_sed_strt) ! LS_PRC2(I) = max(1000.*(prectr8(1)-precir8(1)), 0.0) @@ -1541,7 +1546,9 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & ! if(lprint) then ! write(0,*)' calling micro_mg_tend3_0 qcvar3=',qcvar3,' i=',i ! write(0,*)' qcr8=',qcr8(:) +! write(0,*)' qir8=',qir8(:) ! write(0,*)' ncr8=',ncr8(:) +! write(0,*)' nir8=',nir8(:) ! write(0,*)' npccninr8=',npccninr8(:) ! write(0,*)' plevr8=',plevr8(:) ! write(0,*)' ter8=',ter8(:) @@ -1625,7 +1632,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & & qgout2, ngout2, dgout2, freqg, & & freqs, freqr, & & nfice, qcrat, & - & prer_evap, xlat(i), xlon(i), lprint, iccn, aero_in, & + & prer_evap, xlat(i), xlon(i), lprint, iccn, & & lev_sed_strt) LS_PRC2(I) = max(1000.*(prectr8(1)-precir8(1)), 0.0) @@ -1674,14 +1681,21 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & !TVQX1 = SUM( ( Q1 + QL_TOT + QI_TOT(1:im,:,:))*DM, 3) & - if (skip_macro) then do k=1,lm do i=1,im + QLCN(i,k) = QL_TOT(i,k) * FQA(i,k) + QLLS(i,k) = QL_TOT(i,k) - QLCN(i,k) + QICN(i,k) = QI_TOT(i,k) * FQA(i,k) + QILS(i,k) = QI_TOT(i,k) - QICN(i,k) + CALL fix_up_clouds_2M(Q1(I,K), TEMP(i,k), QLLS(I,K), & & QILS(I,K), CLLS(I,K), QLCN(I,K), & & QICN(I,K), CLCN(I,K), NCPL(I,K), & & NCPI(I,K), qc_min) + + QL_TOT(I,K) = QLLS(I,K) + QLCN(I,K) + QI_TOT(I,K) = QILS(I,K) + QICN(I,K) if (rnw(i,k) <= qc_min(1)) then ncpl(i,k) = 0.0 elseif (ncpl(i,k) <= nmin) then ! make sure NL > 0 if Q >0 @@ -1839,7 +1853,7 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & if (allocated(ALPHT_X)) deallocate (ALPHT_X) ! if (lprnt) then -! write(0,*)' rn_o=',rn_o(ipr),' ls_prc2=',ls_prc2(ipr),' ls_snr=',ls_snr(ipr) +! write(0,*)' rn_o=',rn_o(ipr),' ls_prc2=',ls_prc2(ipr),' ls_snr=',ls_snr(ipr),' kdt=',kdt ! write(0,*)' end micro_mg_tend t_io= ', t_io(ipr,:) ! write(0,*)' end micro_mg_tend clls_io= ', clls_io(ipr,:) ! endif @@ -1869,7 +1883,7 @@ end subroutine m_micro_run !DONIF Calculate the Brunt_Vaisala frequency !=============================================================================== -!>\ingroup mg_driver +!>\ingroup mg2mg3 !> This subroutine computes profiles of background state quantities for !! the multiple gravity wave drag parameterization. !!\section gw_prof_gen MG gw_prof General Algorithm @@ -1956,7 +1970,7 @@ subroutine gw_prof (pcols, pver, ncol, t, pm, pi, rhoi, ni, ti, & end subroutine gw_prof !> @} -!>\ingroup mg_driver +!>\ingroup mg2mg3 !! This subroutine is to find cloud top based on cloud fraction. subroutine find_cldtop(ncol, pver, cf, kcldtop) implicit none @@ -1990,6 +2004,5 @@ subroutine find_cldtop(ncol, pver, cf, kcldtop) end subroutine find_cldtop -!> @} end module m_micro diff --git a/physics/m_micro.meta b/physics/m_micro.meta index 91b0c1df0..8ea90f7b9 100644 --- a/physics/m_micro.meta +++ b/physics/m_micro.meta @@ -61,6 +61,15 @@ kind = kind_phys intent = in optional = F +[eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [tmelt] standard_name = triple_point_temperature_of_water long_name = triple point temperature of water @@ -380,7 +389,7 @@ optional = F [qlls_i] standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) in the convectively transported tracer array + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -398,7 +407,7 @@ optional = F [qils_i] standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -415,7 +424,7 @@ intent = in optional = F [lwheat_i] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky lw heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -424,7 +433,7 @@ intent = in optional = F [swheat_i] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky sw heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -587,7 +596,7 @@ optional = F [lwm_o] standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud condensed water updated by physics + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -596,7 +605,7 @@ optional = F [qi_o] standard_name = ice_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water updated by physics + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -658,7 +667,7 @@ optional = F [rnw_io] standard_name = local_rain_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of rain water local to physics + long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -667,7 +676,7 @@ optional = F [snw_io] standard_name = local_snow_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of snow water local to physics + long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -676,7 +685,7 @@ optional = F [qgl_io] standard_name = local_graupel_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of graupel local to physics + long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -781,14 +790,6 @@ kind = kind_phys intent = in optional = F -[aero_in] - standard_name = flag_for_aerosol_input_MG - long_name = flag for using aerosols in Morrison-Gettelman microphysics - units = flag - dimensions = () - type = logical - intent = in - optional = F [naai_i] standard_name = in_number_concentration long_name = IN number concentration @@ -810,9 +811,9 @@ [iccn] standard_name = flag_for_in_ccn_forcing_for_morrison_gettelman_microphysics long_name = flag for IN and CCN forcing for morrison gettelman microphysics - units = flag + units = none dimensions = () - type = logical + type = integer intent = in optional = F [skip_macro] @@ -823,14 +824,6 @@ type = logical intent = in optional = F -[lprnt] - standard_name = flag_print - long_name = control flag for diagnostic print out - units = flag - dimensions = () - type = logical - intent = in - optional = F [alf_fac] standard_name = mg_tuning_factor_for_alphas long_name = tuning factor for alphas (alpha = 1 - critical relative humidity) @@ -857,14 +850,6 @@ type = integer intent = in optional = F -[ipr] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = in - optional = F [kdt] standard_name = index_of_time_step long_name = current forecast iteration diff --git a/physics/m_micro_interstitial.F90 b/physics/m_micro_interstitial.F90 index 2ab2b68db..930b32b3d 100644 --- a/physics/m_micro_interstitial.F90 +++ b/physics/m_micro_interstitial.F90 @@ -23,7 +23,7 @@ end subroutine m_micro_pre_init #endif subroutine m_micro_pre_run (im, levs, do_shoc, skip_macro, fprcp, mg3_as_mg2, gq0_ice, gq0_water, gq0_rain, & gq0_snow, gq0_graupel, gq0_rain_nc, gq0_snow_nc, gq0_graupel_nc, cld_shoc, cnvc, cnvw, tcr, tcrf, gt0, & - qrn, qsnw, qgl, ncpr, ncps, ncgl, cld_frc_MG, qlcn, qicn, cf_upi, clw_water, clw_ice, clcn, errmsg, errflg ) + qrn, qsnw, qgl, ncpr, ncps, ncgl, cld_frc_MG, clw_water, clw_ice, clcn, errmsg, errflg ) use machine, only : kind_phys implicit none @@ -41,7 +41,7 @@ subroutine m_micro_pre_run (im, levs, do_shoc, skip_macro, fprcp, mg3_as_mg2, gq real(kind=kind_phys), intent(inout) :: & qrn(:,:), qsnw(:,:), qgl(:,:), ncpr(:,:), ncps(:,:), ncgl(:,:), & - cld_frc_MG(:,:), cf_upi(:,:), qlcn(:,:), qicn(:,:) + cld_frc_MG(:,:) real(kind=kind_phys), intent(out) :: clw_ice(:,:), clw_water(:,:) @@ -62,39 +62,39 @@ subroutine m_micro_pre_run (im, levs, do_shoc, skip_macro, fprcp, mg3_as_mg2, gq ! in other procceses too. August 28/2015; Hope that can be done next ! year. I believe this will make the physical interaction more reasonable ! Anning 12/5/2015 changed ntcw hold liquid only + skip_macro = do_shoc if (do_shoc) then - skip_macro = do_shoc if (fprcp == 0) then do k=1,levs do i=1,im - clw_ice(i,k) = gq0_ice(i,k) - clw_water(i,k) = gq0_water(i,k) + clw_ice(i,k) = gq0_ice(i,k) + clw_water(i,k) = gq0_water(i,k) cld_frc_MG(i,k) = cld_shoc(i,k) enddo enddo else if ((abs(fprcp) == 1) .or. mg3_as_mg2) then do k=1,levs do i=1,im - clw_ice(i,k) = gq0_ice(i,k) - clw_water(i,k) = gq0_water(i,k) - qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) - ncpr(i,k) = gq0_rain_nc(i,k) - ncps(i,k) = gq0_snow_nc(i,k) + clw_ice(i,k) = gq0_ice(i,k) + clw_water(i,k) = gq0_water(i,k) + qrn(i,k) = gq0_rain(i,k) + qsnw(i,k) = gq0_snow(i,k) + ncpr(i,k) = gq0_rain_nc(i,k) + ncps(i,k) = gq0_snow_nc(i,k) cld_frc_MG(i,k) = cld_shoc(i,k) enddo enddo else do k=1,levs do i=1,im - clw_ice(i,k) = gq0_ice(i,k) - clw_water(i,k) = gq0_water(i,k) - qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) - qgl(i,k) = gq0_graupel(i,k) - ncpr(i,k) = gq0_rain_nc(i,k) - ncps(i,k) = gq0_snow_nc(i,k) - ncgl(i,k) = gq0_graupel_nc(i,k) + clw_ice(i,k) = gq0_ice(i,k) + clw_water(i,k) = gq0_water(i,k) + qrn(i,k) = gq0_rain(i,k) + qsnw(i,k) = gq0_snow(i,k) + qgl(i,k) = gq0_graupel(i,k) + ncpr(i,k) = gq0_rain_nc(i,k) + ncps(i,k) = gq0_snow_nc(i,k) + ncgl(i,k) = gq0_graupel_nc(i,k) cld_frc_MG(i,k) = cld_shoc(i,k) enddo enddo @@ -103,32 +103,32 @@ subroutine m_micro_pre_run (im, levs, do_shoc, skip_macro, fprcp, mg3_as_mg2, gq if (fprcp == 0 ) then do k=1,levs do i=1,im - clw_ice(i,k) = gq0_ice(i,k) + clw_ice(i,k) = gq0_ice(i,k) clw_water(i,k) = gq0_water(i,k) enddo enddo elseif (abs(fprcp) == 1 .or. mg3_as_mg2) then do k=1,levs do i=1,im - clw_ice(i,k) = gq0_ice(i,k) + clw_ice(i,k) = gq0_ice(i,k) clw_water(i,k) = gq0_water(i,k) - qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) - ncpr(i,k) = gq0_rain_nc(i,k) - ncps(i,k) = gq0_snow_nc(i,k) + qrn(i,k) = gq0_rain(i,k) + qsnw(i,k) = gq0_snow(i,k) + ncpr(i,k) = gq0_rain_nc(i,k) + ncps(i,k) = gq0_snow_nc(i,k) enddo enddo else do k=1,levs do i=1,im - clw_ice(i,k) = gq0_ice(i,k) + clw_ice(i,k) = gq0_ice(i,k) clw_water(i,k) = gq0_water(i,k) - qrn(i,k) = gq0_rain(i,k) - qsnw(i,k) = gq0_snow(i,k) - qgl(i,k) = gq0_graupel(i,k) - ncpr(i,k) = gq0_rain_nc(i,k) - ncps(i,k) = gq0_snow_nc(i,k) - ncgl(i,k) = gq0_graupel_nc(i,k) + qrn(i,k) = gq0_rain(i,k) + qsnw(i,k) = gq0_snow(i,k) + qgl(i,k) = gq0_graupel(i,k) + ncpr(i,k) = gq0_rain_nc(i,k) + ncps(i,k) = gq0_snow_nc(i,k) + ncgl(i,k) = gq0_graupel_nc(i,k) enddo enddo endif @@ -243,8 +243,8 @@ subroutine m_micro_post_run( & do i=1,im if (abs(qrn(i,k)) < qsmall) qrn(i,k) = 0.0 if (abs(qsnw(i,k)) < qsmall) qsnw(i,k) = 0.0 - gq0_rain(i,k) = qrn(i,k) - gq0_snow(i,k) = qsnw(i,k) + gq0_rain(i,k) = qrn(i,k) + gq0_snow(i,k) = qsnw(i,k) gq0_rain_nc(i,k) = ncpr(i,k) gq0_snow_nc(i,k) = ncps(i,k) enddo @@ -259,11 +259,11 @@ subroutine m_micro_post_run( & if (abs(qrn(i,k)) < qsmall) qrn(i,k) = 0.0 if (abs(qsnw(i,k)) < qsmall) qsnw(i,k) = 0.0 if (abs(qgl(i,k)) < qsmall) qgl(i,k) = 0.0 - gq0_rain(i,k) = qrn(i,k) - gq0_snow(i,k) = qsnw(i,k) - gq0_graupel(i,k) = qgl(i,k) - gq0_rain_nc(i,k) = ncpr(i,k) - gq0_snow_nc(i,k) = ncps(i,k) + gq0_rain(i,k) = qrn(i,k) + gq0_snow(i,k) = qsnw(i,k) + gq0_graupel(i,k) = qgl(i,k) + gq0_rain_nc(i,k) = ncpr(i,k) + gq0_snow_nc(i,k) = ncps(i,k) gq0_graupel_nc(i,k) = ncgl(i,k) enddo enddo diff --git a/physics/m_micro_interstitial.meta b/physics/m_micro_interstitial.meta index 17358de83..0b5b56b2f 100644 --- a/physics/m_micro_interstitial.meta +++ b/physics/m_micro_interstitial.meta @@ -56,7 +56,7 @@ optional = F [gq0_ice] standard_name = ice_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water updated by physics + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -65,7 +65,7 @@ optional = F [gq0_water] standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud condensed water updated by physics + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -74,7 +74,7 @@ optional = F [gq0_rain] standard_name = rain_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of rain water updated by physics + long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -83,7 +83,7 @@ optional = F [gq0_snow] standard_name = snow_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of snow water updated by physics + long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -92,7 +92,7 @@ optional = F [gq0_graupel] standard_name = graupel_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of graupel updated by physics + long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -182,7 +182,7 @@ optional = F [qrn] standard_name = local_rain_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of rain water local to physics + long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -191,7 +191,7 @@ optional = F [qsnw] standard_name = local_snow_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of snow water local to physics + long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -200,7 +200,7 @@ optional = F [qgl] standard_name = local_graupel_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of graupel local to physics + long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -243,36 +243,9 @@ kind = kind_phys intent = inout optional = F -[qlcn] - standard_name = mass_fraction_of_convective_cloud_liquid_water - long_name = mass fraction of convective cloud liquid water - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[qicn] - standard_name = mass_fraction_of_convective_cloud_ice - long_name = mass fraction of convective cloud ice water - units = kg kg-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F -[cf_upi] - standard_name = convective_cloud_fraction_for_microphysics - long_name = convective cloud fraction for microphysics - units = frac - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [clw_water] standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) in the convectively transported tracer array + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -281,7 +254,7 @@ optional = F [clw_ice] standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -390,7 +363,7 @@ optional = F [qrn] standard_name = local_rain_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of rain water local to physics + long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -399,7 +372,7 @@ optional = F [qsnw] standard_name = local_snow_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of snow water local to physics + long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -408,7 +381,7 @@ optional = F [qgl] standard_name = local_graupel_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of graupel local to physics + long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) local to physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -417,7 +390,7 @@ optional = F [gq0_ice] standard_name = ice_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water updated by physics + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -426,7 +399,7 @@ optional = F [gq0_rain] standard_name = rain_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of rain water updated by physics + long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -435,7 +408,7 @@ optional = F [gq0_snow] standard_name = snow_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of snow water updated by physics + long_name = ratio of mass of snow water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -444,7 +417,7 @@ optional = F [gq0_graupel] standard_name = graupel_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of graupel updated by physics + long_name = ratio of mass of graupel to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/mfpbltq.f b/physics/mfpbltq.f index 0f4004444..a6fc22cef 100644 --- a/physics/mfpbltq.f +++ b/physics/mfpbltq.f @@ -3,7 +3,7 @@ !! updraft parcel properties for thermals driven by surface heating !! for use in the TKE-EDMF PBL scheme (updated version). -!>\ingroup satmedmfq +!>\ingroup satmedmfvdifq !! This subroutine computes mass flux and updraft parcel properties for !! thermals driven by surface heating. !!\section mfpbltq_gen GFS mfpblt General Algorithm diff --git a/physics/mfscuq.f b/physics/mfscuq.f index c6f66b74b..3390c3e58 100644 --- a/physics/mfscuq.f +++ b/physics/mfscuq.f @@ -2,7 +2,7 @@ !! This file contains the mass flux and downdraft parcel preperties !! parameterization for stratocumulus-top-driven turbulence (updated version). -!>\ingroup satmedmfq +!>\ingroup satmedmfvdifq !! This subroutine computes mass flux and downdraft parcel properties !! for stratocumulus-top-driven turbulence. !! \section mfscuq GFS mfscu General Algorithm diff --git a/physics/micro_mg2_0.F90 b/physics/micro_mg2_0.F90 index 281802878..744b46ebc 100644 --- a/physics/micro_mg2_0.F90 +++ b/physics/micro_mg2_0.F90 @@ -95,7 +95,6 @@ module micro_mg2_0 ! 2) saturation vapor pressure and specific humidity over water ! 3) svp over ice use machine, only : r8 => kind_phys -use physcons, only : epsqs => con_eps, fv => con_fvirt use funcphys, only : fpvsl, fpvsi !use wv_sat_methods, only: & @@ -183,7 +182,7 @@ module micro_mg2_0 real(r8) :: gamma_br_plus1, gamma_bs_plus1, gamma_bi_plus1, gamma_bj_plus1 real(r8) :: gamma_br_plus4, gamma_bs_plus4, gamma_bi_plus4, gamma_bj_plus4 real(r8) :: xxlv_squared, xxls_squared -real(r8) :: omeps +real(r8) :: omeps, epsqs character(len=16) :: micro_mg_precip_frac_method ! type of precipitation fraction method real(r8) :: micro_mg_berg_eff_factor ! berg efficiency factor @@ -200,7 +199,7 @@ module micro_mg2_0 !>\ingroup mg2_0_mp !! This subroutine calculates subroutine micro_mg_init( & - kind, gravit, rair, rh2o, cpair, & + kind, gravit, rair, rh2o, cpair, eps, & tmelt_in, latvap, latice, & rhmini_in, micro_mg_dcs,ts_auto, mg_qcvar, & microp_uniform_in, do_cldice_in, use_hetfrz_classnuc_in, & @@ -226,6 +225,8 @@ subroutine micro_mg_init( & real(r8), intent(in) :: rair real(r8), intent(in) :: rh2o real(r8), intent(in) :: cpair + real(r8), intent(in) :: eps +! real(r8), intent(in) :: fv real(r8), intent(in) :: tmelt_in !< Freezing point of water (K) real(r8), intent(in) :: latvap real(r8), intent(in) :: latice @@ -321,6 +322,7 @@ subroutine micro_mg_init( & xxlv_squared = xxlv * xxlv xxls_squared = xxls * xxls + epsqs = eps omeps = one - epsqs tmn = 173.16_r8 tmx = 375.16_r8 @@ -393,7 +395,7 @@ subroutine micro_mg_tend ( & drout2, dsout2, & freqs, freqr, & nfice, qcrat, & - prer_evap, xlat, xlon, lprnt, iccn, aero_in, nlball) + prer_evap, xlat, xlon, lprnt, iccn, nlball) ! Constituent properties. use micro_mg_utils, only: mg_liq_props, & @@ -464,7 +466,8 @@ subroutine micro_mg_tend ( & real(r8), intent(in) :: liqcldf(mgncol,nlev) ! liquid cloud fraction (no units) real(r8), intent(in) :: icecldf(mgncol,nlev) ! ice cloud fraction (no units) real(r8), intent(in) :: qsatfac(mgncol,nlev) ! subgrid cloud water saturation scaling factor (no units) - logical, intent(in) :: lprnt, iccn, aero_in + logical, intent(in) :: lprnt + integer, intent(in) :: iccn ! used for scavenging @@ -1113,7 +1116,7 @@ subroutine micro_mg_tend ( & enddo enddo - if(iccn) then + if(iccn == 1) then do k=1,nlev do i=1,mgncol npccn(i,k) = npccnin(i,k) @@ -1152,7 +1155,7 @@ subroutine micro_mg_tend ( & ncal = zero end where - if (iccn) then + if (iccn == 1) then do k=1,nlev do i=1,mgncol if (t(i,k) < icenuct) then @@ -1167,7 +1170,7 @@ subroutine micro_mg_tend ( & endif enddo enddo - elseif (aero_in) then + elseif (iccn == 2) then do k=1,nlev do i=1,mgncol if (t(i,k) < icenuct) then diff --git a/physics/micro_mg3_0.F90 b/physics/micro_mg3_0.F90 index d9d47a347..6164cf544 100644 --- a/physics/micro_mg3_0.F90 +++ b/physics/micro_mg3_0.F90 @@ -1,12 +1,14 @@ !>\file micro_mg3_0.F90 !! This file contains Morrison-Gettelman MP version 3.0 - -!! Update of MG microphysics with prognostic hai OR graupel. +!! Update of MG microphysics with prognostic hail OR graupel. !>\ingroup mg2mg3 !>\defgroup mg3_mp Morrison-Gettelman MP version 3.0 !> @{ -!! This module contains MG microphysics version 3.0 - Update of MG microphysics with -!! prognostic hail OR graupel. +!!--------------------------------------------------------------------------------- +!! Purpose: +!! MG microphysics version 3.0 - Update of MG microphysics with +!! prognostic hail OR graupel. !! !! \authors Andrew Gettelman, Hugh Morrison !! @@ -44,6 +46,9 @@ !! Part II: Global model solutions and Aerosol-Cloud Interactions. !! J. Climate, 28, 1288-1307. doi:10.1175/JCLI-D-14-00103.1 , 2015. !! +!! for questions contact Hugh Morrison, Andrew Gettelman +!! e-mail: morrison@ucar.edu, andrew@ucar.edu +!!--------------------------------------------------------------------------------- !! !! NOTE: Modified to allow other microphysics packages (e.g. CARMA) to do ice !! microphysics in cooperation with the MG liquid microphysics. This is @@ -122,7 +127,6 @@ module micro_mg3_0 use machine, only : r8 => kind_phys -use physcons, only : epsqs => con_eps, fv => con_fvirt use funcphys, only : fpvsl, fpvsi !use wv_sat_methods, only: & @@ -230,7 +234,7 @@ module micro_mg3_0 real(r8) :: gamma_br_plus1, gamma_bs_plus1, gamma_bi_plus1, gamma_bj_plus1, gamma_bg_plus1 real(r8) :: gamma_br_plus4, gamma_bs_plus4, gamma_bi_plus4, gamma_bj_plus4, gamma_bg_plus4 real(r8) :: xxlv_squared, xxls_squared -real(r8) :: omeps +real(r8) :: omeps, epsqs character(len=16) :: micro_mg_precip_frac_method !< type of precipitation fraction method real(r8) :: micro_mg_berg_eff_factor !< berg efficiency factor @@ -245,14 +249,16 @@ module micro_mg3_0 !=============================================================================== !>\ingroup mg3_mp -!! This subroutine initializes microphysics routine, should be called -!! once at start of simulation. +!! This subroutine initializes the microphysics +!! and needs to be called once at start of simulation. !!\author Andrew Gettelman, Dec 2005 subroutine micro_mg_init( & - kind, gravit, rair, rh2o, cpair, & + kind, gravit, rair, rh2o, cpair, eps, & tmelt_in, latvap, latice, & - rhmini_in, micro_mg_dcs,ts_auto, mg_qcvar, & !++ag - micro_mg_do_hail_in, micro_mg_do_graupel_in, &!--ag + rhmini_in, micro_mg_dcs,ts_auto, mg_qcvar, & +!++ag + micro_mg_do_hail_in, micro_mg_do_graupel_in, & +!--ag microp_uniform_in, do_cldice_in, use_hetfrz_classnuc_in, & micro_mg_precip_frac_method_in, micro_mg_berg_eff_factor_in, & allow_sed_supersat_in, do_sb_physics_in, & @@ -277,6 +283,8 @@ subroutine micro_mg_init( & real(r8), intent(in) :: rair real(r8), intent(in) :: rh2o real(r8), intent(in) :: cpair + real(r8), intent(in) :: eps +! real(r8), intent(in) :: fv real(r8), intent(in) :: tmelt_in ! Freezing point of water (K) real(r8), intent(in) :: latvap real(r8), intent(in) :: latice @@ -408,6 +416,7 @@ subroutine micro_mg_init( & xxlv_squared = xxlv * xxlv xxls_squared = xxls * xxls + epsqs = eps omeps = one - epsqs tmn = 173.16_r8 tmx = 375.16_r8 @@ -425,8 +434,7 @@ end subroutine micro_mg_init !microphysics routine for each timestep goes here... !>\ingroup mg3_mp -!! This subroutine calculates calculate -!! MG3 microphysical processes and other utilities. +!! This subroutine calculates the MG3 microphysical processes. !>\authors Hugh Morrison, Andrew Gettelman, NCAR, Peter Caldwell, LLNL !! e-mail: morrison@ucar.edu, andrew@ucar.edu !!\section mg3_micro_mg_tend MG3 micro_mg_tend General Algorithm @@ -437,8 +445,10 @@ subroutine micro_mg_tend ( & qcn, qin, & ncn, nin, & qrn, qsn, & - nrn, nsn, &!++ag - qgr, ngr, &!--ag + nrn, nsn, & +!++ag + qgr, ngr, & +!--ag relvar, accre_enhan_i, & p, pdel, & cldn, liqcldf, icecldf, qsatfac, & @@ -449,8 +459,10 @@ subroutine micro_mg_tend ( & qctend, qitend, & nctend, nitend, & qrtend, qstend, & - nrtend, nstend, &!++ag - qgtend, ngtend, &!--ag + nrtend, nstend, & +!++ag + qgtend, ngtend, & +!--ag effc, effc_fn, effi, & sadice, sadsnow, & prect, preci, & @@ -459,30 +471,43 @@ subroutine micro_mg_tend ( & prain, prodsnow, & cmeout, deffi, & pgamrad, lamcrad, & - qsout, dsout, &!++ag - qgout, ngout, dgout, &!--ag - lflx, iflx, &!++ag - gflx, &!--ag - rflx, sflx, qrout, &!++ag - reff_rain, reff_snow, reff_grau, &!--ag + qsout, dsout, & +!++ag + qgout, ngout, dgout, & +!--ag + lflx, iflx, & +!++ag + gflx, & +!--ag + rflx, sflx, qrout, & +!++ag + reff_rain, reff_snow, reff_grau, & +!--ag + qcsevap, qisevap, qvres, & cmeitot, vtrmc, vtrmi, & - umr, ums, &!++ag - umg, qgsedten, &!--ag + umr, ums, & +!++ag + umg, qgsedten, & +!--ag qcsedten, qisedten, & qrsedten, qssedten, & pratot, prctot, & mnuccctot, mnuccttot, msacwitot, & psacwstot, bergstot, bergtot, & melttot, homotot, & - qcrestot, prcitot, praitot, &!++ag - qirestot, mnuccrtot, mnuccritot, pracstot, &!--ag - meltsdttot, frzrdttot, mnuccdtot, &!++ag + qcrestot, prcitot, praitot, & +!++ag + qirestot, mnuccrtot, mnuccritot, pracstot, & +!--ag + meltsdttot, frzrdttot, mnuccdtot, & +!++ag pracgtot, psacwgtot, pgsacwtot, & pgracstot, prdgtot, & qmultgtot, qmultrgtot, psacrtot, & npracgtot, nscngtot, ngracstot, & - nmultgtot, nmultrgtot, npsacwgtot, &!--ag + nmultgtot, nmultrgtot, npsacwgtot, & +!--ag nrout, nsout, & refl, arefl, areflz, & frefl, csrfl, acsrfl, & @@ -490,11 +515,13 @@ subroutine micro_mg_tend ( & ncai, ncal, & qrout2, qsout2, & nrout2, nsout2, & - drout2, dsout2, &!++ag - qgout2, ngout2, dgout2, freqg, &!--ag + drout2, dsout2, & +!++ag + qgout2, ngout2, dgout2, freqg, & +!--ag freqs, freqr, & nfice, qcrat, & - prer_evap, xlat, xlon, lprnt, iccn, aero_in, nlball) + prer_evap, xlat, xlon, lprnt, iccn, nlball) ! Constituent properties. use micro_mg_utils, only: mg_liq_props, & @@ -583,8 +610,8 @@ subroutine micro_mg_tend ( & real(r8), intent(in) :: icecldf(mgncol,nlev) !< ice cloud fraction (no units) real(r8), intent(in) :: qsatfac(mgncol,nlev) !< subgrid cloud water saturation scaling factor (no units) logical, intent(in) :: lprnt !< control flag for diagnostic print out - logical, intent(in) :: iccn !< flag for IN and CCN forcing for Morrison-Gettelman microphysics - logical, intent(in) :: aero_in !< flag for using aerosols in Morrison-Gettelman microphysics + integer, intent(in) :: iccn !< flag for IN and CCN forcing for Morrison-Gettelman microphysics + ! used for scavenging @@ -1432,7 +1459,7 @@ subroutine micro_mg_tend ( & enddo enddo !> - initialize ccn activated number tendency (\p npccn) - if (iccn) then + if (iccn == 1) then do k=1,nlev do i=1,mgncol npccn(i,k) = npccnin(i,k) @@ -1486,7 +1513,7 @@ subroutine micro_mg_tend ( & enddo enddo - if (iccn) then + if (iccn == 1) then do k=1,nlev do i=1,mgncol if (t(i,k) < icenuct) then @@ -1501,11 +1528,13 @@ subroutine micro_mg_tend ( & endif enddo enddo - elseif (aero_in) then + elseif (iccn == 2) then do k=1,nlev do i=1,mgncol if (t(i,k) < icenuct) then ncai(i,k) = naai(i,k)*rho(i,k) + ncai(i,k) = min(ncai(i,k), 710.0e3_r8) + naai(i,k) = ncai(i,k)*rhoinv(i,k) else naai(i,k) = zero ncai(i,k) = zero @@ -1592,7 +1621,7 @@ subroutine micro_mg_tend ( & tlat(i,k) = tlat(i,k) + dum1 meltsdttot(i,k) = meltsdttot(i,k) + dum1 -! if (lprnt .and. k >=100) write(0,*)' tlats=',tlat(i,k),' dum1=',dum1,& +! if (lprnt .and. k >=40) write(0,*)' tlats=',tlat(i,k),' dum1=',dum1,& ! ' minstsm=',minstsm(i,k),' qs=',qs(i,k),' xlf=',xlf,' oneodt=',oneodt, & ! ' snowmelt=',snowmelt,' t=',t(i,k),' dum=',dum,' k=',k @@ -1634,7 +1663,7 @@ subroutine micro_mg_tend ( & tlat(i,k) = dum1 + tlat(i,k) meltsdttot(i,k) = dum1 + meltsdttot(i,k) -! if (lprnt .and. k >=100) write(0,*)' tlatg=',tlat(i,k),' dum1=',dum1,& +! if (lprnt .and. k >=40) write(0,*)' tlatg=',tlat(i,k),' dum1=',dum1,& ! ' minstgm=',minstgm(i,k),' qg=',qg(i,k),' xlf=',xlf,' oneodt=',oneodt, & ! ' snowmelt=',snowmelt,' t=',t(i,k),' k=',k,' cpp=',cpp @@ -2162,6 +2191,10 @@ subroutine micro_mg_tend ( & call bergeron_process_snow(t(:,k), rho(:,k), dv(:,k), mu(:,k), sc(:,k), & qvl(:,k), qvi(:,k), asn(:,k), qcic(:,k), qsic(:,k), lams(:,k), n0s(:,k), & bergs(:,k), mgncol) +! if(lprnt) write(0,*)' bergs1=',bergs(1,k),' k=',k,' micro_mg_berg_eff_factor=',micro_mg_berg_eff_factor +! if(lprnt) write(0,*)' t=',t(1,k),' rho=',rho(1,k),' dv=',dv(1,k),' mu=',mu(1,k),& +! 'qcic=',qcic(1,k),' qsic=',qsic(1,k),' qvl=',qvl(1,k),' qvi=',qvi(1,k), & +! ' mu=',mu(1,k),' sc=',sc(1,k),' asn=',asn(1,k),' lams=',lams(1,k),' n0s=',n0s(1,k),' ni=',ni(1,k) bergs(:,k) = bergs(:,k) * micro_mg_berg_eff_factor @@ -2172,6 +2205,11 @@ subroutine micro_mg_tend ( & icldm(:,k), rho(:,k), dv(:,k), qvl(:,k), qvi(:,k), & berg(:,k), vap_dep(:,k), ice_sublim(:,k), mgncol) +! if(lprnt) write(0,*)' t=',t(1,k),' k=',k,' q=',q(1,k),' qi=',qi(1,k),& +! ' ni=',ni(1,k),' icldm=',icldm(1,k),' rho=',rho(1,k),' dv=',dv(1,k),& +! ' qvl=',qvl(1,k),' qvi=',qvi(1,k),' berg=',berg(1,k),' vap_dep=',& +! vap_dep(1,k),' ice_sublim=',ice_sublim(1,k) +! if(lprnt) write(0,*)' berg1=',berg(1,k),' k=',k,' micro_mg_berg_eff_factor=',micro_mg_berg_eff_factor do i=1,mgncol ! sublimation should not exceed available ice ice_sublim(i,k) = max(ice_sublim(i,k), -qi(i,k)*oneodt) @@ -2347,6 +2385,8 @@ subroutine micro_mg_tend ( & qcrat(i,k) = one end if +! if(lprnt) write(0,*)' bergs2=',bergs(1,k),' k=',k,' ratio=',ratio + !PMC 12/3/12: ratio is also frac of step w/ liquid. !thus we apply berg for "ratio" of timestep and vapor !deposition for the remaining frac of the timestep. @@ -2417,13 +2457,11 @@ subroutine micro_mg_tend ( & if (do_cldice) then ! freezing of rain to produce ice if mean rain size is smaller than Dcs - if (lamr(i,k) > qsmall) then - if(one/lamr(i,k) < Dcs) then - mnuccri(i,k) = mnuccr(i,k) - nnuccri(i,k) = nnuccr(i,k) - mnuccr(i,k) = zero - nnuccr(i,k) = zero - end if + if (lamr(i,k) > qsmall .and. one/lamr(i,k) < Dcs) then + mnuccri(i,k) = mnuccr(i,k) + nnuccri(i,k) = nnuccr(i,k) + mnuccr(i,k) = zero + nnuccr(i,k) = zero end if end if @@ -2820,11 +2858,11 @@ subroutine micro_mg_tend ( & ! if (lprnt) write(0,*)' k=',k,' tlat=',tlat(i,k) ! if (lprnt .and. k >= 60) write(0,*)' k=',k,' tlat=',tlat(i,k) -! qctend(i,k) = qctend(i,k) + (-pra(i,k)-prc(i,k)-mnuccc(i,k)-mnucct(i,k)-msacwi(i,k)- & -! psacws(i,k)-bergs(i,k))*l!ldm(i,k)-berg(i,k) +! qctend(i,k) = qctend(i,k) + (-pra(i,k)-prc(i,k)-mnuccc(i,k)-mnucct(i,k)-msacwi(i,k)- & +! psacws(i,k)-bergs(i,k))*lcldm(i,k)-berg(i,k) - qctend(i,k) = qctend(i,k)+ & - (-pra(i,k)-prc(i,k)-mnuccc(i,k)-mnucct(i,k)-msacwi(i,k)- & + qctend(i,k) = qctend(i,k) + & + (-pra(i,k)-prc(i,k)-mnuccc(i,k)-mnucct(i,k)-msacwi(i,k) - & psacws(i,k)-bergs(i,k)-qmultg(i,k)-psacwg(i,k)-pgsacw(i,k))*lcldm(i,k)-berg(i,k) if (do_cldice) then @@ -3662,7 +3700,7 @@ subroutine micro_mg_tend ( & end do !! nstep loop ! if (lprnt) write(0,*)' prectaftssno=',prect(i),' preci=',preci(i) -! if (lprnt) write(0,*)' qgtnd1=',qgtend(1,:) +! if (lprnt) write(0,*)' qgtnd1=',qgtend(1,:) if (do_graupel .or. do_hail) then !++ag Graupel Sedimentation @@ -4446,7 +4484,7 @@ end subroutine micro_mg_tend !======================================================================== !>\ingroup mg3_mp -!! This subroutine calculates effective radius for rain and cloud. +!! This subroutine calculates effective radii for rain and cloud. subroutine calc_rercld(lamr, n0r, lamc, pgam, qric, qcic, ncic, rercld, mgncol,nlev) integer, intent(in) :: mgncol, nlev ! horizontal and vertical dimension real(r8), dimension(mgncol,nlev), intent(in) :: lamr ! rain size parameter (slope) diff --git a/physics/micro_mg_utils.F90 b/physics/micro_mg_utils.F90 index 51178813c..74da36df4 100644 --- a/physics/micro_mg_utils.F90 +++ b/physics/micro_mg_utils.F90 @@ -839,7 +839,7 @@ end function var_coef_integer !! Initial ice deposition and sublimation loop. !! Run before the main loop !! This subroutine written by Peter Caldwell -subroutine ice_deposition_sublimation(t, qv, qi, ni, & +subroutine ice_deposition_sublimation(t, qv, qi, ni, & icldm, rho, dv,qvl, qvi, & berg, vap_dep, ice_sublim, mgncol) @@ -2656,7 +2656,7 @@ end subroutine graupel_rime_splintering ! prdg(i) = epsg*(q(i)-qvi(i))/abi ! !! make sure not pushed into ice supersat/subsat -!! put this in main mg3 code…..check for it… +!! put this in main mg3 code ... check for it ... !! formula from reisner 2 scheme !! diff --git a/physics/module_MYJPBL_wrapper.meta b/physics/module_MYJPBL_wrapper.meta index a70203def..dd2560e06 100644 --- a/physics/module_MYJPBL_wrapper.meta +++ b/physics/module_MYJPBL_wrapper.meta @@ -446,7 +446,7 @@ intent = inout optional = F [hflx] - standard_name = kinematic_surface_upward_sensible_heat_flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 dimensions = (horizontal_dimension) @@ -455,7 +455,7 @@ intent = in optional = F [evap] - standard_name = kinematic_surface_upward_latent_heat_flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 dimensions = (horizontal_dimension) diff --git a/physics/module_MYNNPBL_wrapper.F90 b/physics/module_MYNNPBL_wrapper.F90 index 1ba309729..e6c553350 100644 --- a/physics/module_MYNNPBL_wrapper.F90 +++ b/physics/module_MYNNPBL_wrapper.F90 @@ -10,7 +10,23 @@ MODULE mynnedmf_wrapper contains - subroutine mynnedmf_wrapper_init () + subroutine mynnedmf_wrapper_init (lheatstrg, errmsg, errflg) + implicit none + + logical, intent(in) :: lheatstrg + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (lheatstrg) then + errmsg = 'Logic error: lheatstrg not implemented for MYNN PBL' + errflg = 1 + return + end if + end subroutine mynnedmf_wrapper_init subroutine mynnedmf_wrapper_finalize () @@ -36,8 +52,8 @@ SUBROUTINE mynnedmf_wrapper_run( & & qgrs_ice_aer_num_conc, & & prsl,exner, & & slmsk,tsurf,qsfc,ps, & - & ust,ch,hflx,qflx,wspd,rb, & - & dtsfc1,dqsfc1, & + & ust,ch,hflx,qflx, & + & wspd,rb,dtsfc1,dqsfc1, & & dtsfci_diag,dqsfci_diag, & & dtsfc_diag,dqsfc_diag, & & recmol, & @@ -49,7 +65,6 @@ SUBROUTINE mynnedmf_wrapper_run( & & edmf_thl,edmf_ent,edmf_qc, & & sub_thl,sub_sqv,det_thl,det_sqv,& & nupdraft,maxMF,ktop_plume, & - & RTHRATEN, & & dudt, dvdt, dtdt, & & dqdt_water_vapor, dqdt_liquid_cloud, & & dqdt_ice_cloud, dqdt_ozone, & @@ -154,7 +169,7 @@ SUBROUTINE mynnedmf_wrapper_run( & character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg - + LOGICAL, INTENT(IN) :: lssav, ldiag3d, lsidea, qdiag3d ! NAMELIST OPTIONS (INPUT): LOGICAL, INTENT(IN) :: bl_mynn_tkeadvect, ltaerosol, & @@ -224,8 +239,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & qgrs_cloud_ice_num_conc, & & qgrs_ozone, & & qgrs_water_aer_num_conc, & - & qgrs_ice_aer_num_conc, & - & RTHRATEN + & qgrs_ice_aer_num_conc real(kind=kind_phys), dimension(im,levs), intent(out) :: & & Tsq, Qsq, Cov, exch_h, exch_m real(kind=kind_phys), dimension(:,:), intent(inout) :: & @@ -254,13 +268,14 @@ SUBROUTINE mynnedmf_wrapper_run( & real(kind=kind_phys), dimension(im), intent(in) :: & & dx,zorl,slmsk,tsurf,qsfc,ps, & & hflx,qflx,ust,wspd,rb,recmol + real(kind=kind_phys), dimension(im), intent(inout) :: & & pblh real(kind=kind_phys), dimension(im), intent(out) :: & & ch,dtsfc1,dqsfc1, & & dtsfci_diag,dqsfci_diag,dtsfc_diag,dqsfc_diag, & & maxMF - integer, dimension(im), intent(inout) :: & + integer, dimension(im), intent(inout) :: & & kpbl,nupdraft,ktop_plume !LOCAL @@ -576,7 +591,7 @@ SUBROUTINE mynnedmf_wrapper_run( & & ,nupdraft=nupdraft,maxMF=maxMF & !output & ,ktop_plume=ktop_plume & !output & ,spp_pbl=spp_pbl,pattern_spp_pbl=pattern_spp_pbl & !input - & ,RTHRATEN=RTHRATEN & !input + & ,RTHRATEN=htrlw & !input & ,FLAG_QI=flag_qi,FLAG_QNI=flag_qni & !input & ,FLAG_QC=flag_qc,FLAG_QNC=flag_qnc & !input & ,FLAG_QNWFA=FLAG_QNWFA,FLAG_QNIFA=FLAG_QNIFA & !input diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index 6ef588066..393ad5292 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -1,3 +1,32 @@ +[ccpp-arg-table] + name = mynnedmf_wrapper_init + type = scheme +[lheatstrg] + standard_name = flag_for_canopy_heat_storage + long_name = flag for canopy heat storage parameterization + units = flag + dimensions = () + type = logical + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + [ccpp-arg-table] name = mynnedmf_wrapper_run type = scheme @@ -171,7 +200,7 @@ optional = F [qgrs_liquid_cloud] standard_name = cloud_condensed_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -180,7 +209,7 @@ optional = F [qgrs_ice_cloud] standard_name = ice_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -305,8 +334,8 @@ intent = out optional = F [hflx] - standard_name = kinematic_surface_upward_sensible_heat_flux - long_name = kinematic surface upward sensible heat flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward sensible heat flux reduced by surface roughness units = K m s-1 dimensions = (horizontal_dimension) type = real @@ -314,8 +343,8 @@ intent = in optional = F [qflx] - standard_name = kinematic_surface_upward_latent_heat_flux - long_name = kinematic surface upward latent heat flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward latent heat flux reduced by surface roughness units = kg kg-1 m s-1 dimensions = (horizontal_dimension) type = real @@ -643,15 +672,6 @@ type = integer intent = inout optional = F -[RTHRATEN] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step - long_name = total sky longwave heating rate - units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) - type = real - kind = kind_phys - intent = in - optional = F [dudt] standard_name = tendency_of_x_wind_due_to_model_physics long_name = updated tendency of the x wind @@ -811,7 +831,7 @@ type = real kind = kind_phys [htrsw] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_timestep + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky sw heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -820,7 +840,7 @@ intent = in optional = F [htrlw] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_timestep + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky lw heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) diff --git a/physics/module_MYNNSFC_wrapper.meta b/physics/module_MYNNSFC_wrapper.meta index b12837233..a58253c08 100644 --- a/physics/module_MYNNSFC_wrapper.meta +++ b/physics/module_MYNNSFC_wrapper.meta @@ -121,7 +121,7 @@ optional = F [qc] standard_name = cloud_condensed_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/module_SGSCloud_RadPost.meta b/physics/module_SGSCloud_RadPost.meta index f56bd30df..b3a5bce2b 100644 --- a/physics/module_SGSCloud_RadPost.meta +++ b/physics/module_SGSCloud_RadPost.meta @@ -43,7 +43,7 @@ optional = F [qc] standard_name = cloud_condensed_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) + long_name = no condensates) ratio of mass of cloud water to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -52,7 +52,7 @@ optional = F [qi] standard_name = ice_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -61,7 +61,7 @@ optional = F [qc_save] standard_name = cloud_condensed_water_mixing_ratio_save - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) before entering a physics scheme + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -70,7 +70,7 @@ optional = F [qi_save] standard_name = ice_water_mixing_ratio_save - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water before entering a physics scheme + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) before entering a physics scheme units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/module_SGSCloud_RadPre.meta b/physics/module_SGSCloud_RadPre.meta index f8da4b262..f959e66ef 100644 --- a/physics/module_SGSCloud_RadPre.meta +++ b/physics/module_SGSCloud_RadPre.meta @@ -53,7 +53,7 @@ optional = F [qc] standard_name = cloud_condensed_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -62,7 +62,7 @@ optional = F [qi] standard_name = ice_water_mixing_ratio - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -123,7 +123,7 @@ optional = F [qc_save] standard_name = cloud_condensed_water_mixing_ratio_save - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) before entering a physics scheme + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) before entering a physics scheme units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -132,7 +132,7 @@ optional = F [qi_save] standard_name = ice_water_mixing_ratio_save - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water before entering a physics scheme + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) before entering a physics scheme units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/module_mp_thompson.F90 b/physics/module_mp_thompson.F90 index 87a1ff132..b5c8da161 100644 --- a/physics/module_mp_thompson.F90 +++ b/physics/module_mp_thompson.F90 @@ -1006,7 +1006,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & ids,ide, jds,jde, kds,kde, & ! domain dims ims,ime, jms,jme, kms,kme, & ! memory dims its,ite, jts,jte, kts,kte, & ! tile dims - errmsg, errflg) + errmsg, errflg, reset) implicit none @@ -1044,6 +1044,7 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & vt_dbz_wt LOGICAL, OPTIONAL, INTENT(IN) :: first_time_step REAL, INTENT(IN):: dt_in + LOGICAL, INTENT (IN) :: reset !..Local variables REAL, DIMENSION(kts:kte):: & @@ -1066,6 +1067,8 @@ 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 + logical :: melti = .false. + ! CCPP error handling character(len=*), optional, intent( out) :: errmsg integer, optional, intent( out) :: errflg @@ -1361,15 +1364,26 @@ SUBROUTINE mp_gt_driver(qv, qc, qr, qi, qs, qg, ni, nr, nc, & enddo !> - Call calc_refl10cm() + IF ( PRESENT (diagflag) ) THEN if (diagflag .and. do_radar_ref == 1) then +! + ! Only set melti to true at the output times + if (reset) then + melti=.true. + else + melti=.false. + endif +! if (present(vt_dbz_wt) .and. present(first_time_step)) then call calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & - t1d, p1d, dBZ, kts, kte, i, j, & - vt_dbz_wt(i,:,j), first_time_step) + t1d, p1d, dBZ, kts, kte, i, j, & + melti, vt_dbz_wt(i,:,j), & + first_time_step) else - call calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & - t1d, p1d, dBZ, kts, kte, i, j) + call calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & + t1d, p1d, dBZ, kts, kte, i, j, & + melti) end if do k = kts, kte refl_10cm(i,k,j) = MAX(-35., dBZ(k)) @@ -1576,7 +1590,7 @@ subroutine mp_thompson (qv1d, qc1d, qi1d, qr1d, qs1d, qg1d, ni1d, & INTEGER:: idx_tc, idx_t, idx_s, idx_g1, idx_g, idx_r1, idx_r, & idx_i1, idx_i, idx_c, idx, idx_d, idx_n, idx_in - LOGICAL:: melti, no_micro + LOGICAL:: no_micro LOGICAL, DIMENSION(kts:kte):: L_qc, L_qi, L_qr, L_qs, L_qg LOGICAL:: debug_flag INTEGER:: nu_c @@ -5202,8 +5216,9 @@ end subroutine calc_effectRad !! library of routines. The meltwater fraction is simply the amount !! of frozen species remaining from what initially existed at the !! melting level interface. - subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & - t1d, p1d, dBZ, kts, kte, ii, jj, vt_dBZ, first_time_step) + subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & + t1d, p1d, dBZ, kts, kte, ii, jj, melti, vt_dBZ, & + first_time_step) IMPLICIT NONE @@ -5236,7 +5251,7 @@ subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & DOUBLE PRECISION:: fmelt_s, fmelt_g INTEGER:: i, k, k_0, kbot, n - LOGICAL:: melti + LOGICAL, INTENT(IN):: melti LOGICAL, DIMENSION(kts:kte):: L_qr, L_qs, L_qg DOUBLE PRECISION:: cback, x, eta, f_d @@ -5389,18 +5404,16 @@ subroutine calc_refl10cm (qv1d, qc1d, qr1d, nr1d, qs1d, qg1d, & !+---+-----------------------------------------------------------------+ !..Locate K-level of start of melting (k_0 is level above). !+---+-----------------------------------------------------------------+ - melti = .false. k_0 = kts - do k = kte-1, kts, -1 - if ( (temp(k).gt.273.15) .and. L_qr(k) & + if ( melti ) then + K_LOOP:do k = kte-1, kts, -1 + if ((temp(k).gt.273.15) .and. L_qr(k) & & .and. (L_qs(k+1).or.L_qg(k+1)) ) then - k_0 = MAX(k+1, k_0) - melti=.true. - goto 195 - endif - enddo - 195 continue - + k_0 = MAX(k+1, k_0) + EXIT K_LOOP + endif + enddo K_LOOP + endif !+---+-----------------------------------------------------------------+ !..Assume Rayleigh approximation at 10 cm wavelength. Rain (all temps) !.. and non-water-coated snow and graupel when below freezing are diff --git a/physics/module_sf_noahmplsm.f90 b/physics/module_sf_noahmplsm.f90 index a0612d417..02ea70a6e 100644 --- a/physics/module_sf_noahmplsm.f90 +++ b/physics/module_sf_noahmplsm.f90 @@ -291,7 +291,6 @@ subroutine noahmp_sflx (parameters, & qc , soldn , lwdn , & ! in : forcing prcpconv, prcpnonc, prcpshcv, prcpsnow, prcpgrpl, prcphail, & ! in : forcing tbot , co2air , o2air , foln , ficeold , zlvl , & ! in : forcing - lheatstrg , & ! in : canopy heat storage albold , sneqvo , & ! in/out : stc , sh2o , smc , tah , eah , fwet , & ! in/out : canliq , canice , tv , tg , qsfc , qsnow , & ! in/out : @@ -299,9 +298,9 @@ subroutine noahmp_sflx (parameters, & zwt , wa , wt , wslake , lfmass , rtmass , & ! in/out : stmass , wood , stblcp , fastcp , lai , sai , & ! in/out : cm , ch , tauss , & ! in/out : - smcwtd ,deeprech , rech , cpfac , & ! in/out : + smcwtd ,deeprech , rech , & ! in/out : z0wrf , & - fsa , fsr , fira , fshx , ssoil , fcev , & ! out : + fsa , fsr , fira , fsh , ssoil , fcev , & ! out : fgev , fctr , ecan , etran , edir , trad , & ! out : tgb , tgv , t2mv , t2mb , q2v , q2b , & ! out : runsrf , runsub , apar , psn , sav , sag , & ! out : @@ -342,7 +341,6 @@ subroutine noahmp_sflx (parameters, & real , intent(in) :: lwdn !downward longwave radiation (w/m2) real , intent(in) :: sfcprs !pressure (pa) real , intent(inout) :: zlvl !reference height (m) - logical , intent(in) :: lheatstrg ! flag for canopy heat storage parameterization real , intent(in) :: cosz !cosine solar zenith angle [0-1] real , intent(in) :: tbot !bottom condition for soil temp. [k] real , intent(in) :: foln !foliage nitrogen (%) [1-saturated] @@ -401,14 +399,13 @@ subroutine noahmp_sflx (parameters, & real, intent(inout) :: smcwtd !soil water content between bottom of the soil and water table [m3/m3] real, intent(inout) :: deeprech !recharge to or from the water table when deep [m] real, intent(inout) :: rech !recharge to or from the water table when shallow [m] (diagnostic) - real, intent(inout) :: cpfac ! heat capacity enhancement factor due to heat storage ! output real , intent(out) :: z0wrf !combined z0 sent to coupled model real , intent(out) :: fsa !total absorbed solar radiation (w/m2) real , intent(out) :: fsr !total reflected solar radiation (w/m2) real , intent(out) :: fira !total net lw rad (w/m2) [+ to atm] - real , intent(out) :: fshx !total sensible heat (w/m2) [+ to atm] + real , intent(out) :: fsh !total sensible heat (w/m2) [+ to atm] real , intent(out) :: fcev !canopy evap heat (w/m2) [+ to atm] real , intent(out) :: fgev !ground evap heat (w/m2) [+ to atm] real , intent(out) :: fctr !transpiration heat (w/m2) [+ to atm] @@ -458,7 +455,6 @@ subroutine noahmp_sflx (parameters, & real :: taux !wind stress: e-w (n/m2) real :: tauy !wind stress: n-s (n/m2) real :: rhoair !density air (kg/m3) - real :: fsh !total sensible heat (w/m2) [+ to atm] ! real, dimension( 1: 5) :: vocflx !voc fluxes [ug c m-2 h-1] real, dimension(-nsnow+1:nsoil) :: dzsnso !snow/soil layer thickness [m] real :: thair !potential temperature (k) @@ -649,7 +645,6 @@ subroutine noahmp_sflx (parameters, & call energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in isnow ,dt ,rhoair ,sfcprs ,qair , & !in sfctmp ,thair ,lwdn ,uu ,vv ,zlvl , & !in - lheatstrg , & !in co2air ,o2air ,solad ,solai ,cosz ,igs , & !in eair ,tbot ,zsnso ,zsoil , & !in elai ,esai ,fwet ,foln , & !in @@ -658,16 +653,16 @@ subroutine noahmp_sflx (parameters, & z0wrf , & imelt ,snicev ,snliqv ,epore ,t2m ,fsno , & !out sav ,sag ,qmelt ,fsa ,fsr ,taux , & !out - tauy ,fira ,fsh ,fshx ,fcev ,fgev ,fctr , & !out + tauy ,fira ,fsh ,fcev ,fgev ,fctr , & !out trad ,psn ,apar ,ssoil ,btrani ,btran , & !out ponding,ts ,latheav , latheag , frozen_canopy,frozen_ground, & !out tv ,tg ,stc ,snowh ,eah ,tah , & !inout sneqvo ,sneqv ,sh2o ,smc ,snice ,snliq , & !inout albold ,cm ,ch ,dx ,dz8w ,q2 , & !inout #ifdef CCPP - tauss ,cpfac ,errmsg ,errflg , & !inout + tauss ,errmsg ,errflg , & !inout #else - tauss ,cpfac , & !inout + tauss , & !inout #endif !jref:start qc ,qsfc ,psfc , & !in @@ -1428,7 +1423,6 @@ end subroutine error subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in isnow ,dt ,rhoair ,sfcprs ,qair , & !in sfctmp ,thair ,lwdn ,uu ,vv ,zref , & !in - lheatstrg , & !in co2air ,o2air ,solad ,solai ,cosz ,igs , & !in eair ,tbot ,zsnso ,zsoil , & !in elai ,esai ,fwet ,foln , & !in @@ -1437,16 +1431,16 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in z0wrf , & imelt ,snicev ,snliqv ,epore ,t2m ,fsno , & !out sav ,sag ,qmelt ,fsa ,fsr ,taux , & !out - tauy ,fira ,fsh ,fshx ,fcev ,fgev ,fctr , & !out + tauy ,fira ,fsh ,fcev ,fgev ,fctr , & !out trad ,psn ,apar ,ssoil ,btrani ,btran , & !out ponding,ts ,latheav , latheag , frozen_canopy,frozen_ground, & !out tv ,tg ,stc ,snowh ,eah ,tah , & !inout sneqvo ,sneqv ,sh2o ,smc ,snice ,snliq , & !inout albold ,cm ,ch ,dx ,dz8w ,q2 , & !inout #ifdef CCPP - tauss ,cpfac ,errmsg ,errflg, & !inout + tauss ,errmsg ,errflg, & !inout #else - tauss ,cpfac , & !inout + tauss , & !inout #endif !jref:start qc ,qsfc ,psfc , & !in @@ -1528,7 +1522,6 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in real , intent(in) :: igs !growing season index (0=off, 1=on) real , intent(in) :: zref !reference height (m) - logical , intent(in) :: lheatstrg ! flag for canopy heat storage parameterization real , intent(in) :: tbot !bottom condition for soil temp. (k) real , dimension(-nsnow+1:nsoil), intent(in) :: zsnso !layer-bottom depth from snow surf [m] real , dimension( 1:nsoil), intent(in) :: zsoil !layer-bottom depth from soil surf [m] @@ -1563,7 +1556,6 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in real , intent(out) :: tauy !wind stress: n-s (n/m2) real , intent(out) :: fira !total net lw. rad (w/m2) [+ to atm] real , intent(out) :: fsh !total sensible heat (w/m2) [+ to atm] - real , intent(out) :: fshx !total sensible heat (w/m2) [+ to atm] real , intent(out) :: fcev !canopy evaporation (w/m2) [+ to atm] real , intent(out) :: fgev !ground evaporation (w/m2) [+ to atm] real , intent(out) :: fctr !transpiration (w/m2) [+ to atm] @@ -1610,7 +1602,6 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in real , intent(inout) :: tah !canopy air temperature (k) real , intent(inout) :: albold !snow albedo at last time step(class type) real , intent(inout) :: tauss !non-dimensional snow age - real , intent(inout) :: cpfac !heat capacity enhancement factor due to heat storage real , intent(inout) :: cm !momentum drag coefficient real , intent(inout) :: ch !sensible heat exchange coefficient real , intent(inout) :: q1 @@ -1712,11 +1703,6 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in real, parameter :: mpe = 1.e-6 real, parameter :: psiwlt = -150. !metric potential for wilting point (m) real, parameter :: z0 = 0.01 ! bare-soil roughness length (m) (i.e., under the canopy) -! -! parameters for heat storage parametrization -! - real, parameter :: z0min = 0.2 !minimum roughness length for heat storage - real, parameter :: z0max = 1.0 !maximum roughness length for heat storage ! --------------------------------------------------------------------------------------------------- ! initialize fluxes from veg. fraction @@ -1782,13 +1768,6 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in z0m = z0mg zpd = zpdg end if -! -! compute heat capacity enhancement factor as a function of z0m to mimic heat storage -! - if (lheatstrg .and. (.not. parameters%urban_flag) ) then - cpfac = (z0m - z0min) / (z0max - z0min) - cpfac = 1. + min(max(cpfac, 0.0), 1.0) - endif zlvl = max(zpd,parameters%hvt) + zref if(zpdg >= zlvl) zlvl = zpdg + zref @@ -1893,7 +1872,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in latheav = hsub frozen_canopy = .true. end if - gammav = cpair*cpfac*sfcprs/(0.622*latheav) + gammav = cpair*sfcprs/(0.622*latheav) if (tg .gt. tfrz) then latheag = hvap @@ -1902,14 +1881,14 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in latheag = hsub frozen_ground = .true. end if - gammag = cpair*cpfac*sfcprs/(0.622*latheag) + gammag = cpair*sfcprs/(0.622*latheag) ! if (sfctmp .gt. tfrz) then ! lathea = hvap ! else ! lathea = hsub ! end if -! gamma = cpair*cpfac*sfcprs/(0.622*lathea) +! gamma = cpair*sfcprs/(0.622*lathea) ! surface temperatures of the ground and canopy and energy fluxes @@ -1924,7 +1903,7 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in uu ,vv ,sfctmp ,thair ,qair , & !in eair ,rhoair ,snowh ,vai ,gammav ,gammag , & !in fwet ,laisun ,laisha ,cwp ,dzsnso , & !in - zlvl ,cpfac ,zpd ,z0m ,fveg , & !in + zlvl ,zpd ,z0m ,fveg , & !in z0mg ,emv ,emg ,canliq ,fsno, & !in canice ,stc ,df ,rssun ,rssha , & !in rsurf ,latheav ,latheag ,parsun ,parsha ,igs , & !in @@ -1980,7 +1959,6 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in tauy = fveg * tauyv + (1.0 - fveg) * tauyb fira = fveg * irg + (1.0 - fveg) * irb + irc fsh = fveg * shg + (1.0 - fveg) * shb + shc - fshx = fveg * shg/cpfac + (1.0 - fveg) * shb + shc/cpfac fgev = fveg * evg + (1.0 - fveg) * evb ssoil = fveg * ghv + (1.0 - fveg) * ghb fcev = evc @@ -1999,7 +1977,6 @@ subroutine energy (parameters,ice ,vegtyp ,ist ,nsnow ,nsoil , & !in tauy = tauyb fira = irb fsh = shb - fshx = shb fgev = evb ssoil = ghb tg = tgb @@ -3305,8 +3282,7 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & uu ,vv ,sfctmp ,thair ,qair , & !in eair ,rhoair ,snowh ,vai ,gammav ,gammag, & !in fwet ,laisun ,laisha ,cwp ,dzsnso , & !in - zlvl ,cpfac , & !in - zpd ,z0m ,fveg , & !in + zlvl ,zpd ,z0m ,fveg , & !in z0mg ,emv ,emg ,canliq ,fsno, & !in canice ,stc ,df ,rssun ,rssha , & !in rsurf ,latheav ,latheag ,parsun ,parsha ,igs , & !in @@ -3366,7 +3342,6 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & real, intent(in) :: laisun !sunlit leaf area index, one-sided (m2/m2) real, intent(in) :: laisha !shaded leaf area index, one-sided (m2/m2) real, intent(in) :: zlvl !reference height (m) - real, intent(in) :: cpfac !heat capacity enhancement factor due to heat storage real, intent(in) :: zpd !zero plane displacement (m) real, intent(in) :: z0m !roughness length, momentum (m) @@ -3724,7 +3699,7 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & cond = cah + cvh + cgh ata = (sfctmp*cah + tg*cgh) / cond bta = cvh/cond - csh = (1.-bta)*rhoair*cpair*cpfac*cvh + csh = (1.-bta)*rhoair*cpair*cvh ! prepare for latent heat flux above veg. @@ -3735,8 +3710,8 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & cond = caw + cew + ctw + cgw aea = (eair*caw + estg*cgw) / cond bea = (cew+ctw)/cond - cev = (1.-bea)*cew*rhoair*cpair*cpfac/gammav ! barlage: change to vegetation v3.6 - ctr = (1.-bea)*ctw*rhoair*cpair*cpfac/gammav + cev = (1.-bea)*cew*rhoair*cpair/gammav ! barlage: change to vegetation v3.6 + ctr = (1.-bea)*ctw*rhoair*cpair/gammav ! evaluate surface fluxes with current temperature and solve for dts @@ -3744,9 +3719,9 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & eah = aea + bea*estv ! canopy air e irc = fveg*(air + cir*tv**4) - shc = fveg*rhoair*cpair*cpfac*cvh * ( tv-tah) - evc = fveg*rhoair*cpair*cpfac*cew * (estv-eah) / gammav ! barlage: change to v in v3.6 - tr = fveg*rhoair*cpair*cpfac*ctw * (estv-eah) / gammav + shc = fveg*rhoair*cpair*cvh * ( tv-tah) + evc = fveg*rhoair*cpair*cew * (estv-eah) / gammav ! barlage: change to v in v3.6 + tr = fveg*rhoair*cpair*ctw * (estv-eah) / gammav if (tv > tfrz) then evc = min(canliq*latheav/dt,evc) ! barlage: add if block for canice in v3.6 else @@ -3786,8 +3761,8 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & air = - emg*(1.-emv)*lwdn - emg*emv*sb*tv**4 cir = emg*sb - csh = rhoair*cpair*cpfac/rahg - cev = rhoair*cpair*cpfac / (gammag*(rawg+rsurf)) ! barlage: change to ground v3.6 + csh = rhoair*cpair/rahg + cev = rhoair*cpair / (gammag*(rawg+rsurf)) ! barlage: change to ground v3.6 cgh = 2.*df(isnow+1)/dzsnso(isnow+1) ! write(*,*)'inside tg=',tg,'stc(1)=',stc(1) @@ -3842,10 +3817,10 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & ! consistent vegetation air temperature and vapor pressure since tg is not consistent with the tah/eah ! calculation. -! tah = sfctmp + (shg+shc)/(rhoair*cpair*cpfac*cah) -! tah = sfctmp + (shg*fveg+shc)/(rhoair*cpair*cpfac*cah) ! ground flux need fveg -! eah = eair + (evc+fveg*(tr+evg))/(rhoair*caw*cpair*cpfac/gammag ) -! qfx = (qsfc-qair)*rhoair*cpfac*caw !*cpair/gammag +! tah = sfctmp + (shg+shc)/(rhoair*cpair*cah) +! tah = sfctmp + (shg*fveg+shc)/(rhoair*cpair*cah) ! ground flux need fveg +! eah = eair + (evc+fveg*(tr+evg))/(rhoair*caw*cpair/gammag ) +! qfx = (qsfc-qair)*rhoair*caw !*cpair/gammag ! 2m temperature over vegetation ( corrected for low cq2v values ) if (opt_sfc == 1 .or. opt_sfc == 2) then @@ -3858,7 +3833,7 @@ subroutine vege_flux(parameters,nsnow ,nsoil ,isnow ,vegtyp ,veg , & ! q2v = (eah*0.622/(sfcprs - 0.378*eah)) q2v = qsfc else - t2mv = tah - (shg+shc/fveg)/(rhoair*cpair*cpfac) * 1./cah2 + t2mv = tah - (shg+shc/fveg)/(rhoair*cpair) * 1./cah2 ! q2v = (eah*0.622/(sfcprs - 0.378*eah))- qfx/(rhoair*fv)* 1./vkc * log((2.+z0h)/z0h) q2v = qsfc - ((evc+tr)/fveg+evg)/(latheav*rhoair) * 1./cq2v endif diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index 706ac9a0f..313e22e17 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -148,7 +148,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky shortwave heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in @@ -157,7 +157,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky longwave heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in @@ -244,7 +244,7 @@ intent = in optional = F [heat] - standard_name = kinematic_surface_upward_sensible_heat_flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 dimensions = (horizontal_dimension) @@ -253,7 +253,7 @@ intent = in optional = F [evap] - standard_name = kinematic_surface_upward_latent_heat_flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 dimensions = (horizontal_dimension) diff --git a/physics/moninedmf_hafs.f b/physics/moninedmf_hafs.f new file mode 100644 index 000000000..5c6ff85a8 --- /dev/null +++ b/physics/moninedmf_hafs.f @@ -0,0 +1,1555 @@ +!> \file moninedmf_hafs.f +!! Contains most of the hybrid eddy-diffusivity mass-flux scheme except for the +!! subroutine that calculates the mass flux and updraft properties. + +!> This module contains the CCPP-compliant hybrid eddy-diffusivity mass-flux +!! scheme. + module hedmf_hafs + + contains + +!> \section arg_table_hedmf_hafs_init Argument Table +!! \htmlinclude hedmf_hafs_init.html +!! + subroutine hedmf_hafs_init (moninq_fac,errmsg,errflg) + use machine, only : kind_phys + implicit none + real(kind=kind_phys), intent(in ) :: moninq_fac + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (moninq_fac == 0) then + errflg = 1 + write(errmsg,'(*(a))') 'Logic error: moninq_fac == 0', & + & ' is incompatible with moninedmf_hafs' + end if + end subroutine hedmf_hafs_init + + subroutine hedmf_hafs_finalize () + end subroutine hedmf_hafs_finalize + + +!> \defgroup HEDMF GFS Hybrid Eddy-Diffusivity Mass-Flux (HEDMF) Scheme Module +!! @{ +!! \brief This subroutine contains all of logic for the +!! Hybrid EDMF PBL scheme except for the calculation of +!! the updraft properties and mass flux. +!! +!> \section arg_table_hedmf_hafs_run Argument Table +!! \htmlinclude hedmf_hafs_run.html +!! +!! \section general_edmf GFS Hybrid EDMF General Algorithm +!! -# Compute preliminary variables from input arguments. +!! -# Calculate the first estimate of the PBL height ("Predictor step"). +!! -# Calculate Monin-Obukhov similarity parameters. +!! -# Update thermal properties of surface parcel and recompute PBL height ("Corrector step"). +!! -# Determine whether stratocumulus layers exist and compute quantities needed for enhanced diffusion. +!! -# Calculate the inverse Prandtl number. +!! -# Compute diffusion coefficients below the PBL top. +!! -# Compute diffusion coefficients above the PBL top. +!! -# If the PBL is convective, call the mass flux scheme to replace the countergradient terms. +!! -# Compute enhanced diffusion coefficients related to stratocumulus-topped PBLs. +!! -# Solve for the temperature and moisture tendencies due to vertical mixing. +!! -# Calculate heating due to TKE dissipation and add to the tendency for temperature. +!! -# Solve for the horizontal momentum tendencies and add them to output tendency terms. +!! \section detailed_hedmf GFS Hybrid HEDMF Detailed Algorithm +!! @{ + subroutine hedmf_hafs_run(ix,im,km,ntrac,ntcw,dv,du,tau,rtg, & + & u1,v1,t1,q1,swh,hlw,xmu, & + & psk,rbsoil,zorl,u10m,v10m,fm,fh, & + & tsea,heat,evap,stress,spd1,kpbl, & + & prsi,del,prsl,prslk,phii,phil,delt,dspheat, & + & dusfc,dvsfc,dtsfc,dqsfc,hpbl,hgamt,hgamq,dkt, & + & kinver,xkzm_m,xkzm_h,xkzm_s,lprnt,ipr, & + & xkzminv,moninq_fac,islimsk,errmsg,errflg) +! + use machine , only : kind_phys + use funcphys , only : fpvs + use physcons, grav => con_g, rd => con_rd, cp => con_cp & + &, hvap => con_hvap, fv => con_fvirt + implicit none +! +! arguments +! + logical, intent(in) :: lprnt + integer, intent(in) :: ipr + integer, intent(in) :: ix, im, km, ntrac, ntcw, kinver(im) + integer, intent(in) :: islimsk(1:im) + integer, intent(out) :: kpbl(im) + +! + real(kind=kind_phys), intent(in) :: delt, xkzm_m, xkzm_h, xkzm_s + real(kind=kind_phys), intent(in) :: xkzminv, moninq_fac + real(kind=kind_phys), intent(inout) :: dv(im,km), du(im,km), & + & tau(im,km), rtg(im,km,ntrac) + real(kind=kind_phys), intent(in) :: & + & u1(ix,km), v1(ix,km), & + & t1(ix,km), q1(ix,km,ntrac), & + & swh(ix,km), hlw(ix,km), & + & xmu(im), psk(im), & + & rbsoil(im), zorl(im), & + & u10m(im), v10m(im), & + & fm(im), fh(im), & + & tsea(im), & + & heat(im), evap(im), & + & stress(im), spd1(im) + real(kind=kind_phys), intent(in) :: & + & prsi(ix,km+1), del(ix,km), & + & prsl(ix,km), prslk(ix,km), & + & phii(ix,km+1), phil(ix,km) + real(kind=kind_phys), intent(out) :: & + & dusfc(im), dvsfc(im), & + & dtsfc(im), dqsfc(im), & + & hpbl(im), dkt(im,km-1) + + real(kind=kind_phys), intent(inout) :: & + & hgamt(im), hgamq(im) +! + logical, intent(in) :: dspheat +! flag for tke dissipative heating + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + +! +! locals +! + integer i,iprt,is,iun,k,kk,km1,kmpbl,latd,lond + integer lcld(im),icld(im),kcld(im),krad(im) + integer kx1(im), kpblx(im) +! +! real(kind=kind_phys) betaq(im), betat(im), betaw(im), + real(kind=kind_phys) phih(im), phim(im), hpblx(im), & + & rbdn(im), rbup(im), & + & beta(im), sflux(im), & + & z0(im), crb(im), wstar(im), & + & zol(im), ustmin(im), ustar(im), & + & thermal(im),wscale(im), wscaleu(im) +! + real(kind=kind_phys) theta(im,km),thvx(im,km), thlvx(im,km), & + & qlx(im,km), thetae(im,km), & + & qtx(im,km), bf(im,km-1), diss(im,km), & + & radx(im,km-1), & + & govrth(im), hrad(im), & +! & hradm(im), radmin(im), vrad(im), & + & radmin(im), vrad(im), & + & zd(im), zdd(im), thlvx1(im) +! + real(kind=kind_phys) rdzt(im,km-1),dktx(im,km-1), & + & zi(im,km+1), zl(im,km), xkzo(im,km-1), & + & dku(im,km-1), xkzmo(im,km-1), & + & cku(im,km-1), ckt(im,km-1), & + & ti(im,km-1), shr2(im,km-1), & + & al(im,km-1), ad(im,km), & + & au(im,km-1), a1(im,km), & + & a2(im,km*ntrac) +! + real(kind=kind_phys) tcko(im,km), qcko(im,km,ntrac), & + & ucko(im,km), vcko(im,km), xmf(im,km) +! + real(kind=kind_phys) prinv(im), rent(im) +! + logical pblflg(im), sfcflg(im), scuflg(im), flg(im) + logical ublflg(im), pcnvflg(im) +! +! pcnvflg: true for convective(strongly unstable) pbl +! ublflg: true for unstable but not convective(strongly unstable) pbl +! + real(kind=kind_phys) aphi16, aphi5, bvf2, wfac, + & cfac, conq, cont, conw, + & dk, dkmax, dkmin, + & dq1, dsdz2, dsdzq, dsdzt, + & dsdzu, dsdzv, + & dsig, dt2, dthe1, dtodsd, + & dtodsu, dw2, dw2min, g, + & gamcrq, gamcrt, gocp, + & gravi, f0, + & prnum, prmax, prmin, pfac, crbcon, + & qmin, tdzmin, qtend, crbmin,crbmax, + & rbint, rdt, rdz, qlmin, + & ri, rimin, rl2, rlam, rlamun, + & rone, rzero, sfcfrac, + & spdk2, sri, zol1, zolcr, zolcru, + & robn, ttend, + & utend, vk, vk2, + & ust3, wst3, + & vtend, zfac, vpert, cteit, + & rentf1, rentf2, radfac, + & zfmin, zk, tem, tem1, tem2, + & xkzm, xkzmu, + & ptem, ptem1, ptem2, tx1(im), tx2(im) +! + real(kind=kind_phys) zstblmax,h1, h2, qlcr, actei, + & cldtime + +!! for aplha + real(kind=kind_phys) WSPM(IM,KM-1) + integer kLOC ! RGF + real :: xDKU, ALPHA ! RGF + + integer :: useshape + real :: smax,ashape,sz2h, sksfc,skmax,ashape1,skminusk0, hmax + + +!cc + parameter(gravi=1.0/grav) + parameter(g=grav) + parameter(gocp=g/cp) + parameter(cont=cp/g,conq=hvap/g,conw=1.0/g) ! for del in pa +! parameter(cont=1000.*cp/g,conq=1000.*hvap/g,conw=1000./g) ! for del in kpa + parameter(rlam=30.0,vk=0.4,vk2=vk*vk) + parameter(prmin=0.25,prmax=4.,zolcr=0.2,zolcru=-0.5) + parameter(dw2min=0.0001,dkmin=0.0,dkmax=1000.,rimin=-100.) + parameter(crbcon=0.25,crbmin=0.15,crbmax=0.35) + parameter(wfac=7.0,cfac=6.5,pfac=2.0,sfcfrac=0.1) +! parameter(qmin=1.e-8,xkzm=1.0,zfmin=1.e-8,aphi5=5.,aphi16=16.) + parameter(qmin=1.e-8, zfmin=1.e-8,aphi5=5.,aphi16=16.) + parameter(tdzmin=1.e-3,qlmin=1.e-12,f0=1.e-4) + parameter(h1=0.33333333,h2=0.66666667) +! parameter(cldtime=500.,xkzminv=0.3) + parameter(cldtime=500.) +! parameter(cldtime=500.,xkzmu=3.0,xkzminv=0.3) +! parameter(gamcrt=3.,gamcrq=2.e-3,rlamun=150.0) + parameter(gamcrt=3.,gamcrq=0.,rlamun=150.0) + parameter(rentf1=0.2,rentf2=1.0,radfac=0.85) + parameter(iun=84) +! +! parameter (zstblmax = 2500., qlcr=1.0e-5) +! parameter (zstblmax = 2500., qlcr=3.0e-5) +! parameter (zstblmax = 2500., qlcr=3.5e-5) +! parameter (zstblmax = 2500., qlcr=1.0e-4) + parameter (zstblmax = 2500., qlcr=3.5e-5) +! parameter (actei = 0.23) + parameter (actei = 0.7) + +! HAFS PBL: height-dependent ALPHA + useshape=2 !0-- no change, origincal ALPHA adjustment,1-- shape1, 2-- shape2(adjust above sfc) + alpha=moninq_fac + + ! write(0,*)'in PBL,alpha=',alpha + + ! write(0,*)'islimsk=',(islimsk(i),i=1,im) + +c +c----------------------------------------------------------------------- +c + 601 format(1x,' moninp lat lon step hour ',3i6,f6.1) + 602 format(1x,' k',' z',' t',' th', + 1 ' tvh',' q',' u',' v', + 2 ' sp') + 603 format(1x,i5,8f9.1) + 604 format(1x,' sfc',9x,f9.1,18x,f9.1) + 605 format(1x,' k zl spd2 thekv the1v' + 1 ,' thermal rbup') + 606 format(1x,i5,6f8.2) + 607 format(1x,' kpbl hpbl fm fh hgamt', + 1 ' hgamq ws ustar cd ch') + 608 format(1x,i5,9f8.2) + 609 format(1x,' k pr dkt dku ',i5,3f8.2) + 610 format(1x,' k pr dkt dku ',i5,3f8.2,' l2 ri t2', + 1 ' sr2 ',2f8.2,2e10.2) +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 +!> ## Compute preliminary variables from input arguments + +! compute preliminary variables +! + if (ix .lt. im) stop +! +! iprt = 0 +! if(iprt.eq.1) then +!cc latd = 0 +! lond = 0 +! else +!cc latd = 0 +! lond = 0 +! endif +! + dt2 = delt + rdt = 1. / dt2 + km1 = km - 1 + kmpbl = km / 2 +!> - Compute physical height of the layer centers and interfaces from the geopotential height (zi and zl) + do k=1,km + do i=1,im + zi(i,k) = phii(i,k) * gravi + zl(i,k) = phil(i,k) * gravi + enddo + enddo + do i=1,im + zi(i,km+1) = phii(i,km+1) * gravi + enddo +!> - Compute reciprocal of \f$ \Delta z \f$ (rdzt) + do k = 1,km1 + do i=1,im + rdzt(i,k) = 1.0 / (zl(i,k+1) - zl(i,k)) + enddo + enddo +!> - Compute reciprocal of pressure (tx1, tx2) + do i=1,im + kx1(i) = 1 + tx1(i) = 1.0 / prsi(i,1) + tx2(i) = tx1(i) + enddo +!> - Compute background vertical diffusivities for scalars and momentum (xkzo and xkzmo) + do k = 1,km1 + do i=1,im + xkzo(i,k) = 0.0 + xkzmo(i,k) = 0.0 + if (k < kinver(i)) then +! vertical background diffusivity + ptem = prsi(i,k+1) * tx1(i) + tem1 = 1.0 - ptem + tem1 = tem1 * tem1 * 10.0 + xkzo(i,k) = xkzm_h * min(1.0, exp(-tem1)) + +! vertical background diffusivity for momentum + if (ptem >= xkzm_s) then + xkzmo(i,k) = xkzm_m + kx1(i) = k + 1 + else + if (k == kx1(i) .and. k > 1) tx2(i) = 1.0 / prsi(i,k) + tem1 = 1.0 - prsi(i,k+1) * tx2(i) + tem1 = tem1 * tem1 * 5.0 + xkzmo(i,k) = xkzm_m * min(1.0, exp(-tem1)) + endif + endif + enddo + enddo + +! if (lprnt) then +! print *,' xkzo=',(xkzo(ipr,k),k=1,km1) +! print *,' xkzmo=',(xkzmo(ipr,k),k=1,km1) +! endif +! +! diffusivity in the inversion layer is set to be xkzminv (m^2/s) +!> - The background scalar vertical diffusivity is limited to be less than or equal to xkzminv + do k = 1,kmpbl + do i=1,im +! if(zi(i,k+1) > 200..and.zi(i,k+1) < zstblmax) then + if(zi(i,k+1) > 250.) then + tem1 = (t1(i,k+1)-t1(i,k)) * rdzt(i,k) + if(tem1 > 1.e-5) then + xkzo(i,k) = min(xkzo(i,k),xkzminv) + endif + endif + enddo + enddo +!> - Some output variables and logical flags are initialized + do i = 1,im + z0(i) = 0.01 * zorl(i) + dusfc(i) = 0. + dvsfc(i) = 0. + dtsfc(i) = 0. + dqsfc(i) = 0. + wscale(i)= 0. + wscaleu(i)= 0. + kpbl(i) = 1 + hpbl(i) = zi(i,1) + hpblx(i) = zi(i,1) + pblflg(i)= .true. + sfcflg(i)= .true. + if(rbsoil(i) > 0.) sfcflg(i) = .false. + ublflg(i)= .false. + pcnvflg(i)= .false. + scuflg(i)= .true. + if(scuflg(i)) then + radmin(i)= 0. + rent(i) = rentf1 + hrad(i) = zi(i,1) +! hradm(i) = zi(i,1) + krad(i) = 1 + icld(i) = 0 + lcld(i) = km1 + kcld(i) = km1 + zd(i) = 0. + endif + enddo +!> - Compute \f$\theta\f$ (theta), \f$q_l\f$ (qlx), \f$q_t\f$ (qtx), \f$\theta_e\f$ (thetae), \f$\theta_v\f$ (thvx), \f$\theta_{l,v}\f$ (thlvx) + do k = 1,km + do i = 1,im + theta(i,k) = t1(i,k) * psk(i) / prslk(i,k) + qlx(i,k) = max(q1(i,k,ntcw),qlmin) + qtx(i,k) = max(q1(i,k,1),qmin)+qlx(i,k) + ptem = qlx(i,k) + ptem1 = hvap*max(q1(i,k,1),qmin)/(cp*t1(i,k)) + thetae(i,k)= theta(i,k)*(1.+ptem1) + thvx(i,k) = theta(i,k)*(1.+fv*max(q1(i,k,1),qmin)-ptem) + ptem2 = theta(i,k)-(hvap/cp)*ptem + thlvx(i,k) = ptem2*(1.+fv*qtx(i,k)) + enddo + enddo +!> - Initialize diffusion coefficients to 0 and calculate the total radiative heating rate (dku, dkt, radx) + do k = 1,km1 + do i = 1,im + dku(i,k) = 0. + dkt(i,k) = 0. + dktx(i,k) = 0. + cku(i,k) = 0. + ckt(i,k) = 0. + tem = zi(i,k+1)-zi(i,k) + radx(i,k) = tem*(swh(i,k)*xmu(i)+hlw(i,k)) + enddo + enddo +!> - Set lcld to first index above 2.5km + do i=1,im + flg(i) = scuflg(i) + enddo + do k = 1, km1 + do i=1,im + if(flg(i).and.zl(i,k) >= zstblmax) then + lcld(i)=k + flg(i)=.false. + endif + enddo + enddo +! +! compute virtual potential temp gradient (bf) and winshear square +!> - Compute \f$\frac{\partial \theta_v}{\partial z}\f$ (bf) and the wind shear squared (shr2) + do k = 1, km1 + do i = 1, im + rdz = rdzt(i,k) + bf(i,k) = (thvx(i,k+1)-thvx(i,k))*rdz + ti(i,k) = 2./(t1(i,k)+t1(i,k+1)) + dw2 = (u1(i,k)-u1(i,k+1))**2 + & + (v1(i,k)-v1(i,k+1))**2 + shr2(i,k) = max(dw2,dw2min)*rdz*rdz + enddo + enddo +!> - Calculate \f$\frac{g}{\theta}\f$ (govrth), \f$\beta = \frac{\Delta t}{\Delta z}\f$ (beta), \f$u_*\f$ (ustar), total surface flux (sflux), and set pblflag to false if the total surface energy flux is into the surface + do i = 1,im + govrth(i) = g/theta(i,1) + enddo +! + do i=1,im + beta(i) = dt2 / (zi(i,2)-zi(i,1)) + enddo +! + do i=1,im + ustar(i) = sqrt(stress(i)) + enddo +! + do i = 1,im + sflux(i) = heat(i) + evap(i)*fv*theta(i,1) + if(.not.sfcflg(i) .or. sflux(i) <= 0.) pblflg(i)=.false. + enddo +!> ## Calculate the first estimate of the PBL height (``Predictor step") +!! The calculation of the boundary layer height follows Troen and Mahrt (1986) \cite troen_and_mahrt_1986 section 3. The approach is to find the level in the column where a modified bulk Richardson number exceeds a critical value. +!! +!! The temperature of the thermal is of primary importance. For the initial estimate of the PBL height, the thermal is assumed to have one of two temperatures. If the boundary layer is stable, the thermal is assumed to have a temperature equal to the surface virtual temperature. Otherwise, the thermal is assumed to have the same virtual potential temperature as the lowest model level. For the stable case, the critical bulk Richardson number becomes a function of the wind speed and roughness length, otherwise it is set to a tunable constant. +! compute the pbl height +! + do i=1,im + flg(i) = .false. + rbup(i) = rbsoil(i) + + IF ( ALPHA .GT. 0.0) THEN ! ALPHA + + if(pblflg(i)) then + thermal(i) = thvx(i,1) + crb(i) = crbcon + else + thermal(i) = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) + tem = sqrt(u10m(i)**2+v10m(i)**2) + tem = max(tem, 1.) + robn = tem / (f0 * z0(i)) + tem1 = 1.e-7 * robn + crb(i) = 0.16 * (tem1 ** (-0.18)) + crb(i) = max(min(crb(i), crbmax), crbmin) + endif + + ELSE +! use variable Ri for all conditions + if(pblflg(i)) then + thermal(i) = thvx(i,1) + else + thermal(i) = tsea(i)*(1.+fv*max(q1(i,1,1),qmin)) + endif + tem = sqrt(u10m(i)**2+v10m(i)**2) + tem = max(tem, 1.) + robn = tem / (f0 * z0(i)) + tem1 = 1.e-7 * robn +! crb(i) = 0.16 * (tem1 ** (-0.18)) + crb(i) = crbcon + IF(islimsk(i).ne.0) crb(I) = 0.16*(tem1)**(-0.18) + IF(islimsk(i).eq.0) crb(I) = 0.25*(tem1)**(-0.18) + crb(i) = max(min(crb(i), crbmax), crbmin) + ENDIF ! ALPHA + + enddo + +!> Given the thermal's properties and the critical Richardson number, a loop is executed to find the first level above the surface where the modified Richardson number is greater than the critical Richardson number, using equation 10a from Troen and Mahrt (1986) \cite troen_and_mahrt_1986 (also equation 8 from Hong and Pan (1996) \cite hong_and_pan_1996): +!! \f[ +!! h = Ri\frac{T_0\left|\vec{v}(h)\right|^2}{g\left(\theta_v(h) - \theta_s\right)} +!! \f] +!! where \f$h\f$ is the PBL height, \f$Ri\f$ is the Richardson number, \f$T_0\f$ is the virtual potential temperature near the surface, \f$\left|\vec{v}\right|\f$ is the wind speed, and \f$\theta_s\f$ is for the thermal. Rearranging this equation to calculate the modified Richardson number at each level, k, for comparison with the critical value yields: +!! \f[ +!! Ri_k = gz(k)\frac{\left(\theta_v(k) - \theta_s\right)}{\theta_v(1)*\vec{v}(k)} +!! \f] + do k = 1, kmpbl + do i = 1, im + if(.not.flg(i)) then + rbdn(i) = rbup(i) + spdk2 = max((u1(i,k)**2+v1(i,k)**2),1.) + rbup(i) = (thvx(i,k)-thermal(i))* + & (g*zl(i,k)/thvx(i,1))/spdk2 + kpbl(i) = k + flg(i) = rbup(i) > crb(i) + endif + enddo + enddo + +!> Once the level is found, some linear interpolation is performed to find the exact height of the boundary layer top (where \f$Ri = Ri_{cr}\f$) and the PBL height and the PBL top index are saved (hpblx and kpblx, respectively) + do i = 1,im + if(kpbl(i) > 1) then + k = kpbl(i) + if(rbdn(i) >= crb(i)) then + rbint = 0. + elseif(rbup(i) <= crb(i)) then + rbint = 1. + else + rbint = (crb(i)-rbdn(i))/(rbup(i)-rbdn(i)) + endif + hpbl(i) = zl(i,k-1) + rbint*(zl(i,k)-zl(i,k-1)) + if(hpbl(i) < zi(i,kpbl(i))) kpbl(i) = kpbl(i) - 1 + else + hpbl(i) = zl(i,1) + kpbl(i) = 1 + endif + kpblx(i) = kpbl(i) + hpblx(i) = hpbl(i) + enddo +! +! compute similarity parameters +!> ## Calculate Monin-Obukhov similarity parameters +!! Using the initial guess for the PBL height, Monin-Obukhov similarity parameters are calculated. They are needed to refine the PBL height calculation and for calculating diffusion coefficients. +!! +!! First, calculate the Monin-Obukhov nondimensional stability parameter, commonly referred to as \f$\zeta\f$ using the following equation from Businger et al. (1971) \cite businger_et_al_1971 (equation 28): +!! \f[ +!! \zeta = Ri_{sfc}\frac{F_m^2}{F_h} = \frac{z}{L} +!! \f] +!! where \f$F_m\f$ and \f$F_h\f$ are surface Monin-Obukhov stability functions calculated in sfc_diff.f and \f$L\f$ is the Obukhov length. Then, the nondimensional gradients of momentum and temperature (phim and phih) are calculated using equations 5 and 6 from Hong and Pan (1996) \cite hong_and_pan_1996 depending on the surface layer stability. Then, the velocity scale valid for the surface layer (\f$w_s\f$, wscale) is calculated using equation 3 from Hong and Pan (1996) \cite hong_and_pan_1996. For the neutral and unstable PBL above the surface layer, the convective velocity scale, \f$w_*\f$, is calculated according to: +!! \f[ +!! w_* = \left(\frac{g}{\theta_0}h\overline{w'\theta_0'}\right)^{1/3} +!! \f] +!! and the mixed layer velocity scale is then calculated with equation 6 from Troen and Mahrt (1986) \cite troen_and_mahrt_1986 +!! \f[ +!! w_s = (u_*^3 + 7\epsilon k w_*^3)^{1/3} +!! \f] + do i=1,im + zol(i) = max(rbsoil(i)*fm(i)*fm(i)/fh(i),rimin) + if(sfcflg(i)) then + zol(i) = min(zol(i),-zfmin) + else + zol(i) = max(zol(i),zfmin) + endif + zol1 = zol(i)*sfcfrac*hpbl(i)/zl(i,1) + if(sfcflg(i)) then +! phim(i) = (1.-aphi16*zol1)**(-1./4.) +! phih(i) = (1.-aphi16*zol1)**(-1./2.) + tem = 1.0 / (1. - aphi16*zol1) + phih(i) = sqrt(tem) + phim(i) = sqrt(phih(i)) + else + phim(i) = 1. + aphi5*zol1 + phih(i) = phim(i) + endif + wscale(i) = ustar(i)/phim(i) + ustmin(i) = ustar(i)/aphi5 + wscale(i) = max(wscale(i),ustmin(i)) + enddo + do i=1,im + if(pblflg(i)) then + if(zol(i) < zolcru .and. kpbl(i) > 1) then + pcnvflg(i) = .true. + else + ublflg(i) = .true. + endif + wst3 = govrth(i)*sflux(i)*hpbl(i) + wstar(i)= wst3**h1 + ust3 = ustar(i)**3. + wscaleu(i) = (ust3+wfac*vk*wst3*sfcfrac)**h1 + wscaleu(i) = max(wscaleu(i),ustmin(i)) + endif + enddo +! +! compute counter-gradient mixing term for heat and moisture +!> ## Update thermal properties of surface parcel and recompute PBL height ("Corrector step"). +!! Next, the counter-gradient terms for temperature and humidity are calculated using equation 4 of Hong and Pan (1996) \cite hong_and_pan_1996 and are used to calculate the "scaled virtual temperature excess near the surface" (equation 9 in Hong and Pan (1996) \cite hong_and_pan_1996) so that the properties of the thermal are updated to recalculate the PBL height. + do i = 1,im + if(ublflg(i)) then + hgamt(i) = min(cfac*heat(i)/wscaleu(i),gamcrt) + hgamq(i) = min(cfac*evap(i)/wscaleu(i),gamcrq) + vpert = hgamt(i) + hgamq(i)*fv*theta(i,1) + vpert = min(vpert,gamcrt) + thermal(i)= thermal(i)+max(vpert,0.) + hgamt(i) = max(hgamt(i),0.0) + hgamq(i) = max(hgamq(i),0.0) + endif + enddo +! +! enhance the pbl height by considering the thermal excess +!> The PBL height calculation follows the same procedure as the predictor step, except that it uses an updated virtual potential temperature for the thermal. + do i=1,im + flg(i) = .true. + if(ublflg(i)) then + flg(i) = .false. + rbup(i) = rbsoil(i) + endif + enddo + do k = 2, kmpbl + do i = 1, im + if(.not.flg(i)) then + rbdn(i) = rbup(i) + spdk2 = max((u1(i,k)**2+v1(i,k)**2),1.) + rbup(i) = (thvx(i,k)-thermal(i))* + & (g*zl(i,k)/thvx(i,1))/spdk2 + kpbl(i) = k + flg(i) = rbup(i) > crb(i) + endif + enddo + enddo + do i = 1,im + if(ublflg(i)) then + k = kpbl(i) + if(rbdn(i) >= crb(i)) then + rbint = 0. + elseif(rbup(i) <= crb(i)) then + rbint = 1. + else + rbint = (crb(i)-rbdn(i))/(rbup(i)-rbdn(i)) + endif + hpbl(i) = zl(i,k-1) + rbint*(zl(i,k)-zl(i,k-1)) + if(hpbl(i) < zi(i,kpbl(i))) kpbl(i) = kpbl(i) - 1 + if(kpbl(i) <= 1) then + ublflg(i) = .false. + pblflg(i) = .false. + endif + endif + enddo +! +! look for stratocumulus +!> ## Determine whether stratocumulus layers exist and compute quantities needed for enhanced diffusion +!! - Starting at the PBL top and going downward, if the level is less than 2.5 km and \f$q_l>q_{l,cr}\f$ then set kcld = k (find the cloud top index in the PBL). If no cloud water above the threshold is found, scuflg is set to F. + do i = 1, im + flg(i)=scuflg(i) + enddo + do k = kmpbl,1,-1 + do i = 1, im + if(flg(i) .and. k <= lcld(i)) then + if(qlx(i,k).ge.qlcr) then + kcld(i)=k + flg(i)=.false. + endif + endif + enddo + enddo + do i = 1, im + if(scuflg(i) .and. kcld(i)==km1) scuflg(i)=.false. + enddo +!> - Starting at the PBL top and going downward, if the level is less than the cloud top, find the level of the minimum radiative heating rate within the cloud. If the level of the minimum is the lowest model level or the minimum radiative heating rate is positive, then set scuflg to F. + do i = 1, im + flg(i)=scuflg(i) + enddo + do k = kmpbl,1,-1 + do i = 1, im + if(flg(i) .and. k <= kcld(i)) then + if(qlx(i,k) >= qlcr) then + if(radx(i,k) < radmin(i)) then + radmin(i)=radx(i,k) + krad(i)=k + endif + else + flg(i)=.false. + endif + endif + enddo + enddo + do i = 1, im + if(scuflg(i) .and. krad(i) <= 1) scuflg(i)=.false. + if(scuflg(i) .and. radmin(i)>=0.) scuflg(i)=.false. + enddo +!> - Starting at the PBL top and going downward, count the number of levels below the minimum radiative heating rate level that have cloud water above the threshold. If there are none, then set the scuflg to F. + do i = 1, im + flg(i)=scuflg(i) + enddo + do k = kmpbl,2,-1 + do i = 1, im + if(flg(i) .and. k <= krad(i)) then + if(qlx(i,k) >= qlcr) then + icld(i)=icld(i)+1 + else + flg(i)=.false. + endif + endif + enddo + enddo + do i = 1, im + if(scuflg(i) .and. icld(i) < 1) scuflg(i)=.false. + enddo +!> - Find the height of the interface where the minimum in radiative heating rate is located. If this height is less than the second model interface height, then set the scuflg to F. + do i = 1, im + if(scuflg(i)) then + hrad(i) = zi(i,krad(i)+1) +! hradm(i)= zl(i,krad(i)) + endif + enddo +! + do i = 1, im + if(scuflg(i) .and. hrad(i) - Calculate the hypothetical \f$\theta_v\f$ at the minimum radiative heating level that a parcel would reach due to radiative cooling after a typical cloud turnover time spent at that level. + do i = 1, im + if(scuflg(i)) then + k = krad(i) + tem = zi(i,k+1)-zi(i,k) + tem1 = cldtime*radmin(i)/tem + thlvx1(i) = thlvx(i,k)+tem1 +! if(thlvx1(i) > thlvx(i,k-1)) scuflg(i)=.false. + endif + enddo +!> - Determine the distance that a parcel would sink downwards starting from the level of minimum radiative heating rate by comparing the hypothetical minimum \f$\theta_v\f$ calculated above with the environmental \f$\theta_v\f$. + do i = 1, im + flg(i)=scuflg(i) + enddo + do k = kmpbl,1,-1 + do i = 1, im + if(flg(i) .and. k <= krad(i))then + if(thlvx1(i) <= thlvx(i,k))then + tem=zi(i,k+1)-zi(i,k) + zd(i)=zd(i)+tem + else + flg(i)=.false. + endif + endif + enddo + enddo +!> - Calculate the cloud thickness, where the cloud top is the in-cloud minimum radiative heating level and the bottom is determined previously. + do i = 1, im + if(scuflg(i))then + kk = max(1, krad(i)+1-icld(i)) + zdd(i) = hrad(i)-zi(i,kk) + endif + enddo +!> - Find the largest between the cloud thickness and the distance of a sinking parcel, then determine the smallest of that number and the height of the minimum in radiative heating rate. Set this number to \f$zd\f$. Using \f$zd\f$, calculate the characteristic velocity scale of cloud-top radiative cooling-driven turbulence. + do i = 1, im + if(scuflg(i))then + zd(i) = max(zd(i),zdd(i)) + zd(i) = min(zd(i),hrad(i)) + tem = govrth(i)*zd(i)*(-radmin(i)) + vrad(i)= tem**h1 + endif + enddo +! +! compute inverse prandtl number +!> ## Calculate the inverse Prandtl number +!! For an unstable PBL, the Prandtl number is calculated according to Hong and Pan (1996) \cite hong_and_pan_1996, equation 10, whereas for a stable boundary layer, the Prandtl number is simply \f$Pr = \frac{\phi_h}{\phi_m}\f$. + do i = 1, im + if(ublflg(i)) then + tem = phih(i)/phim(i)+cfac*vk*sfcfrac + else + tem = phih(i)/phim(i) + endif + prinv(i) = 1.0 / tem + prinv(i) = min(prinv(i),prmax) + prinv(i) = max(prinv(i),prmin) + enddo + do i = 1, im + if(zol(i) > zolcr) then + kpbl(i) = 1 + endif + enddo + +!!! HAFS PBL, Bgin adjustment +! RGF determine wspd at roughly 500 m above surface, or as close as possible, +! reuse SPDK2 +! zi(i,k) is AGL, right? May not matter if applied only to water grid points + if(moninq_fac.lt.0)then + + DO I=1,IM + SPDK2 = 0. + WSPM(i,1) = 0. + DO K = 1, KMPBL ! kmpbl is like a max possible pbl height + if(zi(i,k).le.500.and.zi(i,k+1).gt.500.)then ! find level bracketing 500 m + SPDK2 = SQRT(U1(i,k)*U1(i,k)+V1(i,k)*V1(i,k)) ! wspd near 500 m + WSPM(i,1) = SPDK2/0.6 ! now the Km limit for 500 m. just store in K=1 + WSPM(i,2) = float(k) ! height of level at gridpoint i. store in K=2 +! if(i.eq.25) print *,' IK ',i,k,' ZI ',zi(i,k), ' WSPM1 ',wspm(i,1),' +! KMPBL ',kmpbl,' KPBL ',kpbl(i) + endif + ENDDO + ENDDO ! i + + endif ! moninq_fac < 0 + + +! +! compute diffusion coefficients below pbl +!> ## Compute diffusion coefficients below the PBL top +!! Below the PBL top, the diffusion coefficients (\f$K_m\f$ and \f$K_h\f$) are calculated according to equation 2 in Hong and Pan (1996) \cite hong_and_pan_1996 where a different value for \f$w_s\f$ (PBL vertical velocity scale) is used depending on the PBL stability. \f$K_h\f$ is calculated from \f$K_m\f$ using the Prandtl number. The calculated diffusion coefficients are checked so that they are bounded by maximum values and the local background diffusion coefficients. + + IF (ALPHA > 0) THEN ! AAAAAAAAAAAAAAAAAAAAAAAAAAA + + do k = 1, kmpbl + do i=1,im + if(k < kpbl(i)) then +! zfac = max((1.-(zi(i,k+1)-zl(i,1))/ +! 1 (hpbl(i)-zl(i,1))), zfmin) + zfac = max((1.-zi(i,k+1)/hpbl(i)), zfmin) + tem = zi(i,k+1) * (zfac**pfac) * moninq_fac ! lmh suggested by kg + if(pblflg(i)) then + tem1 = vk * wscaleu(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + else + tem1 = vk * wscale(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + endif + dku(i,k) = min(dku(i,k),dkmax) + dku(i,k) = max(dku(i,k),xkzmo(i,k)) + dkt(i,k) = min(dkt(i,k),dkmax) + dkt(i,k) = max(dkt(i,k),xkzo(i,k)) + dktx(i,k)= dkt(i,k) + endif + enddo + enddo + + ELSE ! ALPHA <0 AAAAAAAAAAAAA + + do i=1,im + do k = 1, kmpbl + if(k < kpbl(i)) then +! zfac = max((1.-(zi(i,k+1)-zl(i,1))/ +! 1 (hpbl(i)-zl(i,1))), zfmin) + zfac = max((1.-zi(i,k+1)/hpbl(i)), zfmin) + ! tem = zi(i,k+1) * (zfac**pfac) * moninq_fac ! lmh suggested by kg + tem = zi(i,k+1) * (zfac**pfac) * abs( moninq_fac) + +!!!! CHANGES FOR HEIGHT-DEPENDENT K ADJUSTMENT, WANG W + if(useshape .ge. 1) then + sz2h=(ZI(I,K+1)-ZL(I,1))/(HPBL(I)-ZL(I,1)) + sz2h=max(sz2h,zfmin) + sz2h=min(sz2h,1.0) + zfac=(1.0-sz2h)**pfac +! smax=0.148 !! max value of this shape function + smax=0.148 !! max value of this shape function + hmax=0.333 !! roughly height if max K + skmax=hmax*(1.0-hmax)**pfac + sksfc=min(ZI(I,2)/HPBL(I),0.05) ! surface layer top, 0.05H or ZI(2) (Zi(1)=0) + sksfc=sksfc*(1-sksfc)**pfac + + zfac=max(zfac,zfmin) + ashape=max(ABS(moninq_fac),0.2) ! should not be smaller than 0.2, otherwise too much adjustment(?) + if(useshape ==1) then + ashape=( 1.0 - ((sz2h*zfac/smax)**0.25) + & *( 1.0 - ashape ) ) + tem = zi(i,k+1) * (zfac) * ashape + endif + + if (useshape == 2) then !only adjus K that is > K_surface_top + ashape1=1.0 + if (skmax > sksfc) ashape1=(skmax*ashape-sksfc)/ + & (skmax-sksfc) + skminusk0=ZI(I,K+1)*zfac - HPBL(i)*sksfc + tem = zi(i,k+1) * (zfac) ! no adjustment + if (skminusk0 > 0) then ! only adjust K which is > surface top K + tem = skminusk0*ashape1 + HPBL(i)*sksfc + endif + endif + endif ! endif useshape>1 +!!!! END OF CHAGES , WANG W + + + if(pblflg(i)) then + tem1 = vk * wscaleu(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + else + tem1 = vk * wscale(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + endif + dku(i,k) = min(dku(i,k),dkmax) + dku(i,k) = max(dku(i,k),xkzmo(i,k)) + dkt(i,k) = min(dkt(i,k),dkmax) + dkt(i,k) = max(dkt(i,k),xkzo(i,k)) + dktx(i,k)= dkt(i,k) + endif + enddo !K loop + +! possible modification of first guess DKU, under certain conditions +! (1) this applies only to columns over water + + IF(islimsk(i).eq.0)then ! sea only + +! (2) alpha test +! if alpha < 0, find alpha for each column and do the loop again +! if alpha > 0, we are finished + + + if(alpha.lt.0)then ! variable alpha test + +! k-level of layer around 500 m + kLOC = INT(WSPM(i,2)) +! print *,' kLOC ',kLOC,' KPBL ',KPBL(I) + +! (3) only do this IF KPBL(I) >= kLOC. Otherwise, we are finished, with DKU as +! if alpha = +1 + + if(KPBL(I).gt.kLOC)then + + xDKU = DKU(i,kLOC) ! Km at k-level +! (4) DKU check. +! WSPM(i,1) is the KM cap for the 500-m level. +! if DKU at 500-m level < WSPM(i,1), do not limit Km ANYWHERE. Alpha = +! abs(alpha). No need to recalc. +! if DKU at 500-m level > WSPM(i,1), then alpha = WSPM(i,1)/xDKU for entire +! column + if(xDKU.ge.WSPM(i,1)) then ! ONLY if DKU at 500-m exceeds cap, otherwise already done + + WSPM(i,3) = WSPM(i,1)/xDKU ! ratio of cap to Km at k-level, store in WSPM(i,3) + !WSPM(i,4) = amin1(WSPM(I,3),1.0) ! this is new column alpha. cap at 1. ! should never be needed + WSPM(i,4) = min(WSPM(I,3),1.0) ! this is new column alpha. cap at 1. ! should never be needed + !! recalculate K capped by WSPM(i,1) + do k = 1, kmpbl + if(k < kpbl(i)) then +! zfac = max((1.-(zi(i,k+1)-zl(i,1))/ +! 1 (hpbl(i)-zl(i,1))), zfmin) + zfac = max((1.-zi(i,k+1)/hpbl(i)), zfmin) + ! tem = zi(i,k+1) * (zfac**pfac) + tem = zi(i,k+1) * (zfac**pfac) * WSPM(i,4) + + +!!!! CHANGES FOR HEIGHT-DEPENDENT K ADJUSTMENT, WANG W + if(useshape .ge. 1) then + sz2h=(ZI(I,K+1)-ZL(I,1))/(HPBL(I)-ZL(I,1)) + sz2h=max(sz2h,zfmin) + sz2h=min(sz2h,1.0) + zfac=(1.0-sz2h)**pfac + smax=0.148 !! max value of this shape function + hmax=0.333 !! roughly height if max K + skmax=hmax*(1.0-hmax)**pfac + sksfc=min(ZI(I,2)/HPBL(I),0.05) ! surface layer top, 0.05H or ZI(2) (Zi(1)=0) + sksfc=sksfc*(1-sksfc)**pfac + + zfac=max(zfac,zfmin) + ashape=max(WSPM(i,4),0.2) !! adjustment coef should not smaller than 0.2 + if(useshape ==1) then + ashape=( 1.0 - ((sz2h*zfac/smax)**0.25) + & *( 1.0 - ashape ) ) + tem = zi(i,k+1) * (zfac) * ashape +! if(k ==5) write(0,*)'min alf, height-depend alf',WSPM(i,4),ashape + endif ! endif useshape=1 + + if (useshape == 2) then !only adjus K that is > K_surface_top + ashape1=1.0 + if (skmax > sksfc) ashape1=(skmax*ashape-sksfc)/ + & (skmax-sksfc) + + skminusk0=ZI(I,K+1)*zfac - HPBL(i)*sksfc + tem = zi(i,k+1) * (zfac) ! no adjustment +! if(k ==5) write(0,*)'before, dku,ashape,ashpe1', +! & tem*wscaleu(i)*vk,ashape,ashape1 + if (skminusk0 > 0) then ! only adjust K which is > surface top K + tem = skminusk0*ashape1 + HPBL(i)*sksfc + endif +! if(k ==5)write(0,*) +! & 'after,dku,k_sfc,skmax,sksfc,zi(2),hpbl' +! & ,tem*wscaleu(i)*vk,WSCALEU(I)*VK*HPBL(i)*sksfc, skmax, +! & sksfc,ZI(I,2),HPBL(I) + + endif ! endif useshape=2 + endif ! endif useshape>1 +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + if(pblflg(i)) then + tem1 = vk * wscaleu(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + else + tem1 = vk * wscale(i) * tem +! dku(i,k) = xkzmo(i,k) + tem1 +! dkt(i,k) = xkzo(i,k) + tem1 * prinv(i) + dku(i,k) = tem1 + dkt(i,k) = tem1 * prinv(i) + endif + dku(i,k) = min(dku(i,k),dkmax) + dku(i,k) = max(dku(i,k),xkzmo(i,k)) + dkt(i,k) = min(dkt(i,k),dkmax) + dkt(i,k) = max(dkt(i,k),xkzo(i,k)) + dktx(i,k)= dkt(i,k) + endif + enddo !K loop + endif ! xDKU.ge.WSPM(i,1) + endif ! KPBL(I).ge.kLOC + endif ! alpha < 0 + endif ! islimsk=0 + + enddo !I loop + ENDIF !AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA + +! +! compute diffusion coefficients based on local scheme above pbl +!> ## Compute diffusion coefficients above the PBL top +!! Diffusion coefficients above the PBL top are computed as a function of local stability (gradient Richardson number), shear, and a length scale from Louis (1979) \cite louis_1979 : +!! \f[ +!! K_{m,h}=l^2f_{m,h}(Ri_g)\left|\frac{\partial U}{\partial z}\right| +!! \f] +!! The functions used (\f$f_{m,h}\f$) depend on the local stability. First, the gradient Richardson number is calculated as +!! \f[ +!! Ri_g=\frac{\frac{g}{T}\frac{\partial \theta_v}{\partial z}}{\frac{\partial U}{\partial z}^2} +!! \f] +!! where \f$U\f$ is the horizontal wind. For the unstable case (\f$Ri_g < 0\f$), the Richardson number-dependent functions are given by +!! \f[ +!! f_h(Ri_g) = 1 + \frac{8\left|Ri_g\right|}{1 + 1.286\sqrt{\left|Ri_g\right|}}\\ +!! \f] +!! \f[ +!! f_m(Ri_g) = 1 + \frac{8\left|Ri_g\right|}{1 + 1.746\sqrt{\left|Ri_g\right|}}\\ +!! \f] +!! For the stable case, the following formulas are used +!! \f[ +!! f_h(Ri_g) = \frac{1}{\left(1 + 5Ri_g\right)^2}\\ +!! \f] +!! \f[ +!! Pr = \frac{K_h}{K_m} = 1 + 2.1Ri_g +!! \f] +!! The source for the formulas used for the Richardson number-dependent functions is unclear. They are different than those used in Hong and Pan (1996) \cite hong_and_pan_1996 as the previous documentation suggests. They follow equation 14 of Louis (1979) \cite louis_1979 for the unstable case, but it is unclear where the values of the coefficients \f$b\f$ and \f$c\f$ from that equation used in this scheme originate. Finally, the length scale, \f$l\f$ is calculated according to the following formula from Hong and Pan (1996) \cite hong_and_pan_1996 +!! \f[ +!! \frac{1}{l} = \frac{1}{kz} + \frac{1}{l_0}\\ +!! \f] +!! \f[ +!! or\\ +!! \f] +!! \f[ +!! l=\frac{l_0kz}{l_0+kz} +!! \f] +!! where \f$l_0\f$ is currently 30 m for stable conditions and 150 m for unstable. Finally, the diffusion coefficients are kept in a range bounded by the background diffusion and the maximum allowable values. + do k = 1, km1 + do i=1,im + if(k >= kpbl(i)) then + bvf2 = g*bf(i,k)*ti(i,k) + ri = max(bvf2/shr2(i,k),rimin) + zk = vk*zi(i,k+1) + if(ri < 0.) then ! unstable regime + rl2 = zk*rlamun/(rlamun+zk) + dk = rl2*rl2*sqrt(shr2(i,k)) + sri = sqrt(-ri) +! dku(i,k) = xkzmo(i,k) + dk*(1+8.*(-ri)/(1+1.746*sri)) +! dkt(i,k) = xkzo(i,k) + dk*(1+8.*(-ri)/(1+1.286*sri)) + dku(i,k) = dk*(1+8.*(-ri)/(1+1.746*sri)) + dkt(i,k) = dk*(1+8.*(-ri)/(1+1.286*sri)) + else ! stable regime + rl2 = zk*rlam/(rlam+zk) +!! tem = rlam * sqrt(0.01*prsi(i,k)) +!! rl2 = zk*tem/(tem+zk) + dk = rl2*rl2*sqrt(shr2(i,k)) + tem1 = dk/(1+5.*ri)**2 +! + if(k >= kpblx(i)) then + prnum = 1.0 + 2.1*ri + prnum = min(prnum,prmax) + else + prnum = 1.0 + endif +! dku(i,k) = xkzmo(i,k) + tem1 * prnum +! dkt(i,k) = xkzo(i,k) + tem1 + dku(i,k) = tem1 * prnum + dkt(i,k) = tem1 + endif +! + dku(i,k) = min(dku(i,k),dkmax) + dku(i,k) = max(dku(i,k),xkzmo(i,k)) + dkt(i,k) = min(dkt(i,k),dkmax) + dkt(i,k) = max(dkt(i,k),xkzo(i,k)) +! + endif +! + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute components for mass flux mixing by large thermals +!> ## If the PBL is convective, call the mass flux scheme to replace the countergradient terms. +!! If the PBL is convective, the updraft properties are initialized to be the same as the state variables and the subroutine mfpbl is called. + do k = 1, km + do i = 1, im + if(pcnvflg(i)) then + tcko(i,k) = t1(i,k) + ucko(i,k) = u1(i,k) + vcko(i,k) = v1(i,k) + xmf(i,k) = 0. + endif + enddo + enddo + do kk = 1, ntrac + do k = 1, km + do i = 1, im + if(pcnvflg(i)) then + qcko(i,k,kk) = q1(i,k,kk) + endif + enddo + enddo + enddo +!> For details of the mfpbl subroutine, step into its documentation ::mfpbl + call mfpbl(im,ix,km,ntrac,dt2,pcnvflg, + & zl,zi,thvx,q1,t1,u1,v1,hpbl,kpbl, + & sflux,ustar,wstar,xmf,tcko,qcko,ucko,vcko) +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! compute diffusion coefficients for cloud-top driven diffusion +! if the condition for cloud-top instability is met, +! increase entrainment flux at cloud top +! +!> ## Compute enhanced diffusion coefficients related to stratocumulus-topped PBLs +!! If a stratocumulus layer has been identified in the PBL, the diffusion coefficients in the PBL are modified in the following way. +!! +!! -# First, the criteria for CTEI is checked, using the threshold from equation 13 of Macvean and Mason (1990) \cite macvean_and_mason_1990. If the criteria is met, the cloud top diffusion is increased: +!! \f[ +!! K_h^{Sc} = -c\frac{\Delta F_R}{\rho c_p}\frac{1}{\frac{\partial \theta_v}{\partial z}} +!! \f] +!! where the constant \f$c\f$ is set to 0.2 if the CTEI criterion is not met and 1.0 if it is. +!! +!! -# Calculate the diffusion coefficients due to stratocumulus mixing according to equation 5 in Lock et al. (2000) \cite lock_et_al_2000 for every level below the stratocumulus top using the characteristic stratocumulus velocity scale previously calculated. The diffusion coefficient for momentum is calculated assuming a constant inverse Prandtl number of 0.75. + do i = 1, im + if(scuflg(i)) then + k = krad(i) + tem = thetae(i,k) - thetae(i,k+1) + tem1 = qtx(i,k) - qtx(i,k+1) + if (tem > 0. .and. tem1 > 0.) then + cteit= cp*tem/(hvap*tem1) + if(cteit > actei) rent(i) = rentf2 + endif + endif + enddo + do i = 1, im + if(scuflg(i)) then + k = krad(i) + tem1 = max(bf(i,k),tdzmin) + ckt(i,k) = -rent(i)*radmin(i)/tem1 + cku(i,k) = ckt(i,k) + endif + enddo +! + do k = 1, kmpbl + do i=1,im + if(scuflg(i) .and. k < krad(i)) then + tem1=hrad(i)-zd(i) + tem2=zi(i,k+1)-tem1 + if(tem2 > 0.) then + ptem= tem2/zd(i) + if(ptem.ge.1.) ptem= 1. + ptem= tem2*ptem*sqrt(1.-ptem) + ckt(i,k) = radfac*vk*vrad(i)*ptem + cku(i,k) = 0.75*ckt(i,k) + ckt(i,k) = max(ckt(i,k),dkmin) + ckt(i,k) = min(ckt(i,k),dkmax) + cku(i,k) = max(cku(i,k),dkmin) + cku(i,k) = min(cku(i,k),dkmax) + endif + endif + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! +!> After \f$K_h^{Sc}\f$ has been determined from the surface to the top of the stratocumulus layer, it is added to the value for the diffusion coefficient calculated previously using surface-based mixing [see equation 6 of Lock et al. (2000) \cite lock_et_al_2000 ]. + do k = 1, kmpbl + do i=1,im + if(scuflg(i)) then + ! dkt(i,k) = dkt(i,k)+ckt(i,k) + ! dku(i,k) = dku(i,k)+cku(i,k) + !! if K needs to be adjusted by alpha, then no need to add this term + if(alpha .ge. 0.0) dkt(i,k) = dkt(i,k)+ckt(i,k) + if(alpha .ge. 0.0) dku(i,k) = dku(i,k)+cku(i,k) + + dkt(i,k) = min(dkt(i,k),dkmax) + dku(i,k) = min(dku(i,k),dkmax) + endif + enddo + enddo +! +! compute tridiagonal matrix elements for heat and moisture +! +!> ## Solve for the temperature and moisture tendencies due to vertical mixing. +!! The tendencies of heat, moisture, and momentum due to vertical diffusion are calculated using a two-part process. First, a solution is obtained using an implicit time-stepping scheme, then the time tendency terms are "backed out". The tridiagonal matrix elements for the implicit solution for temperature and moisture are prepared in this section, with differing algorithms depending on whether the PBL was convective (substituting the mass flux term for counter-gradient term), unstable but not convective (using the computed counter-gradient terms), or stable (no counter-gradient terms). + do i=1,im + ad(i,1) = 1. + a1(i,1) = t1(i,1) + beta(i) * heat(i) + a2(i,1) = q1(i,1,1) + beta(i) * evap(i) + enddo + + if(ntrac >= 2) then + do k = 2, ntrac + is = (k-1) * km + do i = 1, im + a2(i,1+is) = q1(i,1,k) + enddo + enddo + endif +! + do k = 1,km1 + do i = 1,im + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + rdz = rdzt(i,k) + tem1 = dsig * dkt(i,k) * rdz + dsdz2 = tem1 * rdz + au(i,k) = -dtodsd*dsdz2 + al(i,k) = -dtodsu*dsdz2 +! + if(pcnvflg(i) .and. k < kpbl(i)) then + tem2 = dsig * rdz + ptem = 0.5 * tem2 * xmf(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + ad(i,k) = ad(i,k)-au(i,k)-ptem1 + ad(i,k+1) = 1.-al(i,k)+ptem2 + au(i,k) = au(i,k)-ptem1 + al(i,k) = al(i,k)+ptem2 + ptem = tcko(i,k) + tcko(i,k+1) + dsdzt = tem1 * gocp + a1(i,k) = a1(i,k)+dtodsd*dsdzt-ptem1*ptem + a1(i,k+1) = t1(i,k+1)-dtodsu*dsdzt+ptem2*ptem + ptem = qcko(i,k,1) + qcko(i,k+1,1) + a2(i,k) = a2(i,k) - ptem1 * ptem + a2(i,k+1) = q1(i,k+1,1) + ptem2 * ptem + elseif(ublflg(i) .and. k < kpbl(i)) then + ptem1 = dsig * dktx(i,k) * rdz + tem = 1.0 / hpbl(i) + dsdzt = tem1 * gocp - ptem1 * hgamt(i) * tem + dsdzq = - ptem1 * hgamq(i) * tem + ad(i,k) = ad(i,k)-au(i,k) + ad(i,k+1) = 1.-al(i,k) + a1(i,k) = a1(i,k)+dtodsd*dsdzt + a1(i,k+1) = t1(i,k+1)-dtodsu*dsdzt + a2(i,k) = a2(i,k)+dtodsd*dsdzq + a2(i,k+1) = q1(i,k+1,1)-dtodsu*dsdzq + else + ad(i,k) = ad(i,k)-au(i,k) + ad(i,k+1) = 1.-al(i,k) + dsdzt = tem1 * gocp + a1(i,k) = a1(i,k)+dtodsd*dsdzt + a1(i,k+1) = t1(i,k+1)-dtodsu*dsdzt + a2(i,k+1) = q1(i,k+1,1) + endif +! + enddo + enddo +! + if(ntrac >= 2) then + do kk = 2, ntrac + is = (kk-1) * km + do k = 1, km1 + do i = 1, im + if(pcnvflg(i) .and. k < kpbl(i)) then + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + tem = dsig * rdzt(i,k) + ptem = 0.5 * tem * xmf(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + tem1 = qcko(i,k,kk) + qcko(i,k+1,kk) + a2(i,k+is) = a2(i,k+is) - ptem1*tem1 + a2(i,k+1+is)= q1(i,k+1,kk) + ptem2*tem1 + else + a2(i,k+1+is) = q1(i,k+1,kk) + endif + enddo + enddo + enddo + endif +! +! solve tridiagonal problem for heat and moisture +! +!> The tridiagonal system is solved by calling the internal ::tridin subroutine. + call tridin99(im,km,ntrac,al,ad,au,a1,a2,au,a1,a2) + +! +! recover tendencies of heat and moisture +! +!> After returning with the solution, the tendencies for temperature and moisture are recovered. + do k = 1,km + do i = 1,im + ttend = (a1(i,k)-t1(i,k)) * rdt + qtend = (a2(i,k)-q1(i,k,1))*rdt + tau(i,k) = tau(i,k)+ttend + rtg(i,k,1) = rtg(i,k,1)+qtend + dtsfc(i) = dtsfc(i)+cont*del(i,k)*ttend + dqsfc(i) = dqsfc(i)+conq*del(i,k)*qtend + enddo + enddo + if(ntrac >= 2) then + do kk = 2, ntrac + is = (kk-1) * km + do k = 1, km + do i = 1, im + qtend = (a2(i,k+is)-q1(i,k,kk))*rdt + rtg(i,k,kk) = rtg(i,k,kk)+qtend + enddo + enddo + enddo + endif +! +! compute tke dissipation rate +! +!> ## Calculate heating due to TKE dissipation and add to the tendency for temperature +!! Following Han et al. (2015) \cite han_et_al_2015 , turbulence dissipation contributes to the tendency of temperature in the following way. First, turbulence dissipation is calculated by equation 17 of Han et al. (2015) \cite han_et_al_2015 for the PBL and equation 16 for the surface layer. + if(dspheat) then +! + do k = 1,km1 + do i = 1,im + diss(i,k) = dku(i,k)*shr2(i,k)-g*ti(i,k)*dkt(i,k)*bf(i,k) +! diss(i,k) = dku(i,k)*shr2(i,k) + enddo + enddo +! +! add dissipative heating at the first model layer +! +!> Next, the temperature tendency is updated following equation 14. + do i = 1,im + tem = govrth(i)*sflux(i) + tem1 = tem + stress(i)*spd1(i)/zl(i,1) + tem2 = 0.5 * (tem1+diss(i,1)) + tem2 = max(tem2, 0.) + ttend = tem2 / cp + if (alpha .gt. 0.0) then + tau(i,1) = tau(i,1)+0.5*ttend + else + tau(i,1) = tau(i,1)+0.7*ttend ! in HWRF/HMON, use 0.7 + endif + enddo +! +! add dissipative heating above the first model layer +! + do k = 2,km1 + do i = 1,im + tem = 0.5 * (diss(i,k-1)+diss(i,k)) + tem = max(tem, 0.) + ttend = tem / cp + tau(i,k) = tau(i,k) + 0.5*ttend + enddo + enddo +! + endif +! +! compute tridiagonal matrix elements for momentum +! +!> ## Solve for the horizontal momentum tendencies and add them to the output tendency terms +!! As with the temperature and moisture tendencies, the horizontal momentum tendencies are calculated by solving tridiagonal matrices after the matrices are prepared in this section. + do i=1,im + ad(i,1) = 1.0 + beta(i) * stress(i) / spd1(i) + a1(i,1) = u1(i,1) + a2(i,1) = v1(i,1) + enddo +! + do k = 1,km1 + do i=1,im + dtodsd = dt2/del(i,k) + dtodsu = dt2/del(i,k+1) + dsig = prsl(i,k)-prsl(i,k+1) + rdz = rdzt(i,k) + tem1 = dsig*dku(i,k)*rdz + dsdz2 = tem1 * rdz + au(i,k) = -dtodsd*dsdz2 + al(i,k) = -dtodsu*dsdz2 +! + if(pcnvflg(i) .and. k < kpbl(i)) then + tem2 = dsig * rdz + ptem = 0.5 * tem2 * xmf(i,k) + ptem1 = dtodsd * ptem + ptem2 = dtodsu * ptem + ad(i,k) = ad(i,k)-au(i,k)-ptem1 + ad(i,k+1) = 1.-al(i,k)+ptem2 + au(i,k) = au(i,k)-ptem1 + al(i,k) = al(i,k)+ptem2 + ptem = ucko(i,k) + ucko(i,k+1) + a1(i,k) = a1(i,k) - ptem1 * ptem + a1(i,k+1) = u1(i,k+1) + ptem2 * ptem + ptem = vcko(i,k) + vcko(i,k+1) + a2(i,k) = a2(i,k) - ptem1 * ptem + a2(i,k+1) = v1(i,k+1) + ptem2 * ptem + else + ad(i,k) = ad(i,k)-au(i,k) + ad(i,k+1) = 1.-al(i,k) + a1(i,k+1) = u1(i,k+1) + a2(i,k+1) = v1(i,k+1) + endif +! + enddo + enddo +! +! solve tridiagonal problem for momentum +! + call tridi299(im,km,al,ad,au,a1,a2,au,a1,a2) +! +! recover tendencies of momentum +! +!> Finally, the tendencies are recovered from the tridiagonal solutions. + do k = 1,km + do i = 1,im + utend = (a1(i,k)-u1(i,k))*rdt + vtend = (a2(i,k)-v1(i,k))*rdt + du(i,k) = du(i,k) + utend + dv(i,k) = dv(i,k) + vtend + dusfc(i) = dusfc(i) + conw*del(i,k)*utend + dvsfc(i) = dvsfc(i) + conw*del(i,k)*vtend +! +! for dissipative heating for ecmwf model +! +! tem1 = 0.5*(a1(i,k)+u1(i,k)) +! tem2 = 0.5*(a2(i,k)+v1(i,k)) +! diss(i,k) = -(tem1*utend+tem2*vtend) +! diss(i,k) = max(diss(i,k),0.) +! ttend = diss(i,k) / cp +! tau(i,k) = tau(i,k) + ttend +! + enddo + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! + do i = 1, im + hpbl(i) = hpblx(i) + kpbl(i) = kpblx(i) + enddo +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + return + end subroutine hedmf_hafs_run + +!> @} + +c----------------------------------------------------------------------- +!> \ingroup PBL +!! \brief Routine to solve the tridiagonal system to calculate temperature and moisture at \f$ t + \Delta t \f$; part of two-part process to calculate time tendencies due to vertical diffusion. +!! +!! Origin of subroutine unknown. + subroutine tridi299(l,n,cl,cm,cu,r1,r2,au,a1,a2) +cc + use machine , only : kind_phys + implicit none + integer k,n,l,i + real(kind=kind_phys) fk +cc + real(kind=kind_phys) cl(l,2:n),cm(l,n),cu(l,n-1),r1(l,n),r2(l,n), & + & au(l,n-1),a1(l,n),a2(l,n) +c----------------------------------------------------------------------- + do i=1,l + fk = 1./cm(i,1) + au(i,1) = fk*cu(i,1) + a1(i,1) = fk*r1(i,1) + a2(i,1) = fk*r2(i,1) + enddo + do k=2,n-1 + do i=1,l + fk = 1./(cm(i,k)-cl(i,k)*au(i,k-1)) + au(i,k) = fk*cu(i,k) + a1(i,k) = fk*(r1(i,k)-cl(i,k)*a1(i,k-1)) + a2(i,k) = fk*(r2(i,k)-cl(i,k)*a2(i,k-1)) + enddo + enddo + do i=1,l + fk = 1./(cm(i,n)-cl(i,n)*au(i,n-1)) + a1(i,n) = fk*(r1(i,n)-cl(i,n)*a1(i,n-1)) + a2(i,n) = fk*(r2(i,n)-cl(i,n)*a2(i,n-1)) + enddo + do k=n-1,1,-1 + do i=1,l + a1(i,k) = a1(i,k)-au(i,k)*a1(i,k+1) + a2(i,k) = a2(i,k)-au(i,k)*a2(i,k+1) + enddo + enddo +c----------------------------------------------------------------------- + return + end subroutine tridi299 +c----------------------------------------------------------------------- +!> \ingroup PBL +!! \brief Routine to solve the tridiagonal system to calculate u- and v-momentum at \f$ t + \Delta t \f$; part of two-part process to calculate time tendencies due to vertical diffusion. +!! +!! Origin of subroutine unknown. + subroutine tridin99(l,n,nt,cl,cm,cu,r1,r2,au,a1,a2) +cc + use machine , only : kind_phys + implicit none + integer is,k,kk,n,nt,l,i + real(kind=kind_phys) fk(l) +cc + real(kind=kind_phys) cl(l,2:n), cm(l,n), cu(l,n-1), & + & r1(l,n), r2(l,n*nt), & + & au(l,n-1), a1(l,n), a2(l,n*nt), & + & fkk(l,2:n-1) +c----------------------------------------------------------------------- + do i=1,l + fk(i) = 1./cm(i,1) + au(i,1) = fk(i)*cu(i,1) + a1(i,1) = fk(i)*r1(i,1) + enddo + do k = 1, nt + is = (k-1) * n + do i = 1, l + a2(i,1+is) = fk(i) * r2(i,1+is) + enddo + enddo + do k=2,n-1 + do i=1,l + fkk(i,k) = 1./(cm(i,k)-cl(i,k)*au(i,k-1)) + au(i,k) = fkk(i,k)*cu(i,k) + a1(i,k) = fkk(i,k)*(r1(i,k)-cl(i,k)*a1(i,k-1)) + enddo + enddo + do kk = 1, nt + is = (kk-1) * n + do k=2,n-1 + do i=1,l + a2(i,k+is) = fkk(i,k)*(r2(i,k+is)-cl(i,k)*a2(i,k+is-1)) + enddo + enddo + enddo + do i=1,l + fk(i) = 1./(cm(i,n)-cl(i,n)*au(i,n-1)) + a1(i,n) = fk(i)*(r1(i,n)-cl(i,n)*a1(i,n-1)) + enddo + do k = 1, nt + is = (k-1) * n + do i = 1, l + a2(i,n+is) = fk(i)*(r2(i,n+is)-cl(i,n)*a2(i,n+is-1)) + enddo + enddo + do k=n-1,1,-1 + do i=1,l + a1(i,k) = a1(i,k) - au(i,k)*a1(i,k+1) + enddo + enddo + do kk = 1, nt + is = (kk-1) * n + do k=n-1,1,-1 + do i=1,l + a2(i,k+is) = a2(i,k+is) - au(i,k)*a2(i,k+is+1) + enddo + enddo + enddo +c----------------------------------------------------------------------- + return + end subroutine tridin99 + +!> @} + + end module hedmf_hafs diff --git a/physics/moninedmf_hafs.meta b/physics/moninedmf_hafs.meta new file mode 100644 index 000000000..d600c8eac --- /dev/null +++ b/physics/moninedmf_hafs.meta @@ -0,0 +1,526 @@ +[ccpp-arg-table] + name = hedmf_hafs_init + type = scheme +[moninq_fac] + standard_name = atmosphere_diffusivity_coefficient_factor + long_name = multiplicative constant for atmospheric diffusivities + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = hedmf_hafs_run + type = scheme +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[km] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntrac] + standard_name = number_of_vertical_diffusion_tracers + long_name = number of tracers to diffuse vertically + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntcw] + standard_name = index_for_liquid_cloud_condensate + long_name = cloud condensate index in tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[dv] + standard_name = tendency_of_y_wind_due_to_model_physics + long_name = updated tendency of the y wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[du] + standard_name = tendency_of_x_wind_due_to_model_physics + long_name = updated tendency of the x wind + units = m s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[tau] + standard_name = tendency_of_air_temperature_due_to_model_physics + long_name = updated tendency of the temperature + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[rtg] + standard_name = tendency_of_vertically_diffused_tracer_concentration + long_name = updated tendency of the tracers due to vertical diffusion in PBL scheme + units = kg kg-1 s-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys + intent = inout + optional = F +[u1] + standard_name = x_wind + long_name = x component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v1] + standard_name = y_wind + long_name = y component of layer wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t1] + standard_name = air_temperature + long_name = layer mean air temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[q1] + standard_name = vertically_diffused_tracer_concentration + long_name = tracer concentration diffused by PBL scheme + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_vertical_diffusion_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[swh] + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step + long_name = total sky shortwave heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hlw] + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step + long_name = total sky longwave heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xmu] + standard_name = zenith_angle_temporal_adjustment_factor_for_shortwave_fluxes + long_name = zenith angle temporal adjustment factor for shortwave + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[psk] + standard_name = dimensionless_exner_function_at_lowest_model_interface + long_name = dimensionless Exner function at the surface interface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rbsoil] + standard_name = bulk_richardson_number_at_lowest_model_level + long_name = bulk Richardson number at the surface + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length in cm + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[u10m] + standard_name = x_wind_at_10m + long_name = x component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[v10m] + standard_name = y_wind_at_10m + long_name = y component of wind at 10 m + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fm] + standard_name = Monin_Obukhov_similarity_function_for_momentum + long_name = Monin-Obukhov similarity function for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fh] + standard_name = Monin_Obukhov_similarity_function_for_heat + long_name = Monin-Obukhov similarity function for heat + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsea] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[heat] + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward sensible heat flux + units = K m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[evap] + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness + long_name = kinematic surface upward latent heat flux + units = kg kg-1 m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[stress] + standard_name = surface_wind_stress + long_name = surface wind stress + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[spd1] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[kpbl] + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = PBL top model level index + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[del] + standard_name = air_pressure_difference_between_midlayers + long_name = pres(k) - pres(k+1) + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = Exner function at layers + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[delt] + standard_name = time_step_for_physics + long_name = time step for physics + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dspheat] + standard_name = flag_TKE_dissipation_heating + long_name = flag for using TKE dissipation heating + units = flag + dimensions = () + type = logical + intent = in + optional = F +[dusfc] + standard_name = instantaneous_surface_x_momentum_flux + long_name = x momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dvsfc] + standard_name = instantaneous_surface_y_momentum_flux + long_name = y momentum flux + units = Pa + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dtsfc] + standard_name = instantaneous_surface_upward_sensible_heat_flux + long_name = surface upward sensible heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dqsfc] + standard_name = instantaneous_surface_upward_latent_heat_flux + long_name = surface upward latent heat flux + units = W m-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[hpbl] + standard_name = atmosphere_boundary_layer_thickness + long_name = PBL thickness + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[hgamt] + standard_name = countergradient_mixing_term_for_temperature + long_name = countergradient mixing term for temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[hgamq] + standard_name = countergradient_mixing_term_for_water_vapor + long_name = countergradient mixing term for water vapor + units = kg kg-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[dkt] + standard_name = atmosphere_heat_diffusivity + long_name = diffusivity for heat + units = m2 s-1 + dimensions = (horizontal_dimension,vertical_dimension_minus_one) + type = real + kind = kind_phys + intent = out + optional = F +[kinver] + standard_name = index_of_highest_temperature_inversion + long_name = index of highest temperature inversion + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[xkzm_m] + standard_name = atmosphere_momentum_diffusivity_background + long_name = background value of momentum diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xkzm_h] + standard_name = atmosphere_heat_diffusivity_background + long_name = background value of heat diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[xkzm_s] + standard_name = diffusivity_background_sigma_level + long_name = sigma level threshold for background diffusivity + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[lprnt] + standard_name = flag_print + long_name = flag for printing diagnostics to output + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ipr] + standard_name = horizontal_index_of_printed_column + long_name = horizontal index of printed column + units = index + dimensions = () + type = integer + intent = in + optional = F +[xkzminv] + standard_name = atmosphere_heat_diffusivity_background_maximum + long_name = maximum background value of heat diffusivity + units = m2 s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[moninq_fac] + standard_name = atmosphere_diffusivity_coefficient_factor + long_name = multiplicative constant for atmospheric diffusivities + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[islimsk] + standard_name = sea_land_ice_mask + long_name = sea/land/ice mask (=0/1/2) + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/moninshoc.f b/physics/moninshoc.f index df123958a..eb6ccd7e7 100644 --- a/physics/moninshoc.f +++ b/physics/moninshoc.f @@ -25,15 +25,14 @@ end subroutine moninshoc_finalize !! \htmlinclude moninshoc_run.html !! subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, - & u1,v1,t1,q1,tkh,prnum,ntke, - & psk,rbsoil,zorl,u10m,v10m,fm,fh, - & tsea,heat,evap,stress,spd1,kpbl, - & prsi,del,prsl,prslk,phii,phil,delt, - & dusfc,dvsfc,dtsfc,dqsfc,dkt,hpbl, - & kinver,xkzm_m,xkzm_h,xkzm_s,xkzminv, - & lprnt,ipr,me, - & grav, rd, cp, hvap, fv, - & errmsg,errflg) + & u1,v1,t1,q1,tkh,prnum,ntke, + & psk,rbsoil,zorl,u10m,v10m,fm,fh, + & tsea,heat,evap,stress,spd1,kpbl, + & prsi,del,prsl,prslk,phii,phil,delt, + & dusfc,dvsfc,dtsfc,dqsfc,dkt,hpbl, + & kinver,xkzm_m,xkzm_h,xkzm_s,xkzminv, + & grav, rd, cp, hvap, fv, + & errmsg,errflg) ! use machine , only : kind_phys use funcphys , only : fpvs @@ -42,9 +41,8 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! ! arguments ! - logical, intent(in) :: lprnt integer, intent(in) :: ix, im, - & km, ntrac, ntcw, ncnd, ntke, ipr, me + & km, ntrac, ntcw, ncnd, ntke integer, dimension(im), intent(in) :: kinver real(kind=kind_phys), intent(in) :: delt, @@ -59,12 +57,13 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, real(kind=kind_phys), dimension(ix,km,ntrac), intent(in) :: q1 real(kind=kind_phys), dimension(im,km), intent(inout) :: du, dv, - & tau, prnum + & tau real(kind=kind_phys), dimension(im,km,ntrac), intent(inout) :: rtg integer, dimension(im), intent(out) :: kpbl real(kind=kind_phys), dimension(im), intent(out) :: dusfc, & dvsfc, dtsfc, dqsfc, hpbl + real(kind=kind_phys), dimension(im,km), intent(out) :: prnum real(kind=kind_phys), dimension(im,km-1), intent(out) :: dkt character(len=*), intent(out) :: errmsg @@ -93,14 +92,13 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, &, spdk2, rbint, ri, zol1, robn, bvf2 ! real(kind=kind_phys), parameter :: zolcr=0.2, - & zolcru=-0.5, rimin=-100., sfcfrac=0.1, - & crbcon=0.25, crbmin=0.15, crbmax=0.35, - & qmin=1.e-8, zfmin=1.e-8, qlmin=1.e-12, - & aphi5=5., aphi16=16., f0=1.e-4 + & zolcru=-0.5, rimin=-100., sfcfrac=0.1, + & crbcon=0.25, crbmin=0.15, crbmax=0.35, + & qmin=1.e-8, zfmin=1.e-8, qlmin=1.e-12, + & aphi5=5., aphi16=16., f0=1.e-4 &, dkmin=0.0, dkmax=1000. -! &, dkmin=0.0, dkmax=1000., xkzminv=0.3 - &, prmin=0.25, prmax=4.0 - &, vk=0.4, cfac=6.5 +! &, dkmin=0.0, dkmax=1000., xkzminv=0.3 + &, prmin=0.25, prmax=4.0, vk=0.4, cfac=6.5 real(kind=kind_phys) :: gravi, cont, conq, conw, gocp gravi = 1.0/grav @@ -119,11 +117,12 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, ! if (ix < im) stop ! -! if (lprnt) write(0,*)' in moninshoc tsea=',tsea(ipr) dt2 = delt rdt = 1. / dt2 km1 = km - 1 kmpbl = km / 2 +! + rtg = 0.0 ! do k=1,km do i=1,im @@ -161,10 +160,6 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, endif enddo enddo -! if (lprnt) then -! print *,' xkzo=',(xkzo(ipr,k),k=1,km1) -! print *,' xkzmo=',(xkzmo(ipr,k),k=1,km1) -! endif ! ! diffusivity in the inversion layer is set to be xkzminv (m^2/s) ! @@ -208,7 +203,6 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, enddo enddo ! -! if (lprnt) write(0,*)' heat=',heat(ipr),' evap=',evap(ipr) do i = 1,im sflux(i) = heat(i) + evap(i)*fv*theta(i,1) if(.not.sfcflg(i) .or. sflux(i) <= 0.) pblflg(i)=.false. @@ -377,8 +371,6 @@ subroutine moninshoc_run (ix,im,km,ntrac,ntcw,ncnd,dv,du,tau,rtg, a1(i,1) = t1(i,1) + beta(i) * heat(i) a2(i,1) = q1(i,1,1) + beta(i) * evap(i) enddo -! if (lprnt) write(0,*)' a1=',a1(ipr,1),' beta=',beta(ipr) -! &,' heat=',heat(ipr), ' t1=',t1(ipr,1) ntloc = 1 if(ntrac > 1) then diff --git a/physics/moninshoc.meta b/physics/moninshoc.meta index f506b6ab0..d5fd594ab 100644 --- a/physics/moninshoc.meta +++ b/physics/moninshoc.meta @@ -137,7 +137,7 @@ dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys - intent = inout + intent = out optional = F [ntke] standard_name = index_for_turbulent_kinetic_energy_vertical_diffusion_tracer @@ -220,7 +220,7 @@ intent = in optional = F [heat] - standard_name = kinematic_surface_upward_sensible_heat_flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 dimensions = (horizontal_dimension) @@ -229,7 +229,7 @@ intent = in optional = F [evap] - standard_name = kinematic_surface_upward_latent_heat_flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 dimensions = (horizontal_dimension) @@ -424,30 +424,6 @@ kind = kind_phys intent = in optional = F -[lprnt] - standard_name = flag_print - long_name = flag for printing diagnostics to output - units = flag - dimensions = () - type = logical - intent = in - optional = F -[ipr] - standard_name = horizontal_index_of_printed_column - long_name = horizontal index of printed column - units = index - dimensions = () - type = integer - intent = in - optional = F -[me] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in - optional = F [grav] standard_name = gravitational_acceleration long_name = gravitational acceleration diff --git a/physics/mp_fer_hires.meta b/physics/mp_fer_hires.meta index 36b40a95c..a7a33378a 100644 --- a/physics/mp_fer_hires.meta +++ b/physics/mp_fer_hires.meta @@ -268,7 +268,7 @@ optional = F [qc] standard_name = cloud_condensed_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud condensed water updated by physics + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -277,7 +277,7 @@ optional = F [qi] standard_name = ice_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water updated by physics + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -286,7 +286,7 @@ optional = F [qr] standard_name = rain_water_mixing_ratio_updated_by_physics - long_name = moist (dry+vapor, no condensates) mixing ratio of rain water updated by physics + long_name = ratio of mass of rain water to mass of dry air plus vapor (without condensates) updated by physics units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index cda06605e..d7a08b7ef 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -516,15 +516,15 @@ end subroutine mp_thompson_init !>\ingroup aathompson !>\section gen_thompson_hrrr Thompson MP General Algorithm !>@{ - subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & - spechum, qc, qr, qi, qs, qg, ni, nr, & - is_aerosol_aware, nc, nwfa, nifa, & - nwfa2d, nifa2d, & - tgrs, prsl, phii, omega, dtp, & - prcp, rain, graupel, ice, snow, sr, & - refl_10cm, do_radar_ref, & - re_cloud, re_ice, re_snow, & - mpicomm, mpirank, mpiroot, & + subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & + spechum, qc, qr, qi, qs, qg, ni, nr, & + is_aerosol_aware, nc, nwfa, nifa, & + nwfa2d, nifa2d, & + tgrs, prsl, phii, omega, dtp, & + prcp, rain, graupel, ice, snow, sr, & + refl_10cm, reset, do_radar_ref, & + re_cloud, re_ice, re_snow, & + mpicomm, mpirank, mpiroot, & errmsg, errflg) implicit none @@ -546,7 +546,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & real(kind_phys), intent(inout) :: ni(1:ncol,1:nlev) real(kind_phys), intent(inout) :: nr(1:ncol,1:nlev) ! Aerosols - logical, intent(in) :: is_aerosol_aware + logical, intent(in) :: is_aerosol_aware, reset ! The following arrays are not allocated if is_aerosol_aware is false real(kind_phys), optional, intent(inout) :: nc(:,:) real(kind_phys), optional, intent(inout) :: nwfa(:,:) @@ -748,7 +748,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & 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) + errmsg=errmsg, errflg=errflg, reset=reset) else call mp_gt_driver(qv=qv_mp, qc=qc_mp, qr=qr_mp, qi=qi_mp, qs=qs_mp, qg=qg_mp, & @@ -765,7 +765,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & 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) + errmsg=errmsg, errflg=errflg, reset=reset) end if if (errflg/=0) return diff --git a/physics/mp_thompson.meta b/physics/mp_thompson.meta index 7113cf670..cbaf8b801 100644 --- a/physics/mp_thompson.meta +++ b/physics/mp_thompson.meta @@ -492,6 +492,14 @@ kind = kind_phys intent = out optional = F +[reset] + standard_name = flag_for_resetting_radar_reflectivity_calculation + long_name = flag for resetting radar reflectivity calculation + units = flag + dimensions = () + type = logical + intent = in + optional = F [do_radar_ref] standard_name = flag_for_radar_reflectivity long_name = flag for radar reflectivity diff --git a/physics/radiation_aerosols.f b/physics/radiation_aerosols.f index 60bb50d34..f732c37ef 100644 --- a/physics/radiation_aerosols.f +++ b/physics/radiation_aerosols.f @@ -1,6 +1,6 @@ !> \file radiation_aerosols.f !! This file contains climatological atmospheric aerosol schemes for -!! radiation computations. +!! radiation computations ! ========================================================== !!!!! ! 'module_radiation_aerosols' description !!!!! @@ -25,11 +25,10 @@ ! ! ! 'setaer' -- mapping aeros profile, compute aeros opticals ! ! inputs: ! -! (prsi,prsl,prslk,tvly,rhlay,slmsk,tracer,xlon,xlat, ! +! (prsi,prsl,prslk,tvly,rhlay,slmsk,tracer,aerfld,xlon,xlat, ! ! IMAX,NLAY,NLP1, lsswr,lslwr, ! ! outputs: ! -! (aerosw,aerolw,tau_gocart) ! -!! (aerosw,aerolw,aerodp) ! +! (aerosw,aerolw,aerodp) ! ! ! ! ! ! external modules referenced: ! @@ -100,6 +99,9 @@ ! jun 2018 --- h-m lin and y-t hou updated spectral band ! ! mapping method for aerosol optical properties. controled by ! ! internal variable lmap_new through namelist variable iaer. ! +! may 2019 --- sarah lu, restore the gocart option, allowing ! +! aerosol ext, ssa, asy determined from MERRA2 monthly climo ! +! with new spectral band mapping method ! ! ! ! references for opac climatological aerosols: ! ! hou et al. 2002 (ncep office note 441) ! @@ -107,6 +109,11 @@ ! ! ! references for gocart interactive aerosols: ! ! chin et al., 2000 - jgr, v105, 24671-24687 ! +! colarco et al., 2010 - jgr, v115, D14207 ! +! ! +! references for merra2 aerosol reanalysis: ! +! randles et al., 2017 - jclim, v30, 6823-6850 ! +! buchard et al., 2017 - jclim, v30, 6851-6871 ! ! ! ! references for stratosperic volcanical aerosols: ! ! sato et al. 1993 - jgr, v98, d12, 22987-22994 ! @@ -118,12 +125,12 @@ -!> \ingroup RRTMG -!! \defgroup module_radiation_aerosols RRTMG Aerosols Module -!! \brief This module contains climatological atmospheric aerosol schemes for +!> \ingroup rad +!! \defgroup module_radiation_aerosols module_radiation_aerosols +!> @{ +!! This module contains climatological atmospheric aerosol schemes for !! radiation computations. !! -!! !!\version NCEP-Radiation_aerosols v5.2 Jan 2013 !! !!\n This module has three externally callable subroutines: @@ -134,14 +141,22 @@ !! - setaer() -- mapping aeros profile, compute aeros opticals !! !!\n References: -!! - OPAC climatological aerosols: Hou et al. (2002) \cite hou_et_al_2002; -!! Hess et al. (1998) \cite hess_et_al_1998 -!! - GOCART interactive aerosols: Chin et al.(2000) \cite chin_et_al_2000 -!! - Stratospheric volcanical aerosols: Sato et al. (1993) \cite sato_et_al_1993 - -!> This module contains climatological atmospheric aerosol schemes for -!! radiation computations. - module module_radiation_aerosols +!! - OPAC climatological aerosols: +!! Hou et al. 2002 \cite hou_et_al_2002; Hess et al. 1998 +!! \cite hess_et_al_1998 +!! - GOCART interactive aerosols: +!! Chin et al., 2000 \cite chin_et_al_2000 +!! Colarco et al., 2010 - jgr, v115, D14207\cite colarco_et_al_2010 +!! +!! - MERRA2 aerosol reanalysis: +!! Randles et al., 2017 - jclim, v30, 6823-6850\cite randles_et_al_2017 +!! Buchard et al., 2017 - jclim, v30, 6851-6871\cite buchard_et_al_2017 +!! +!! - Stratospheric volcanical aerosols: +!! Sato et al. 1993 \cite sato_et_al_1993 +!========================================! + module module_radiation_aerosols ! +!........................................! ! use physparam,only : iaermdl, iaerflg, lalw1bd, aeros_file, & & ivflip, kind_phys, kind_io4, kind_io8 @@ -154,7 +169,8 @@ module module_radiation_aerosols use module_radlw_parameters, only : NBDLW, wvnlw1, wvnlw2 ! use funcphys, only : fpkap - use gfs_phy_tracer_config, only : gfs_phy_tracer, trcindx + use aerclm_def, only : ntrcaerm + ! implicit none ! @@ -167,28 +183,28 @@ module module_radiation_aerosols ! & VTAGAER='NCEP-Radiation_aerosols v5.0 Aug 2012 ' ! --- general use parameter constants: -! num of output fields for SW rad - integer, parameter, public :: NF_AESW = 3 !< number of output fields for SW rad -! num of output fields for LW rad - integer, parameter, public :: NF_AELW = 3 !< number of output fields for LW rad -! starting band number in ir region - integer, parameter, public :: NLWSTR = 1 !< starting band number in IR region -! num of species for output aod (opnl) +!> num of output fields for SW rad + integer, parameter, public :: NF_AESW = 3 +!> num of output fields for LW rad + integer, parameter, public :: NF_AELW = 3 +!> starting band number in ir region + integer, parameter, public :: NLWSTR = 1 +!> num of species for output aod (opnl) integer, parameter, public :: NSPC = 5 -! total+species +!> total+species integer, parameter, public :: NSPC1 = NSPC + 1 real (kind=kind_phys), parameter :: f_zero = 0.0 real (kind=kind_phys), parameter :: f_one = 1.0 ! --- module control parameters set in subroutine "aer_init" -! number of actual bands for sw aerosols; calculated according to +!> number of actual bands for sw aerosols; calculated according to !! laswflg setting integer, save :: NSWBND = NBDSW -! number of actual bands for lw aerosols; calculated according to +!> number of actual bands for lw aerosols; calculated according to !! lalwflg and lalw1bd settings integer, save :: NLWBND = NBDLW -! total number of bands for sw+lw aerosols +!> total number of bands for sw+lw aerosols integer, save :: NSWLWBD = NBDSW+NBDLW ! LW aerosols effect control flag ! =.true.:aerosol effect is included in LW radiation @@ -212,15 +228,15 @@ module module_radiation_aerosols ! --------------------------------------------------------------------- ! ! --- parameter constants: -! num of wvnum regions where solar flux is constant +!> num of wvnum regions where solar flux is constant integer, parameter, public :: NWVSOL = 151 -! total num of wvnum included +!> total num of wvnum included integer, parameter, public :: NWVTOT = 57600 -! total num of wvnum in ir range +!> total num of wvnum in ir range integer, parameter, public :: NWVTIR = 4000 -! number of wavenumbers in each region where the solar flux is constant +!> number of wavenumbers in each region where the solar flux is constant integer, dimension(NWVSOL), save :: nwvns0 data nwvns0 / 100, 11, 14, 18, 24, 33, 50, 83, 12, 12, & @@ -236,7 +252,7 @@ module module_radiation_aerosols & 483, 505, 529, 554, 580, 610, 641, 675, 711, 751, 793, 841, 891, & & 947,1008,1075,1150,1231,1323,1425,1538,1667,1633,14300 / -! solar flux \f$w/m^2\f$ in each wvnumb region where it is constant +!> solar flux \f$w/m^2\f$ in each wvnumb region where it is constant real (kind=kind_phys), dimension(NWVSOL), save :: s0intv data s0intv( 1: 50) / & @@ -281,22 +297,22 @@ module module_radiation_aerosols ! --------------------------------------------------------------------- ! ! --- parameter constants: -! lower limit (year) data available +!> lower limit (year) data available integer, parameter :: MINVYR = 1850 -! upper limit (year) data available +!> upper limit (year) data available integer, parameter :: MAXVYR = 1999 -! monthly, 45-deg lat-zone aerosols data set in subroutine 'aer_init' +!> monthly, 45-deg lat-zone aerosols data set in subroutine 'aer_init' integer, allocatable, save :: ivolae(:,:,:) ! --- static control variables: -! starting year of data in the input file +!> starting year of data in the input file integer :: kyrstr -! ending year of data in the input file +!> ending year of data in the input file integer :: kyrend -! the year of data in use in the input file +!> the year of data in use in the input file integer :: kyrsav -! the month of data in use in the input file +!> the month of data in use in the input file integer :: kmonsav ! --------------------------------------------------------------------- ! @@ -305,27 +321,27 @@ module module_radiation_aerosols ! --------------------------------------------------------------------- ! ! --- parameters and constants: -! num of max componets in a profile - integer, parameter :: NXC = 5 !< num of max componets in a profile -! num of aerosols profile structures +!> num of max componets in a profile + integer, parameter :: NXC = 5 +!> num of aerosols profile structures integer, parameter :: NAE = 7 -! num of atmos aerosols domains +!> num of atmos aerosols domains integer, parameter :: NDM = 5 -! num of lon-points in glb aeros data set +!> num of lon-points in glb aeros data set integer, parameter :: IMXAE = 72 -! num of lat-points in glb aeros data set +!> num of lat-points in glb aeros data set integer, parameter :: JMXAE = 37 -! num of bands for clim aer data (opac) +!> num of bands for clim aer data (opac) integer, parameter :: NAERBND=61 -! num of rh levels for rh-dep components +!> num of rh levels for rh-dep components integer, parameter :: NRHLEV =8 -! num of rh independent aeros species +!> num of rh independent aeros species integer, parameter :: NCM1 = 6 -! num of rh dependent aeros species +!> num of rh dependent aeros species integer, parameter :: NCM2 = 4 integer, parameter :: NCM = NCM1+NCM2 -! predefined relative humidity levels +!> predefined relative humidity levels real (kind=kind_phys), dimension(NRHLEV), save :: rhlev data rhlev (:) / 0.0, 0.5, 0.7, 0.8, 0.9, 0.95, 0.98, 0.99 / @@ -336,11 +352,11 @@ module module_radiation_aerosols ! prsref(NDM,NAE) - ref pressure lev (sfc to toa) in mb (100Pa) ! sigref(NDM,NAE) - ref sigma lev (sfc to toa) -! scale height of aerosols (km) +!> scale height of aerosols (km) real (kind=kind_phys), save, dimension(NDM,NAE) :: haer -! ref pressure lev (sfc to toa) in mb (100Pa) +!> ref pressure lev (sfc to toa) in mb (100Pa) real (kind=kind_phys), save, dimension(NDM,NAE) :: prsref -! ref sigma lev (sfc to toa) +!> ref sigma lev (sfc to toa) real (kind=kind_phys), save, dimension(NDM,NAE) :: sigref ! --- the following arrays are allocate and setup in subr 'clim_aerinit' @@ -377,274 +393,77 @@ module module_radiation_aerosols ! cmixg (NXC*IMXAE*JMXAE) - aeros component mixing ratio ! denng ( 2 *IMXAE*JMXAE) - aerosols number density -! \name topospheric aerosol profile distribution +!> \name topospheric aerosol profile distribution -! aeros component mixing ratio +!> aeros component mixing ratio real (kind=kind_phys), dimension(NXC,IMXAE,JMXAE), save :: cmixg -! aeros number density +!> aeros number density real (kind=kind_phys), dimension( 2 ,IMXAE,JMXAE), save :: denng -! aeros component index +!> aeros component index integer, dimension(NXC,IMXAE,JMXAE), save :: idxcg -! aeros profile index +!> aeros profile index integer, dimension( IMXAE,JMXAE), save :: kprfg ! --------------------------------------------------------------------- ! ! section-4 : module variables for gocart aerosol optical properties ! ! --------------------------------------------------------------------- ! - -! \name module variables for gocart aerosol optical properties +!> \name module variables for gocart aerosol optical properties ! --- parameters and constants: -! - KCM, KCM1, KCM2 are determined from subroutine 'set_aerspc' -! num of bands for aer data (gocart) - integer, parameter :: KAERBND=61 -! num of rh levels for rh-dep components +!> num of bands for aer data (gocart) + integer, parameter :: KAERBNDD=61 + integer, parameter :: KAERBNDI=56 +!> num of rh levels for rh-dep components integer, parameter :: KRHLEV =36 -!* integer, parameter :: KCM1 = 8 ! num of rh independent aer !species -!* integer, parameter :: KCM2 = 5 ! num of rh dependent aer species -!* integer, parameter :: KCM = KCM1 + KCM2 -! num of rh indep aerosols (set in subr set_aerspc) - integer, save :: KCM1 = 0 -! num of rh dep aerosols (set in subr set_aerspc) - integer, save :: KCM2 = 0 -! =KCM1+KCM2 (set in subr set_aerspc) - integer, save :: KCM - - real (kind=kind_phys), dimension(KRHLEV) :: rhlev_grt +!> num of gocart rh indep aerosols + integer, parameter :: KCM1 = 5 +!> num of gocart rh dep aerosols + integer, parameter :: KCM2 = 10 +!> num of gocart aerosols + integer, parameter :: KCM = KCM1 + KCM2 + + real (kind=kind_phys), dimension(KRHLEV) :: rhlev_grt & data rhlev_grt (:)/ .00, .05, .10, .15, .20, .25, .30, .35, & & .40, .45, .50, .55, .60, .65, .70, .75, .80, .81, .82, & & .83, .84, .85, .86, .87, .88, .89, .90, .91, .92, .93, & & .94, .95, .96, .97, .98, .99 / -! --- the following arrays are allocate and setup in subr 'gocrt_aerinit' -! ------ gocart aerosol specification ------ -! => transported aerosol species: -! DU (5-bins) -! SS (4 bins for climo mode and 5 bins for fcst mode) -! SU (dms, so2, so4, msa) -! OC (phobic, philic) and BC (phobic, philic) -! => species and lumped species for aerosol optical properties -! DU (5-bins, with 4 sub-groups in the submicron bin ) -! SS (ssam for submicron, sscm for coarse mode) -! SU (so4) -! OC (phobic, philic) and BC (phobic, philic) -! => specification used for aerosol optical properties luts -! DU (8 bins) -! SS (ssam, sscm) -! SU (suso) -! OC (waso) and BC (soot) -! -! - spectral band structure: -! iendwv_grt(KAERBND) - ending wavenumber (cm**-1) for each band -! - relative humidity independent aerosol optical properties: -! ===> species : dust (8 bins) -! rhidext0_grt(KAERBND,KCM1) - extinction coefficient -! rhidssa0_grt(KAERBND,KCM1) - single scattering albedo -! rhidasy0_grt(KAERBND,KCM1) - asymmetry parameter -! - relative humidity dependent aerosol optical properties: -! ===> species : soot, suso, waso, ssam, sscm -! rhdpext0_grt(KAERBND,KRHLEV,KCM2) - extinction coefficient -! rhdpssa0_grt(KAERBND,KRHLEV,KCM2) - single scattering albedo -! rhdpasy0_grt(KAERBND,KRHLEV,KCM2) - asymmetry parameter - -! spectral band structure: ending wavenumber (\f$cm^-1\f$) for each band - integer, allocatable, dimension(:) :: iendwv_grt -! relative humidity independent aerosol optical properties: -!! species : dust (8 bins) - -! \name relative humidity independent aerosol optical properties: -! species : dust (8 bins) - -! extinction coefficient - real (kind=kind_phys),allocatable, dimension(:,:) :: rhidext0_grt -! single scattering albedo - real (kind=kind_phys),allocatable, dimension(:,:) :: rhidssa0_grt -! asymmetry parameter - real (kind=kind_phys), allocatable, dimension(:,:) :: rhidasy0_grt -! -! relative humidity dependent aerosol optical properties: -! species : soot, suso, waso, ssam, sscm - -! \name relative humidity dependent aerosol optical properties: -! species : soot, suso, waso, ssam, sscm - -! extinction coefficient - real (kind=kind_phys),allocatable,dimension(:,:,:) :: rhdpext0_grt -! single scattering albedo - real (kind=kind_phys),allocatable,dimension(:,:,:) :: rhdpssa0_grt -! asymmetry parameter - real (kind=kind_phys),allocatable,dimension(:,:,:) :: rhdpasy0_grt - -! - relative humidity independent aerosol optical properties: -! extrhi_grt(KCM1,NSWLWBD) - extinction coefficient for sw+lw spectral band -! ssarhi_grt(KCM1,NSWLWBD) - single scattering albedo for sw+lw spectral band -! asyrhi_grt(KCM1,NSWLWBD) - asymmetry parameter for sw+lw spectral band -! - relative humidity dependent aerosol optical properties: -! extrhd_grt(KRHLEV,KCM2,NSWLWBD) - extinction coefficient for sw+lw band -! ssarhd_grt(KRHLEV,KCM2,NSWLWBD) - single scattering albedo for sw+lw band -! asyrhd_grt(KRHLEV,KCM2,NSWLWBD) - asymmetry parameter for sw+lw band - -!\name relative humidity independent aerosol optical properties - -! extinction coefficient for SW+LW spectral band - real (kind=kind_phys),allocatable,save,dimension(:,:) :: & - & extrhi_grt -! single scattering albedo for SW+LW spectral band - real (kind=kind_phys),allocatable,save,dimension(:,:) :: & - & ssarhi_grt -! asymmetry parameter for SW+LW spectral band +!> \name relative humidity independent aerosol optical properties: +!! species: du001, du002, du003, du004, du005 +! extrhi_grt(KCM1,NSWLWBD) - extinction coefficient for sw+lw band +! scarhi_grt(KCM1,NSWLWBD) - scattering coefficient for sw+lw band +! ssarhi_grt(KCM1,NSWLWBD) - single scattering albedo for sw+lw band +! asyrhi_grt(KCM1,NSWLWBD) - asymmetry parameter for sw+lw band real (kind=kind_phys),allocatable,save,dimension(:,:) :: & - & asyrhi_grt - -! \name relative humidity dependent aerosol optical properties - -! extinction coefficient for SW+LW spectral band - real (kind=kind_phys),allocatable,save,dimension(:,:,:) :: & - & extrhd_grt -! single scattering albedo for SW+LW band - real (kind=kind_phys),allocatable,save,dimension(:,:,:) :: & - & ssarhd_grt -! asymmetry parameter for SW+LW band + & extrhi_grt, scarhi_grt, ssarhi_grt, asyrhi_grt +! +!> \name relative humidity dependent aerosol optical properties: +!! species : ss001, ss002, ss003, ss004, ss005, so4, +!! bcphobic, bcphilic, ocphobic, ocphilic +! extrhd_grt(KRHLEV,KCM2,NSWLWBD) - extinction coefficient for sw+lw band +! scarhd_grt(KRHLEV,KCM2,NSWLWBD) - scattering coefficient for sw+lw band +! ssarhd_grt(KRHLEV,KCM2,NSWLWBD) - single scattering albedo for sw+lw band +! asyrhd_grt(KRHLEV,KCM2,NSWLWBD) - asymmetry parameter for sw+lw band + +!> extinction coefficient real (kind=kind_phys),allocatable,save,dimension(:,:,:) :: & - & asyrhd_grt + & extrhd_grt, scarhd_grt, ssarhd_grt, asyrhd_grt -! \name module variables for gocart aerosol clim data set +!> gocart species + integer, parameter :: num_gc = 5 + character*2 :: gridcomp(num_gc) + integer, dimension (num_gc):: num_radius, radius_lower + integer, dimension (num_gc):: trc_to_aod -! --------------------------------------------------------------------- ! -! section-5 : module variables for gocart aerosol climo data set ! -! --------------------------------------------------------------------- ! -! This version only supports geos3-gocart data set (Jan 2010) -! Modified to support geos4-gocart data set (May 2010) -! -! geos3-gocart vs geos4-gocart -! (1) Use the same module variables -! IMXG,JMXG,KMXG,NMXG,psclmg,dmclmg,geos_rlon,geos_rlat -! (2) Similarity between geos3 and geos 4: -! identical lat/lon grids and aerosol specification; -! direction of vertical index is bottom-up (sfc to toa) -! (3) Difference between geos3 and geos4 -! vertical coordinate (sigma for geos3/hybrid_sigma_pressure for geos4) -! aerosol units (mass concentration for geos3/mixing ratio for geos4) - -! num of lon-points in geos dataset - integer, parameter :: IMXG = 144 -! num of lat-points in geos dataset - integer, parameter :: JMXG = 91 -! num of vertical layers in geos dataset - integer, parameter :: KMXG = 30 -!* integer, parameter :: NMXG = 12 -! to be determined by set_aerspc - integer, save :: NMXG - - real (kind=kind_phys), parameter :: dltx = 360.0 / float(IMXG) - real (kind=kind_phys), parameter :: dlty = 180.0 / float(JMXG-1) - -! --- the following arrays are allocated and setup in 'rd_gocart_clim' -! - geos-gocart climo data (input dataset) -! psclmg - pressure in cb IMXG*JMXG*KMXG -! dmclmg - aerosol dry mass in g/m3 IMXG*JMXG*KMXG*NMXG -! or aerosol mixing ratio in mol/mol or Kg/Kg - -! pressure in cb - real (kind=kind_phys),allocatable, save:: psclmg(:,:,:) -! aerosol dry mass in g/m3 or aerosol mixing ration in mol/mol or Kg/Kg - real (kind=kind_phys),allocatable, save:: dmclmg(:,:,:,:) - -! - geos-gocart lat/lon arrays - real (kind=kind_phys), allocatable, save, dimension(:):: geos_rlon - real (kind=kind_phys), allocatable, save, dimension(:):: geos_rlat - -! control flag for gocart climo data set: xxxx as default; ver3 for geos3; -!! ver4 for geos4; 0000 for unknown data - character*4, save :: gocart_climo = 'xxxx' - -! molecular wght of gocart aerosol species - real (kind=kind_io4), allocatable :: molwgt(:) - -! --------------------------------------------------------------------- -! ! -! section-6 : module variables for gocart aerosol scheme options -! ! -! --------------------------------------------------------------------- -! ! - -! logical parameter for gocart initialization control - logical, save :: lgrtint = .true. - -! logical parameter for gocart debug print control -! logical, save :: lckprnt = .true. - logical, save :: lckprnt = .false. - -! --- the following index/flag/weight are set up in 'set_aerspc' - -! merging coefficients for fcst/clim; determined from fdaer - real (kind=kind_phys), save :: ctaer = f_zero ! user specified wgt - -! option to get fcst gocart aerosol field - logical, save :: get_fcst = .true. -! option to get clim gocart aerosol field - logical, save :: get_clim = .true. - -! ------ gocart aerosol specification ------ -! => transported aerosol species: -! DU (5-bins) -! SS (4 bins for climo mode and 5 bins for fcst mode) -! SU (dms, so2, so4, msa) -! OC (phobic, philic) and BC (phobic, philic) -! => species and lumped species for aerosol optical properties -! DU (5-bins, with 4 sub-groups in the submicron bin ) -! SS (ssam for submicron, sscm for coarse mode) -! SU (so4) -! OC (phobic, philic) and BC (phobic, philic) -! => specification used for aerosol optical properties luts -! DU (8 bins) -! SS (ssam, sscm) -! SU (suso) -! OC (waso) and BC (soot) -! + data gridcomp /'DU', 'SS', 'SU', 'BC', 'OC'/ + data num_radius /5, 5, 1, 2, 2 / + data radius_lower /1, 6, 11, 12, 14 / + data trc_to_aod /1, 5, 4, 2, 3/ ! dust, soot, waso, suso, ssam -! index for rh dependent aerosol optical properties (2nd -! dimension for extrhd_grt, ssarhd_grt, and asyrhd_grt) - integer, save :: isoot, iwaso, isuso, issam, isscm - -! - index for rh independent aerosol optical properties (1st -! dimension for extrhi_grt, ssarhi_grt, and asyrhi_grt) is -! not needed ===> hardwired to 8-bin dust - - type gocart_index_type !< index for gocart aerosol species to be included in the - !! calculations of aerosol optical properties (ext, ssa, asy) - integer :: dust1, dust2, dust3, dust4, dust5 !< dust - integer :: ssam, sscm !< sea salt - integer :: suso !< sulfate - integer :: waso_phobic, waso_philic !< oc - integer :: soot_phobic, soot_philic !< bc - endtype - type (gocart_index_type), save :: dm_indx !< index for aer spec to be included in - !!aeropt calculations - - type tracer_index_type !< index for gocart aerosols from prognostic tracer fields - integer :: du001, du002, du003, du004, du005 !< dust - integer :: ss001, ss002, ss003, ss004, ss005 !< sea salt - integer :: so4 !< sulfate - integer :: ocphobic, ocphilic !< oc - integer :: bcphobic, bcphilic !< bc - endtype - type (tracer_index_type), save :: dmfcs_indx !< index for prognostic aerosol fields - -! - grid components to be included in the aeropt calculations - integer, save :: num_gridcomp = 0 !< number of aerosol grid components - character, allocatable , save :: gridcomp(:)*2 !< aerosol grid components - -! default full-package setting - integer, parameter :: max_num_gridcomp = 5 !< default full-package setting -! data max_gridcomp /'DU', 'BC', 'OC', 'SU', 'SS'/ - character*2 :: max_gridcomp(max_num_gridcomp) - data max_gridcomp /'DU', 'BC', 'OC', 'SU', 'SS'/ - -! GOCART code modification end here (Sarah Lu) -! ------------------------! ! ======================================================================= - +! --------------------------------------------------------------------- ! +! section-5 : module variables for aod diagnostic ! +! --------------------------------------------------------------------- ! !! --- the following are for diagnostic purpose to output aerosol optical depth ! aod from 10 components are grouped into 5 major different species: ! 1:dust (inso,minm,miam,micm,mitr); 2:black carbon (soot) @@ -653,32 +472,32 @@ module module_radiation_aerosols ! idxspc (NCM) - index conversion array ! lspcaod - logical flag for aod from individual species ! - integer, dimension(NCM) :: idxspc !< index conversion array +!> index conversion array:data idxspc / 1, 2, 1, 1, 1, 1, 3, 5, 5, 4 / + integer, dimension(NCM) :: idxspc data idxspc / 1, 2, 1, 1, 1, 1, 3, 5, 5, 4 / ! ! - wvn550 is the wavenumber (1/cm) of wavelenth 550nm for diagnostic aod output ! nv_aod is the sw spectral band covering wvn550 (comp in aer_init) ! - real (kind=kind_phys), parameter :: wvn550 = 1.0e4/0.55 !< the wavenumber (\f$cm^-1\f$) of - !! wavelength 550nm for diagnostic aod output - integer, save :: nv_aod = 1 !< the SW spectral band covering wvn550 (comp in aer_init) +!> the wavenumber (\f$cm^-1\f$) of wavelength 550nm for diagnostic aod output + real (kind=kind_phys), parameter :: wvn550 = 1.0e4/0.55 +!> the sw spectral band covering wvn550 (comp in aer_init) + integer, save :: nv_aod = 1 ! --- public interfaces public aer_init, aer_update, setaer - ! ================= contains ! ================= -!>\ingroup module_radiation_aerosols !> The initialization program is to set up necessary parameters and !! working arrays. !! !>\param NLAY number of model vertical layers (not used) !>\param me print message control flag -!>\section aer_init_gen_al aer_init General Algorithm +!>\section gen_al General Algorithm !! @{ !----------------------------------- subroutine aer_init & @@ -719,7 +538,7 @@ subroutine aer_init & ! ! ! usage: call aer_init ! ! ! -! subprograms called: clim_aerinit, gcrt_aerinit, ! +! subprograms called: clim_aerinit, gocart_aerinit, ! ! wrt_aerlog, set_volcaer, set_spectrum, ! ! ! ! ================================================================== ! @@ -814,14 +633,13 @@ subroutine aer_init & ! --- outputs: & ) -! elseif ( iaermdl == 1 ) then ! gocart-climatology scheme -! elseif ( iaermdl==1 .or. iaermdl==2 ) then ! gocart-clim/prog scheme - -! call gcrt_climinit + elseif ( iaermdl==1 .or. iaermdl==2 ) then ! gocart clim/prog scheme -! elseif ( iaermdl == 2 ) then ! gocart-prognostic scheme - -! call gcrt_aerinit + call gocart_aerinit & +! --- inputs: + & ( solfwv, eirfwv, me & +! --- outputs: + & ) else if ( me == 0 ) then @@ -849,10 +667,7 @@ subroutine aer_init & contains ! ================= -!>\ingroup module_radiation_aerosols !> This subroutine writes aerosol parameter configuration to run log file. -!>\section wrt_aerlog_gen wrt_aerlog General Algorithm -!! @{ !-------------------------------- subroutine wrt_aerlog !................................ @@ -946,15 +761,12 @@ subroutine wrt_aerlog return !................................ end subroutine wrt_aerlog -!! @} !-------------------------------- -!>\ingroup module_radiation_aerosols !> This subroutine defines the one wavenumber solar fluxes based on toa !! solar spectral distribution, and define the one wavenumber IR fluxes !! based on black-body emission distribution at a predefined temperature. -!>\section gel_set_spec set_spectrum General Algorithm -!! @{ +!>\section gel_set_spec General Algorithm !-------------------------------- subroutine set_spectrum !................................ @@ -1045,12 +857,9 @@ subroutine set_spectrum !................................ end subroutine set_spectrum !-------------------------------- -!! @} -!>\ingroup module_radiation_aerosols + !> The initialization program for stratospheric volcanic aerosols. -!>\section set_volcaer_gen set_volcaer General Algorithm -!! @{ !----------------------------- subroutine set_volcaer !............................. @@ -1088,7 +897,6 @@ subroutine set_volcaer return !................................ end subroutine set_volcaer -!! @} !-------------------------------- ! !................................... @@ -1096,7 +904,7 @@ end subroutine aer_init !----------------------------------- !!@} -!>\ingroup module_radiation_aerosols + !> This subroutine is the opac-climatology aerosol initialization !! program to set up necessary parameters and working arrays. !>\param solfwv (NWVTOT), solar flux for each individual wavenumber @@ -1105,7 +913,7 @@ end subroutine aer_init !! \f$(w/m^2)\f$ !!\param me print message control flag !! -!!\section gen_clim_aerinit clim_aerinit General Algorithm +!!\section gen_clim_aerinit General Algorithm !!@{ !----------------------------------- subroutine clim_aerinit & @@ -1193,11 +1001,10 @@ subroutine clim_aerinit & contains ! ================= -!>\ingroup module_radiation_aerosols !> The initialization program for climatological aerosols. The program !! reads and maps the pre-tabulated aerosol optical spectral data onto !! corresponding SW radiation spectral bands. -!!\section det_set_aercoef set_aercoef General Algorithm +!!\section det_set_aercoef General Algorithm !! @{ !-------------------------------- subroutine set_aercoef @@ -1442,7 +1249,7 @@ subroutine set_aercoef if ( lmap_new ) then if (ib == ibs) then - sumsol = f_zero + sumsol = f_zero else sumsol = -0.5 * solfwv(iw1) endif @@ -1536,7 +1343,7 @@ subroutine set_aercoef if ( lmap_new ) then if (ib == ibs) then - sumir = f_zero + sumir = f_zero else sumir = -0.5 * eirfwv(iw1) endif @@ -1635,13 +1442,10 @@ end subroutine set_aercoef !-------------------------------- !! @} -!>\ingroup module_radiation_aerosols !> This subroutine computes mean aerosols optical properties over each !! SW radiation spectral band for each of the species components. This !! program follows GFDL's approach for thick cloud optical property in !! SW radiation scheme (2000). -!>\section optave_gen optavg General Algorithm -!! @{ !-------------------------------- subroutine optavg !................................ @@ -1894,7 +1698,6 @@ subroutine optavg return !................................ end subroutine optavg -!! @} !-------------------------------- ! !................................... @@ -1902,13 +1705,14 @@ end subroutine clim_aerinit !----------------------------------- !!@} -!>\ingroup module_radiation_aerosols + !> This subroutine checks and updates time varying climatology aerosol !! data sets. +!! !>\param iyear 4-digit calender year !!\param imon month of the year !!\param me print message control flag -!>\section gen_aer_upd aer_update General Algorithm +!>\section gen_aer_upd General Algorithm !! @{ !----------------------------------- subroutine aer_update & @@ -1956,7 +1760,11 @@ subroutine aer_update & !> -# Call trop_update() to update monthly tropospheric aerosol data. if ( lalwflg .or. laswflg ) then + + if ( iaermdl == 0 .or. iaermdl==5 ) then ! opac-climatology scheme call trop_update + endif + endif !> -# Call volc_update() to update yearly stratospheric volcanic aerosol data. @@ -1969,11 +1777,8 @@ subroutine aer_update & contains ! ================= -!>\ingroup module_radiation_aerosols !> This subroutine updates the monthly global distribution of aerosol !! profiles in five degree horizontal resolution. -!>\section trop_update_gen trop_update General Algorithm -!! @{ !-------------------------------- subroutine trop_update !................................ @@ -2130,14 +1935,11 @@ subroutine trop_update return !................................ end subroutine trop_update -!! @} !-------------------------------- -!>\ingroup module_radiation_aerosols + !> This subroutine searches historical volcanic data sets to find and !! read in monthly 45-degree lat-zone band of optical depth. -!>\section volc_update_gen volc_update General Algorithm -!! @{ !-------------------------------- subroutine volc_update !................................ @@ -2258,7 +2060,6 @@ subroutine volc_update return !................................ end subroutine volc_update -!! @} !-------------------------------- ! !................................... @@ -2267,7 +2068,6 @@ end subroutine aer_update !! @} -!>\ingroup module_radiation_aerosols !> This subroutine computes aerosols optical properties. !>\param prsi (IMAX,NLP1), pressure at interface in mb !!\param prsl (IMAX,NLAY), layer mean pressure in mb @@ -2292,11 +2092,11 @@ end subroutine aer_update !!\n (:,:,:,2): single scattering albedo !!\n (:,:,:,3): asymmetry parameter !!\param aerodp (IMAX,NSPC1), vertically integrated optical depth -!>\section general_setaer setaer General Algorithm +!>\section general_setaer General Algorithm !> @{ !----------------------------------- subroutine setaer & - & ( prsi,prsl,prslk,tvly,rhlay,slmsk,tracer,xlon,xlat, & ! --- inputs + & ( prsi,prsl,prslk,tvly,rhlay,slmsk,tracer,aerfld,xlon,xlat, & ! --- inputs & IMAX,NLAY,NLP1, lsswr,lslwr, & & aerosw,aerolw & ! --- outputs &, aerodp & @@ -2314,6 +2114,7 @@ subroutine setaer & ! rhlay - layer mean relative humidity IMAX*NLAY ! ! slmsk - sea/land mask (sea:0,land:1,sea-ice:2) IMAX ! ! tracer - aerosol tracer concentration IMAX*NLAY*NTRAC ! +! aerfld - prescribed aerosol mixing rat IMAX*NLAY*NTRCAER! ! xlon - longitude of given points in radiance IMAX ! ! ok for both 0->2pi or -pi->+pi ranges ! ! xlat - latitude of given points in radiance IMAX ! @@ -2364,6 +2165,7 @@ subroutine setaer & real (kind=kind_phys), dimension(:), intent(in) :: xlon, xlat, & & slmsk real (kind=kind_phys), dimension(:,:,:),intent(in):: tracer + real (kind=kind_phys), dimension(:,:,:),intent(in):: aerfld logical, intent(in) :: lsswr, lslwr @@ -2421,7 +2223,6 @@ subroutine setaer & enddo enddo - if ( .not. (lsswr .or. lslwr) ) then return endif @@ -2497,8 +2298,6 @@ subroutine setaer & !! subroutine computes sw + lw aerosol optical properties for gocart !! aerosol species (merged from fcst and clim fields). -!SARAH -! if ( iaerflg == 1 ) then ! use opac aerosol climatology if ( iaermdl==0 .or. iaermdl==5 ) then ! use opac aerosol climatology call aer_property & @@ -2511,6 +2310,20 @@ subroutine setaer & & aerosw,aerolw,aerodp & & ) +! + elseif ( iaermdl==1 .or. iaermdl==2) then ! use gocart aerosols + + call aer_property_gocart & +! --- inputs: + & ( prsi,prsl,prslk,tvly,rhlay,dz,hz,tracer,aerfld, & + & alon,alat,slmsk,laersw,laerlw, & + & IMAX,NLAY,NLP1, & +! --- outputs: + & aerosw,aerolw,aerodp & + & ) + endif ! end if_iaerflg_block + + ! --- check print ! do m = 1, NBDSW ! print *,' *** CHECK AEROSOLS PROPERTIES FOR SW BAND =',m, & @@ -2546,21 +2359,6 @@ subroutine setaer & ! print *,' ASYAER:',aerolw(:,k,m,3) ! enddo ! enddo -! SARAH -! elseif ( iaerflg == 2 ) then ! use gocart aerosol scheme - elseif ( iaermdl == 1 ) then ! use gocart aerosol scheme - - call setgocartaer & - -! --- inputs: - & ( alon,alat,prslk,rhlay,dz,hz,NSWLWBD, & - & prsl,tvly,tracer, & - & IMAX,NLAY,NLP1, ivflip, lsswr,lslwr, & -! --- outputs: - & aerosw,aerolw & - & ) - - endif ! end if_iaerflg_block endif ! end if_laswflg_or_lalwflg_block @@ -2854,7 +2652,6 @@ end subroutine setaer !> @} -!>\ingroup module_radiation_aerosols !> This subroutine maps the 5 degree global climatological aerosol data !! set onto model grids, and compute aerosol optical properties for SW !! and LW radiations. @@ -2871,6 +2668,7 @@ end subroutine setaer !!\param laersw,laerlw logical flag for sw/lw aerosol calculations !!\param IMAX horizontal dimension of arrays !!\param NLAY,NLP1 vertical dimensions of arrays +!!\param NSPC num of species for optional aod output fields !!\param aerosw (IMAX,NLAY,NBDSW,NF_AESW), aeros opt properties for sw !!\n (:,:,:,1): optical depth !!\n (:,:,:,2): single scattering albedo @@ -2880,7 +2678,7 @@ end subroutine setaer !!\n (:,:,:,2): single scattering albedo !!\n (:,:,:,3): asymmetry parameter !!\param aerodp (IMAX,NSPC+1), vertically integrated aer-opt-depth -!!\section gel_aer_pro aer_property General Algorithm +!!\section gel_aer_pro General Algorithm !> @{ !----------------------------------- subroutine aer_property & @@ -3269,11 +3067,9 @@ subroutine aer_property & enddo ! --- for diagnostic output (optional) -! if ( lspcaod ) then - do m = 1, NSPC - aerodp(i,m+1) = spcodp(m) - enddo -! endif + do m = 1, NSPC + aerodp(i,m+1) = spcodp(m) + enddo endif ! end if_larsw_block @@ -3307,12 +3103,10 @@ subroutine aer_property & contains ! ================= -!>\ingroup module_radiation_aerosols !> This subroutine computes aerosols optical properties in NSWLWBD !! bands. there are seven different vertical profile structures. in the !! troposphere, aerosol distribution at each grid point is composed !! from up to six components out of ten different substances. -!\section radclimaer_gen radclimaer General Algorithm !-------------------------------- subroutine radclimaer !................................ @@ -3617,1517 +3411,824 @@ end subroutine aer_property !----------------------------------- !> @} -! ======================================================================= -! GOCART code modification starts here (Sarah lu) ---------------------! -!! -!! gocart_init : set_aerspc, rd_gocart_clim, rd_gocart_luts, optavg_grt -!! setgocartaer: aeropt_grt, map_aermr - -!>\ingroup module_radiation_aerosols -!> The initialization program for gocart aerosols -!! - determine weight and index for aerosol composition/luts -!! - read in monthly global distribution of gocart aerosols -!! - read and map the tabulated aerosol optical spectral data onto -!! corresponding SW/LW radiation spectral bands. +!> This subroutine is the gocart aerosol initialization +!! program to set up necessary parameters and working arrays. +!>\param solfwv (NWVTOT), solar flux for each individual wavenumber +!! \f$(w/m^2)\f$ +!!\param eirfwv (NWVTIR), IR flux(273k) for each individual wavenumber +!! \f$(w/m^2)\f$ +!!\param me print message control flag !! -!>\param NWVTOT total num of wave numbers used in sw spectrum -!!\param solfwv (NWVTOT), solar flux for each individual -!! wavenumber (w/m2) -!!\param soltot total solar flux for the spectrual range (w/m2) -!!\param NWVTIR total num of wave numbers used in the ir region -!!\param eirfwv (NWVTIR), ir flux(273k) for each individual -!! wavenumber (w/m2) -!!\param NBDSW num of bands calculated for sw aeros opt prop -!!\param NLWBND num of bands calculated for lw aeros opt prop -!!\param NSWLWBD total num of bands calc for sw+lw aeros opt prop -!!\param imon month of the year -!!\param me print message control flag -!!\param raddt radiation time step -!!\param fdaer -!>\section gel_go_ini gocart_init General Algorithm +!>\section gel_go_ini General Algorithm !! @{ !----------------------------------- - subroutine gocart_init & - & ( NWVTOT,solfwv,soltot,NWVTIR,eirfwv, & ! --- inputs: - & NBDSW,NLWBND,NSWLWBD,imon,me,raddt,fdaer & ! --- outputs: ( none ) + subroutine gocart_aerinit & + & ( solfwv, eirfwv, me & & ) ! ================================================================== ! ! ! -! subprogram : gocart_init ! -! ! -! this is the initialization program for gocart aerosols ! -! ! -! - determine weight and index for aerosol composition/luts ! -! - read in monthly global distribution of gocart aerosols ! -! - read and map the tabulated aerosol optical spectral data ! -! onto corresponding sw/lw radiation spectral bands. ! +! subprogram : gocart_aerinit ! ! ! -! ==================== defination of variables =================== ! +! gocart_aerinit is the gocart aerosol initialization program ! +! to set up necessary parameters and working arrays. ! ! ! ! inputs: ! -! NWVTOT - total num of wave numbers used in sw spectrum ! ! solfwv(NWVTOT) - solar flux for each individual wavenumber (w/m2)! -! soltot - total solar flux for the spectrual range (w/m2)! -! NWVTIR - total num of wave numbers used in the ir region ! ! eirfwv(NWVTIR) - ir flux(273k) for each individual wavenum (w/m2)! -! NBDSW - num of bands calculated for sw aeros opt prop ! -! NLWBND - num of bands calculated for lw aeros opt prop ! -! NSWLWBD - total num of bands calc for sw+lw aeros opt prop! -! imon - month of the year ! ! me - print message control flag ! ! ! -! outputs: (to the module variables) ! +! outputs: (to module variables) ! ! ! ! module variables: ! -! NBDSW - total number of sw spectral bands ! -! wvnum1,wvnum2 (NSWSTR:NSWEND) ! -! - start/end wavenumbers for each of sw bands ! -! NBDLW - total number of lw spectral bands ! -! wvnlw1,wvnlw2 (NBDLW) ! -! - start/end wavenumbers for each of lw bands ! -! NSWLWBD - total number of sw+lw bands used in this version ! -! extrhi_grt - extinction coef for rh-indep aeros KCM1*NSWLWBD ! -! ssarhi_grt - single-scat-alb for rh-indep aeros KCM1*NSWLWBD ! -! asyrhi_grt - asymmetry factor for rh-indep aeros KCM1*NSWLWBD ! -! extrhd_grt - extinction coef for rh-dep aeros KRHLEV*KCM2*NSWLWBD! -! ssarhd_grt - single-scat-alb for rh-dep aeros KRHLEV*KCM2*NSWLWBD! -! asyrhd_grt - asymmetry factor for rh-dep aerosKRHLEV*KCM2*NSWLWBD! -! ctaer - merging coefficients for fcst/clim fields ! -! get_fcst - option to get fcst aerosol fields ! -! get_clim - option to get clim aerosol fields ! -! dm_indx - index for aer spec to be included in aeropt calculations ! -! dmfcs_indx - index for prognostic aerosol fields ! -! psclmg - geos3/4-gocart pressure IMXG*JMXG*KMXG ! -! dmclmg - geos3-gocart aerosol dry mass IMXG*JMXG*KMXG*NMXG! -! or geos4-gocart aerosol mixing ratio ! +! NWVSOL - num of wvnum regions where solar flux is constant ! +! NWVTOT - total num of wave numbers used in sw spectrum ! +! NWVTIR - total num of wave numbers used in the ir region ! +! NSWBND - total number of sw spectral bands ! +! NLWBND - total number of lw spectral bands ! +! NAERBND - number of bands for climatology aerosol data ! +! KCM1 - number of rh independent aeros species ! +! KCM2 - number of rh dependent aeros species ! ! ! ! usage: call gocart_init ! ! ! -! subprograms called: set_aerspc, rd_gocart_clim, ! -! rd_gocart_luts, optavg_grt ! +! subprograms called: rd_gocart_luts, optavg_gocart ! ! ! ! ================================================================== ! implicit none ! --- inputs: - integer, intent(in) :: NWVTOT,NWVTIR,NBDSW,NLWBND,NSWLWBD,imon,me - - real (kind=kind_phys), intent(in) :: raddt, fdaer + real (kind=kind_phys), dimension(:) :: solfwv ! one wvn sol flux + real (kind=kind_phys), dimension(:) :: eirfwv ! one wvn ir flux - real (kind=kind_phys), intent(in) :: solfwv(:),soltot, eirfwv(:) + integer, intent(in) :: me ! --- output: ( none ) ! --- locals: + real (kind=kind_phys), dimension(kaerbndi,kcm1) :: & + & rhidext0_grt, rhidsca0_grt, rhidssa0_grt, rhidasy0_grt + real (kind=kind_phys), dimension(kaerbndd,krhlev,kcm2):: & + & rhdpext0_grt, rhdpsca0_grt, rhdpssa0_grt, rhdpasy0_grt - real (kind=kind_phys), dimension(NBDSW,KAERBND) :: solwaer - real (kind=kind_phys), dimension(NBDSW) :: solbnd - real (kind=kind_phys), dimension(NLWBND,KAERBND) :: eirwaer - real (kind=kind_phys), dimension(NLWBND) :: eirbnd - real (kind=kind_phys) :: sumsol, sumir, fac, tmp, wvs, wve - - integer, dimension(NBDSW) :: nv1, nv2 - integer, dimension(NLWBND) :: nr1, nr2 - - integer :: i, mb, ib, ii, iw, iw1, iw2, ik, ibs, ibe - -!===> ... begin here - -!-------------------------------------------------------------------------- -! (1) determine aerosol specification index and merging coefficients -!-------------------------------------------------------------------------- + real (kind=kind_phys), dimension(nswbnd,kaerbndd) :: solwaer + real (kind=kind_phys), dimension(nswbnd) :: solbnd + real (kind=kind_phys), dimension(nlwbnd,kaerbndd) :: eirwaer + real (kind=kind_phys), dimension(nlwbnd) :: eirbnd - if ( .not. lgrtint ) then - -! --- ... already done aerspc initialization, continue - - continue - - else + real (kind=kind_phys), dimension(nswbnd,kaerbndi) :: solwaer_du + real (kind=kind_phys), dimension(nswbnd) :: solbnd_du + real (kind=kind_phys), dimension(nlwbnd,kaerbndi) :: eirwaer_du + real (kind=kind_phys), dimension(nlwbnd) :: eirbnd_du -! --- ... set aerosol specification index and merging coefficients + integer, dimension(nswbnd) :: nv1, nv2, nv1_du, nv2_du + integer, dimension(nlwbnd) :: nr1, nr2, nr1_du, nr2_du - call set_aerspc(raddt,fdaer) -! --- inputs: (in scope variables) -! --- outputs: (in scope variables) + integer, dimension(kaerbndd) :: iendwv + integer, dimension(kaerbndi) :: iendwv_du + real (kind=kind_phys), dimension(kaerbndd) :: wavelength + real (kind=kind_phys), dimension(kaerbndi) :: wavelength_du + real (kind=kind_phys) :: sumsol, sumir, sumsol_du, sumir_du - endif ! end if_lgrtinit_block + integer :: i, j, k, mb, ib, ii, iix, iw, iw1, iw2 ! -!-------------------------------------------------------------------------- -! (2) read gocart climatological data -!-------------------------------------------------------------------------- - -! --- ... read gocart climatological data, if needed - - if ( get_clim ) then +!===> ... begin here +! +! --- ... invoke gocart aerosol initialization - call rd_gocart_clim -! --- inputs: (in scope variables) -! --- outputs: (in scope variables) + if (KCM /= ntrcaerm ) then + print *, 'ERROR in # of gocart aer species',KCM + stop 3000 endif -! -!-------------------------------------------------------------------------- -! (3) read and map the tabulated aerosol optical spectral data -! onto corresponding radiation spectral bands -!-------------------------------------------------------------------------- - - if ( .not. lgrtint ) then +! --- ... aloocate and input aerosol optical data -! --- ... already done optical property interpolation, exit + if ( .not. allocated( extrhi_grt ) ) then + allocate ( extrhi_grt ( kcm1,nswlwbd) ) + allocate ( scarhi_grt ( kcm1,nswlwbd) ) + allocate ( ssarhi_grt ( kcm1,nswlwbd) ) + allocate ( asyrhi_grt ( kcm1,nswlwbd) ) + allocate ( extrhd_grt (krhlev,kcm2,nswlwbd) ) + allocate ( scarhd_grt (krhlev,kcm2,nswlwbd) ) + allocate ( ssarhd_grt (krhlev,kcm2,nswlwbd) ) + allocate ( asyrhd_grt (krhlev,kcm2,nswlwbd) ) + endif - return +! --- ... read tabulated GOCART aerosols optical data - else + call rd_gocart_luts +! --- inputs: (in scope variables, module variables) +! --- outputs: (in scope variables) -! --- ... reset lgrtint +! --- ... convert wavelength to wavenumber +! wavelength and wavelength_du are read-in by rd_gocart_luts - lgrtint = .false. + do i = 1, kaerbndd + iendwv(i) = int(10000. / wavelength(i)) + enddo -! --- ... read tabulated aerosol optical input data - call rd_gocart_luts -! --- inputs: (in scope variables) -! --- outputs: (in scope variables) + do i = 1, kaerbndi + iendwv_du(i) = int(10000. / wavelength_du(i)) + enddo ! --- ... compute solar flux weights and interval indices for mapping ! spectral bands between sw radiation and aerosol data + if ( laswflg ) then solbnd (:) = f_zero - solwaer(:,:) = f_zero + solbnd_du (:)= f_zero + do i=1,nswbnd + do j=1,kaerbndd + solwaer(i,j) = f_zero + enddo + do j=1,kaerbndi + solwaer_du(i,j) = f_zero + enddo + enddo - nv_aod = 1 + do ib = 1, nswbnd + mb = ib + nswstr - 1 + ii = 1 + iix = 1 + iw1 = nint(wvnsw1(mb)) + iw2 = nint(wvnsw2(mb)) - ibs = 1 - ibe = 1 - wvs = wvn_sw1(1) - wve = wvn_sw1(1) - do ib = 2, NBDSW - mb = ib + NSWSTR - 1 - if ( wvn_sw2(mb) >= wvn550 .and. wvn550 >= wvn_sw1(mb) ) then + if ( wvnsw2(mb)>=wvn550 .and. wvn550>=wvnsw1(mb) ) then nv_aod = ib ! sw band number covering 550nm wavelenth endif - if ( wvn_sw1(mb) < wvs ) then - wvs = wvn_sw1(mb) - ibs = ib - endif - if ( wvn_sw1(mb) > wve ) then - wve = wvn_sw1(mb) - ibe = ib - endif - enddo - - do ib = 1, NBDSW - mb = ib + NSWSTR - 1 - ii = 1 - iw1 = nint(wvn_sw1(mb)) - iw2 = nint(wvn_sw2(mb)) - - Lab_swdowhile : do while ( iw1 > iendwv_grt(ii) ) - if ( ii == KAERBND ) exit Lab_swdowhile +! -- for rd-dependent + do while ( iw1 > iendwv(ii) ) + if ( ii == kaerbndd ) exit ii = ii + 1 - enddo Lab_swdowhile - - if ( lmap_new ) then - if (ib == ibs) then + enddo sumsol = f_zero - else - sumsol = -0.5 * solfwv(iw1) - endif - if (ib == ibe) then - fac = f_zero - else - fac = -0.5 - endif - solbnd(ib) = sumsol - else - sumsol = f_zero - endif nv1(ib) = ii +! -- for rd-independent + do while ( iw1 > iendwv_du(iix) ) + if ( iix == kaerbndi ) exit + iix = iix + 1 + enddo + sumsol_du = f_zero + nv1_du(ib) = iix + do iw = iw1, iw2 +! -- for rd-dependent solbnd(ib) = solbnd(ib) + solfwv(iw) sumsol = sumsol + solfwv(iw) - if ( iw == iendwv_grt(ii) ) then + if ( iw == iendwv(ii) ) then solwaer(ib,ii) = sumsol - - if ( ii < KAERBND ) then + if ( ii < kaerbndd ) then sumsol = f_zero ii = ii + 1 endif endif + +! -- for rd-independent + solbnd_du(ib) = solbnd_du(ib) + solfwv(iw) + sumsol_du = sumsol_du + solfwv(iw) + + if ( iw == iendwv_du(iix) ) then + solwaer_du(ib,iix) = sumsol_du + if ( iix < kaerbndi ) then + sumsol_du = f_zero + iix = iix + 1 + endif + endif enddo - if ( iw2 /= iendwv_grt(ii) ) then + if ( iw2 /= iendwv(ii) ) then solwaer(ib,ii) = sumsol endif - - if ( lmap_new ) then - tmp = fac * solfwv(iw2) - solwaer(ib,ii) = solwaer(ib,ii) + tmp - solbnd(ib) = solbnd(ib) + tmp + if ( iw2 /= iendwv_du(iix) ) then + solwaer_du(ib,iix) = sumsol_du endif nv2(ib) = ii - - if((me==0) .and. lckprnt) print *,'RAD-nv1,nv2:', & - & ib,iw1,iw2,nv1(ib),iendwv_grt(nv1(ib)), & - & nv2(ib),iendwv_grt(nv2(ib)), & - & 10000./iw1, 10000./iw2 + nv2_du(ib) = iix enddo ! end do_ib_block for sw + endif ! end if_laswflg_block -! --- check the spectral range for the nv_550 band - if((me==0) .and. lckprnt) then - mb = nv_aod + NSWSTR - 1 - iw1 = nint(wvn_sw1(mb)) - iw2 = nint(wvn_sw2(mb)) - print *,'RAD-nv_aod:', & - & nv_aod, iw1, iw2, 10000./iw1, 10000./iw2 - endif -! -! --- ... compute ir flux weights and interval indices for mapping +! --- ... compute lw flux weights and interval indices for mapping ! spectral bands between lw radiation and aerosol data - eirbnd (:) = f_zero - eirwaer(:,:) = f_zero - - ibs = 1 - ibe = 1 - if (NLWBND > 1 ) then - wvs = wvn_lw1(1) - wve = wvn_lw1(1) - do ib = 2, NLWBND - if ( wvn_lw1(ib) < wvs ) then - wvs = wvn_lw1(ib) - ibs = ib - endif - if ( wvn_lw1(ib) > wve ) then - wve = wvn_lw1(ib) - ibe = ib - endif + if ( lalwflg ) then + eirbnd (:) = f_zero + eirbnd_du (:) = f_zero + do i=1,nlwbnd + do j=1,kaerbndd + eirwaer(i,j) = f_zero enddo - endif + do j=1,kaerbndi + eirwaer_du(i,j) = f_zero + enddo + enddo - do ib = 1, NLWBND + do ib = 1, nlwbnd ii = 1 - if ( NLWBND == 1 ) then + iix = 1 + if ( nlwbnd == 1 ) then iw1 = 400 ! corresponding 25 mu iw2 = 2500 ! corresponding 4 mu else - iw1 = nint(wvn_lw1(ib)) - iw2 = nint(wvn_lw2(ib)) + mb = ib + nlwstr - 1 + iw1 = nint(wvnlw1(mb)) + iw2 = nint(wvnlw2(mb)) endif - Lab_lwdowhile : do while ( iw1 > iendwv_grt(ii) ) - if ( ii == KAERBND ) exit Lab_lwdowhile +! -- for rd-dependent + do while ( iw1 > iendwv(ii) ) + if ( ii == kaerbndd ) exit ii = ii + 1 - enddo Lab_lwdowhile - - if ( lmap_new ) then - if (ib == ibs) then + enddo sumir = f_zero - else - sumir = -0.5 * eirfwv(iw1) - endif - if (ib == ibe) then - fac = f_zero - else - fac = -0.5 - endif - eirbnd(ib) = sumir - else - sumir = f_zero - endif nr1(ib) = ii +! -- for rd-independent + do while ( iw1 > iendwv_du(iix) ) + if ( iix == kaerbndi ) exit + iix = iix + 1 + enddo + sumir_du = f_zero + nr1_du(ib) = iix + do iw = iw1, iw2 +! -- for rd-dependent eirbnd(ib) = eirbnd(ib) + eirfwv(iw) sumir = sumir + eirfwv(iw) - if ( iw == iendwv_grt(ii) ) then + if ( iw == iendwv(ii) ) then eirwaer(ib,ii) = sumir - if ( ii < KAERBND ) then + if ( ii < kaerbndd ) then sumir = f_zero ii = ii + 1 endif endif + +! -- for rd-independent + eirbnd_du(ib) = eirbnd_du(ib) + eirfwv(iw) + sumir_du = sumir_du + eirfwv(iw) + + if ( iw == iendwv_du(iix) ) then + eirwaer_du(ib,iix) = sumir_du + + if ( iix < kaerbndi ) then + sumir_du = f_zero + iix = iix + 1 + endif + endif enddo - if ( iw2 /= iendwv_grt(ii) ) then + if ( iw2 /= iendwv(ii) ) then eirwaer(ib,ii) = sumir endif - - nr2(ib) = ii - - if ( lmap_new ) then - tmp = fac * eirfwv(iw2) - eirwaer(ib,ii) = eirwaer(ib,ii) + tmp - eirbnd(ib) = eirbnd(ib) + tmp + if ( iw2 /= iendwv_du(iix) ) then + eirwaer_du(ib,iix) = sumir_du endif - if(me==0 .and. lckprnt) print *,'RAD-nr1,nr2:', & - & ib,iw1,iw2,nr1(ib),iendwv_grt(nr1(ib)), & - & nr2(ib),iendwv_grt(nr2(ib)), & - & 10000./iw1, 10000./iw2 + nr2(ib) = ii + nr2_du(ib) = iix enddo ! end do_ib_block for lw + endif ! end if_lalwflg_block ! --- compute spectral band mean properties for each species - call optavg_grt -! --- inputs: (in scope variables) -! --- outputs: (in scope variables) + call optavg_gocart +! --- inputs: (in-scope variables, module variables) +! --- outputs: (module variables) - if(me==0 .and. lckprnt) then - print *, 'RAD -After optavg_grt, sw band info' - do ib = 1, NBDSW - mb = ib + NSWSTR - 1 - print *,'RAD -wvnsw1,wvnsw2: ',ib,wvn_sw1(mb),wvn_sw2(mb) - print *,'RAD -lamda1,lamda2: ',ib,10000./wvn_sw1(mb), & - & 10000./wvn_sw2(mb) - print *,'RAD -extrhi_grt:', extrhi_grt(:,ib) -! do i = 1, KRHLEV - do i = 1, KRHLEV, 10 - print *, 'RAD -extrhd_grt:',i,rhlev_grt(i), & - & extrhd_grt(i,:,ib) - enddo - enddo - print *, 'RAD -After optavg_grt, lw band info' - do ib = 1, NLWBND - ii = NBDSW + ib - print *,'RAD -wvnlw1,wvnlw2: ',ib,wvn_lw1(ib),wvn_lw2(ib) - print *,'RAD -lamda1,lamda2: ',ib,10000./wvn_lw1(ib), & - & 10000./wvn_lw2(ib) - print *,'RAD -extrhi_grt:', extrhi_grt(:,ii) -! do i = 1, KRHLEV - do i = 1, KRHLEV, 10 - print *, 'RAD -extrhd_grt:',i,rhlev_grt(i), & - & extrhd_grt(i,:,ii) - enddo - enddo - endif -! --- ... dealoocate input data arrays no longer needed - deallocate ( iendwv_grt ) - if ( allocated(rhidext0_grt) ) then - deallocate ( rhidext0_grt ) - deallocate ( rhidssa0_grt ) - deallocate ( rhidasy0_grt ) - endif - if ( allocated(rhdpext0_grt) ) then - deallocate ( rhdpext0_grt ) - deallocate ( rhdpssa0_grt ) - deallocate ( rhdpasy0_grt ) - endif - - endif ! end if_lgrtinit_block +! --- check print +! if (me == 0) then +! do ib = 1, NSWBND +! mb = ib + NSWSTR - 1 +! print *, ' wvnsw1,wvnsw2 :',wvnsw1(mb),wvnsw2(mb) +! print *, ' After optavg_gocart, for sw band:',ib +! print *, ' extrhi:', extrhi_grt(:,ib) +! print *, ' scarhi:', scarhi_grt(:,ib) +! print *, ' ssarhi:', ssarhi_grt(:,ib) +! print *, ' asyrhi:', asyrhi_grt(:,ib) +! do i = 1, KRHLEV +! print *, ' extrhd for rhlev:',i +! print *, extrhd_grt(i,:,ib) +! print *, ' scarhd for rhlev:',i +! print *, scarhd_grt(i,:,ib) +! print *, ' ssarhd for rhlev:',i +! print *, ssarhd_grt(i,:,ib) +! print *, ' asyrhd for rhlev:',i +! print *, asyrhd_grt(i,:,ib) +! enddo +! enddo +! print *, ' wvnlw1 :',wvnlw1 +! print *, ' wvnlw2 :',wvnlw2 +! do ib = 1, NLWBND +! ii = NSWBND + ib +! print *,' After optavg_gocart, for lw band:',ib +! print *,' extrhi_grt:', extrhi_grt(:,ii) +! print *,' scarhi_grt:', scarhi_grt(:,ii) +! print *,' ssarhi_grt:', ssarhi_grt(:,ii) +! print *,' asyrhi_grt:', asyrhi_grt(:,ii) +! do i = 1, KRHLEV +! print *,' extrhd for rhlev:',i +! print *, extrhd_grt(i,:,ib) +! print *,' scarhd for rhlev:',i +! print *, scarhd_grt(i,:,ib) +! print *,' ssarhd for rhlev:',i +! print *, ssarhd_grt(i,:,ib) +! print *,' asyrhd for rhlev:',i +! print *, asyrhd_grt(i,:,ib) +! enddo +! enddo +! endif ! ================= contains ! ================= -!>\ingroup module_radiation_aerosols -!> This subroutine determines merging coefficients ctaer; setup aerosol -!! specification. The current version only supports prognostic aerosols -!! (from GOCART in-line calculations) and climo aerosols (from GEOS-GOCART -!! runs). -!!\section set_aerspc_gen set_aerspc General Algorithm -!! place holder !----------------------------- - subroutine set_aerspc(raddt,fdaer) + subroutine rd_gocart_luts !............................. -! --- inputs: (in scope variables) +! --- inputs: (in scope variables, module variables) ! --- outputs: (in scope variables) ! ==================================================================== ! ! ! -! subprogram: set_aerspc ! -! ! -! determine merging coefficients ctaer; ! -! set up aerosol specification: num_gridcomp, gridcomp, dm_indx, ! -! dmfcs_indx, isoot, iwaso, isuso, issam, isscm ! -! ! -! Aerosol optical properties (ext, ssa, asy) are determined from ! -! NMGX (<=12) aerosol species ! -! ==> DU: dust1 (4 sub-micron bins), dust2, dust3, dust4, dust5 ! -! BC: soot_phobic, soot_philic ! -! OC: waso_phobic, waso_philic ! -! SU: suso (=so4) ! -! SS: ssam (accumulation mode), sscm (coarse mode) ! +! subprogram: rd_gocart_luts ! +! read GMAO pre-tabultaed aerosol optical data for dust, seasalt, ! +! sulfate, black carbon, and organic carbon aerosols ! ! ! -! The current version only supports prognostic aerosols (from GOCART ! -! in-line calculations) and climo aerosols (from GEOS-GOCART runs) ! +! major local variables: ! +! for handling spectral band structures ! +! iendwv - ending wvnum (cm**-1) for each band kaerbndd ! +! iendwv_du - ending wvnum (cm**-1) for each band kaerbndi ! +! for handling optical properties of rh independent species (kcm1) ! +! 1=du001, 2=du002, 3=du003, 4=du004, 5=du005 ! +! rhidext0_grt - extinction coefficient kaerbndi*kcm1 ! +! rhidsca0_grt - scattering coefficient kaerbndi*kcm1 ! +! rhidssa0_grt - single scattering albedo kaerbndi*kcm1 ! +! rhidasy0_grt - asymmetry parameter kaerbndi*kcm1 ! +! for handling optical properties of rh ndependent species (kcm2) ! +! 1=ss001, 2=ss002, 3=ss003, 4=ss004, 5=ss005, 6=so4, ! +! 7=bcphobic, 8=bcphilic, 9=ocphobic, 10=ocphilic ! +! rhdpext0_grt - extinction coefficient kaerbndd*krhlev*kcm2! +! rhdpsca0_grt - scattering coefficient kaerbndd*krhlev*kcm2! +! rhdpssa0_grt - single scattering albedo kaerbndd*krhlev*kcm2! +! rhdpasy0_grt - asymmetry parameter kaerbndd*krhlev*kcm2! +! ! +! usage: call rd_gocart_luts ! ! ! ! ================================================================== ! ! implicit none -! --- inputs: - real (kind=kind_phys), intent(in) :: raddt, fdaer -! --- output: - -! --- local: -! real (kind=kind_phys) :: raddt - integer :: i, indxr - character*2 :: tp, gridcomp_tmp(max_num_gridcomp) - -!! ===> determine ctaer (user specified weight for fcst fields) -! raddt = min(fhswr,fhlwr) / 24. - if( fdaer >= 99999. ) ctaer = f_one - if((fdaer>0.).and.(fdaer<99999.)) ctaer=exp(-raddt/fdaer) - - if(me==0 .and. lckprnt) then - print *, 'RAD -raddt, fdaer,ctaer: ', raddt, fdaer, ctaer - if (ctaer == f_one ) then - print *, 'LU -aerosol fields determined from fcst' - elseif (ctaer == f_zero) then - print *, 'LU -aerosol fields determined from clim' - else - print *, 'LU -aerosol fields determined from fcst/clim' - endif - endif +! --- inputs: (none) +! --- output: (none) -!! ===> determine get_fcst and get_clim -!! if fcst is chosen (ctaer == f_one ), set get_clim to F -!! if clim is chosen (ctaer == f_zero), set get_fcst to F - if ( ctaer == f_one ) get_clim = .false. - if ( ctaer == f_zero ) get_fcst = .false. - -!! ===> determine aerosol species to be included in the calculations -!! of aerosol optical properties (ext, ssa, asy) - -!* If climo option is chosen, the aerosol composition is hardwired -!* to full package. If not, the composition is determined from -!* tracer_config on-the-fly (full package or subset) - lab_if_fcst : if ( get_fcst ) then - -!! use tracer_config to determine num_gridcomp and gridcomp - if ( gfs_phy_tracer%doing_GOCART ) then - if ( gfs_phy_tracer%doing_DU ) then - num_gridcomp = num_gridcomp + 1 - gridcomp_tmp(num_gridcomp) = 'DU' - endif - if ( gfs_phy_tracer%doing_SU ) then - num_gridcomp = num_gridcomp + 1 - gridcomp_tmp(num_gridcomp) = 'SU' - endif - if ( gfs_phy_tracer%doing_SS ) then - num_gridcomp = num_gridcomp + 1 - gridcomp_tmp(num_gridcomp) = 'SS' - endif - if ( gfs_phy_tracer%doing_OC ) then - num_gridcomp = num_gridcomp + 1 - gridcomp_tmp(num_gridcomp) = 'OC' - endif - if ( gfs_phy_tracer%doing_BC ) then - num_gridcomp = num_gridcomp + 1 - gridcomp_tmp(num_gridcomp) = 'BC' - endif +! --- locals: + integer :: iradius, ik, ibeg + integer, parameter :: numspc = 5 ! # of aerosol species + +! - input tabulated aerosol optical spectral data from GSFC + real, dimension(kaerbndd) :: lambda ! wavelength (m) for non-dust + real, dimension(kaerbndi) :: lambda_du ! wavelength (m) for dust + real, dimension(krhlev) :: rh ! relative humidity (fraction) + real, dimension(kaerbndd,krhlev,numspc) :: bext! extinction efficiency (m2/kg) + real, dimension(kaerbndd,krhlev,numspc) :: bsca! scattering efficiency (m2/kg) + real, dimension(kaerbndd,krhlev,numspc) :: g ! asymmetry factor (dimensionless) + real, dimension(kaerbndi,krhlev,numspc) :: bext_du! extinction efficiency (m2/kg) + real, dimension(kaerbndi,krhlev,numspc) :: bsca_du! scattering efficiency (m2/kg) + real, dimension(kaerbndi,krhlev,numspc) :: g_du ! asymmetry factor (dimensionless) ! - if ( num_gridcomp > 0 ) then - allocate ( gridcomp(num_gridcomp) ) - gridcomp(1:num_gridcomp) = gridcomp_tmp(1:num_gridcomp) - else - print *,'ERROR: prognostic aerosols not found,abort',me - stop 1000 - endif - - else ! gfs_phy_tracer%doing_GOCART=F - - print *,'ERROR: prognostic aerosols option off, abort',me - stop 1001 - - endif ! end_if_gfs_phy_tracer%doing_GOCART_if_ - - else lab_if_fcst - -!! set to full package (max_num_gridcomp and max_gridcomp) - num_gridcomp = max_num_gridcomp - allocate ( gridcomp(num_gridcomp) ) - gridcomp(1:num_gridcomp) = max_gridcomp(1:num_gridcomp) - - endif lab_if_fcst - -!! -!! Aerosol specification is determined as such: -!! A. For radiation-aerosol feedback, the specification is based on the aeropt -!! routine from Mian Chin and Hongbin Yu (hydrophobic and hydrophilic for -!! OC/BC; submicron and supermicron for SS, 8-bins (with 4 subgroups for the -!! the submicron bin) for DU, and SO4 for SU) -!! B. For transport, the specification is determined from GOCART in-line module -!! C. For LUTS, (waso, soot, ssam, sscm, suso, dust) is used, based on the -!! the OPAC climo aerosol scheme (implemented by Yu-Tai Hou) - -!!=== determine dm_indx and NMXG - indxr = 0 - dm_indx%waso_phobic = -999 ! OC - dm_indx%soot_phobic = -999 ! BC - dm_indx%ssam = -999 ! SS - dm_indx%suso = -999 ! SU - dm_indx%dust1 = -999 ! DU - do i = 1, num_gridcomp - tp = gridcomp(i) - select case ( tp ) - case ( 'OC') ! consider hydrophobic and hydrophilic - dm_indx%waso_phobic = indxr + 1 - dm_indx%waso_philic = indxr + 2 - indxr = indxr + 2 - case ( 'BC') ! consider hydrophobic and hydrophilic - dm_indx%soot_phobic = indxr + 1 - dm_indx%soot_philic = indxr + 2 - indxr = indxr + 2 - case ( 'SS') ! consider submicron and supermicron - dm_indx%ssam = indxr + 1 - dm_indx%sscm = indxr + 2 - indxr = indxr + 2 - case ( 'SU') ! consider SO4 only - dm_indx%suso = indxr + 1 - indxr = indxr + 1 - case ( 'DU') ! consider all 5 bins - dm_indx%dust1 = indxr + 1 - dm_indx%dust2 = indxr + 2 - dm_indx%dust3 = indxr + 3 - dm_indx%dust4 = indxr + 4 - dm_indx%dust5 = indxr + 5 - indxr = indxr + 5 - case default - print *,'ERROR: aerosol species not supported, abort',me - stop 1002 - end select - enddo -!! - NMXG = indxr ! num of gocart aer spec for opt cal -!! - -!!=== determine dmfcs_indx -!! SS: 5-bins are considered for transport while only two groups -!! (accumulation/coarse modes) are considered for radiation -!! DU: 5-bins are considered for transport while 8 bins (with the -!! submicorn bin exptended to 4 bins) are considered for radiation -!! SU: DMS, SO2, and MSA are not considered for radiation - - if ( get_fcst ) then - if ( gfs_phy_tracer%doing_OC ) then - dmfcs_indx%ocphobic = trcindx ('ocphobic', gfs_phy_tracer) - dmfcs_indx%ocphilic = trcindx ('ocphilic', gfs_phy_tracer) - endif - if ( gfs_phy_tracer%doing_BC ) then - dmfcs_indx%bcphobic = trcindx ('bcphobic', gfs_phy_tracer) - dmfcs_indx%bcphilic = trcindx ('bcphilic', gfs_phy_tracer) - endif - if ( gfs_phy_tracer%doing_SS ) then - dmfcs_indx%ss001 = trcindx ('ss001', gfs_phy_tracer) - dmfcs_indx%ss002 = trcindx ('ss002', gfs_phy_tracer) - dmfcs_indx%ss003 = trcindx ('ss003', gfs_phy_tracer) - dmfcs_indx%ss004 = trcindx ('ss004', gfs_phy_tracer) - dmfcs_indx%ss005 = trcindx ('ss005', gfs_phy_tracer) - endif - if ( gfs_phy_tracer%doing_SU ) then - dmfcs_indx%so4 = trcindx ('so4', gfs_phy_tracer) - endif - if ( gfs_phy_tracer%doing_DU ) then - dmfcs_indx%du001 = trcindx ('du001', gfs_phy_tracer) - dmfcs_indx%du002 = trcindx ('du002', gfs_phy_tracer) - dmfcs_indx%du003 = trcindx ('du003', gfs_phy_tracer) - dmfcs_indx%du004 = trcindx ('du004', gfs_phy_tracer) - dmfcs_indx%du005 = trcindx ('du005', gfs_phy_tracer) - endif - endif + logical :: file_exist + character*50 :: fin, dummy + +! --- read LUTs for dust aerosols + fin='optics_'//gridcomp(1)//'.dat' + inquire (file=trim(fin), exist=file_exist) + if ( file_exist ) then + close(niaercm) + open (unit=niaercm, file=fin, status='OLD') + rewind(niaercm) + else + print *,' Requested luts file ',trim(fin),' not found' + print *,' ** Stopped in rd_gocart_luts ** ' + stop 1220 + endif ! end if_file_exist_block + + iradius = 5 +! read lambda and compute mpwavelength (m) + read(niaercm,'(a40)') dummy + read(niaercm,*) (lambda_du(i), i=1, kaerbndi) +! read rh, relative humidity (fraction) + read(niaercm,'(a40)') dummy + read(niaercm,*) (rh(i), i=1, krhlev) +! read bext (m2 (kg dry mass)-1) + do k = 1, iradius + read(niaercm,'(a40)') dummy + do j=1, krhlev + read(niaercm,*) (bext_du(i,j,k), i=1,kaerbndi) + enddo + enddo +! read bsca (m2 (kg dry mass)-1) + do k = 1, iradius + read(niaercm,'(a40)') dummy + do j=1, krhlev + read(niaercm,*) (bsca_du(i,j,k), i=1, kaerbndi) + enddo + enddo +! read g (dimensionless) + do k = 1, iradius + read(niaercm,'(a40)') dummy + do j=1, krhlev + read(niaercm,*) (g_du(i,j,k), i=1, kaerbndi) + enddo + enddo -!! -!!=== determin KCM, KCM1, KCM2 -!! DU: submicron bin (dust1) contains 4 sub-groups (e.g., hardwire -!! 8 bins for aerosol optical properties luts) -!! OC/BC: while hydrophobic aerosols are rh-independent, the luts -!! for hydrophilic aerosols are used (e.g., use the coeff -!! corresponding to rh=0) -!! - indxr = 1 - isoot = -999 - iwaso = -999 - isuso = -999 - issam = -999 - isscm = -999 - do i = 1, num_gridcomp - tp = gridcomp(i) - if ( tp /= 'DU' ) then !<--- non-dust aerosols - select case ( tp ) - case ( 'OC ') - iwaso = indxr - case ( 'BC ') - isoot = indxr - case ( 'SU ') - isuso = indxr - case ( 'SS ') - issam = indxr - isscm = indxr + 1 - end select - if ( tp /= 'SS' ) then - indxr = indxr + 1 +! fill rhidext0 local arrays for dust aerosols (flip i-index) + do i = 1, kaerbndi ! convert from m to micron + j = kaerbndi -i + 1 ! flip i-index + wavelength_du(j) = 1.e6 * lambda_du(i) + enddo + do k = 1, iradius + do i = 1, kaerbndi + ii = kaerbndi -i + 1 + rhidext0_grt(ii,k) = bext_du(i,1,k) + rhidsca0_grt(ii,k) = bsca_du(i,1,k) + if ( bext_du(i,1,k) /= f_zero) then + rhidssa0_grt(ii,k) = bsca_du(i,1,k)/bext_du(i,1,k) else - indxr = indxr + 2 + rhidssa0_grt(ii,k) = f_one endif - else !<--- dust aerosols - KCM1 = 8 ! num of rh independent aer species - endif - enddo - KCM2 = indxr - 1 ! num of rh dependent aer species - KCM = KCM1 + KCM2 ! total num of aer species - -!! -!! check print starts here - if( me == 0 .and. lckprnt) then - print *, 'RAD -num_gridcomp:', num_gridcomp - print *, 'RAD -gridcomp :', gridcomp(:) - print *, 'RAD -NMXG:', NMXG - print *, 'RAD -dm_indx ===> ' - print *, 'RAD -aerspc: dust1=', dm_indx%dust1 - print *, 'RAD -aerspc: dust2=', dm_indx%dust2 - print *, 'RAD -aerspc: dust3=', dm_indx%dust3 - print *, 'RAD -aerspc: dust4=', dm_indx%dust4 - print *, 'RAD -aerspc: dust5=', dm_indx%dust5 - print *, 'RAD -aerspc: ssam=', dm_indx%ssam - print *, 'RAD -aerspc: sscm=', dm_indx%sscm - print *, 'RAD -aerspc: suso=', dm_indx%suso - print *, 'RAD -aerspc: waso_phobic=',dm_indx%waso_phobic - print *, 'RAD -aerspc: waso_philic=',dm_indx%waso_philic - print *, 'RAD -aerspc: soot_phobic=',dm_indx%soot_phobic - print *, 'RAD -aerspc: soot_philic=',dm_indx%soot_philic - - print *, 'RAD -KCM1 =', KCM1 - print *, 'RAD -KCM2 =', KCM2 - print *, 'RAD -KCM =', KCM - if ( KCM2 > 0 ) then - print *, 'RAD -aerspc: issam=', issam - print *, 'RAD -aerspc: isscm=', isscm - print *, 'RAD -aerspc: isuso=', isuso - print *, 'RAD -aerspc: iwaso=', iwaso - print *, 'RAD -aerspc: isoot=', isoot - endif - - if ( get_fcst ) then - print *, 'RAD -dmfcs_indx ===> ' - print *, 'RAD -trc_du001=',dmfcs_indx%du001 - print *, 'RAD -trc_du002=',dmfcs_indx%du002 - print *, 'RAD -trc_du003=',dmfcs_indx%du003 - print *, 'RAD -trc_du004=',dmfcs_indx%du004 - print *, 'RAD -trc_du005=',dmfcs_indx%du005 - print *, 'RAD -trc_so4 =',dmfcs_indx%so4 - print *, 'RAD -trc_ocphobic=',dmfcs_indx%ocphobic - print *, 'RAD -trc_ocphilic=',dmfcs_indx%ocphilic - print *, 'RAD -trc_bcphobic=',dmfcs_indx%bcphobic - print *, 'RAD -trc_bcphilic=',dmfcs_indx%bcphilic - print *, 'RAD -trc_ss001=',dmfcs_indx%ss001 - print *, 'RAD -trc_ss002=',dmfcs_indx%ss002 - print *, 'RAD -trc_ss003=',dmfcs_indx%ss003 - print *, 'RAD -trc_ss004=',dmfcs_indx%ss004 - print *, 'RAD -trc_ss005=',dmfcs_indx%ss005 - endif - endif -!! check print ends here - - return -! ! - end subroutine set_aerspc - -!----------------------------------- -!>\ingroup module_radiation_aerosols -!> This subroutine reads input gocart aerosol optical data from Mie -!! code calculations. -!\section rd_gocart_luts_gen rd_gocart_luts General Algorithm -!----------------------------- - subroutine rd_gocart_luts -!............................. -! --- inputs: (in scope variables) -! --- outputs: (in scope variables) - -! ==================================================================== ! -! subprogram: rd_gocart_luts ! -! read input gocart aerosol optical data from Mie code calculations ! -! ! -! Remarks (Quanhua (Mark) Liu, JCSDA, June 2008) ! -! The LUT is for NCEP selected 61 wave numbers and 6 aerosols ! -! (dust, soot, suso, waso, ssam, and sscm) and 36 aerosol effective ! -! size in microns. ! -! ! -! The LUT is computed using Mie code with a logorithm size ! -! distribution for each of 36 effective sizes. The standard deviation ! -! sigma of the size, and min/max size follows Chin et al. 2000 ! -! For each effective size, it corresponds a relative humidity value. ! -! ! -! The LUT contains the density, sigma, relative humidity, mean mode ! -! radius, effective size, mass extinction coefficient, single ! -! scattering albedo, asymmetry factor, and phase function ! -! ! -! ================================================================== ! -! - implicit none - -! --- inputs: -! --- output: - -! --- locals: - INTEGER, PARAMETER :: NP = 100, NP2 = 2*NP, nWave=100, & - & nAero=6, n_p=36 - INTEGER :: NW, NS, nH, n_bin - real (kind=kind_io8), Dimension( NP2 ) :: Angle, Cos_Angle, & - & Cos_Weight - real (kind=kind_io8), Dimension(n_p,nAero) :: RH, rm, reff - real (kind=kind_io8), Dimension(nWave,n_p,nAero) :: & - & ext0, sca0, asy0 - real (kind=kind_io8), Dimension(NP2,n_p,nWave,nAero) :: ph0 - real (kind=kind_io8) :: wavelength(nWave), density(nAero), & - & sigma(nAero), wave,n_fac,PI,t1,s1,g1 - CHARACTER(len=80) :: AerosolName(nAero) - INTEGER :: i, j, k, l, ij - - character :: aerosol_file*30 - logical :: file_exist - integer :: indx_dust(8) ! map 36 dust bins to gocart size bins - - data aerosol_file /"NCEP_AEROSOL.bin"/ - data AerosolName/ ' Dust ', ' Soot ', ' SUSO ', ' WASO ', & - & ' SSAM ', ' SSCM '/ - -!! 8 dust bins -!! 1 2 3 4 5 6 7 8 -!! .1-.18, .18-.3, .3-.6, 0.6-1.0, 1.0-1.8, 1.8-3, 3-6, 6-10 <-- def -!! 0.1399 0.2399 0.4499 0.8000 1.3994 2.3964 4.4964 7.9887 <-- reff - data indx_dust/4, 8, 12, 18, 21, 24, 30, 36/ - -! PI = acos(-1.d0) - -! -- allocate aerosol optical data - if ( .not. allocated( iendwv_grt ) ) then - allocate ( iendwv_grt (KAERBND) ) - endif - if (.not. allocated(rhidext0_grt) .and. KCM1 > 0 ) then - allocate ( rhidext0_grt(KAERBND,KCM1)) - allocate ( rhidssa0_grt(KAERBND,KCM1)) - allocate ( rhidasy0_grt(KAERBND,KCM1)) - endif - if (.not. allocated(rhdpext0_grt) .and. KCM2 > 0 ) then - allocate ( rhdpext0_grt(KAERBND,KRHLEV,KCM2)) - allocate ( rhdpssa0_grt(KAERBND,KRHLEV,KCM2)) - allocate ( rhdpasy0_grt(KAERBND,KRHLEV,KCM2)) - endif - -! -- read luts - inquire (file = aerosol_file, exist = file_exist) - - if ( file_exist ) then - if(me==0 .and. lckprnt) print *,'RAD -open :',aerosol_file - close (NIAERCM) - open (unit=NIAERCM,file=aerosol_file,status='OLD', & - & action='read',form='UNFORMATTED') - else - print *,' Requested aerosol data file "',aerosol_file, & - & '" not found!', me - print *,' *** Stopped in subroutine RD_GOCART_LUTS !!' - stop 1003 - endif ! end if_file_exist_block - - READ(NIAERCM) (Cos_Angle(i),i=1,NP) - READ(NIAERCM) (Cos_Weight(i),i=1,NP) - READ(NIAERCM) - READ(NIAERCM) - READ(NIAERCM) NW,NS - READ(NIAERCM) - READ(NIAERCM) (wavelength(i),i=1,NW) - -! --- check nAero and NW - if (NW /= KAERBND) then - print *, "Incorrect spectral band, abort ", NW - stop 1004 - endif - -! --- convert wavelength to wavenumber - do i = 1, KAERBND - iendwv_grt(i) = 10000. / wavelength(i) - if(me==0 .and. lckprnt) print *,'RAD -wn,lamda:', & - & i,iendwv_grt(i),wavelength(i) - enddo + rhidasy0_grt(ii,k) = g_du(i,1,k) + enddo + enddo - DO j = 1, nAero - if(me==0 .and. lckprnt) print *,'RAD -read LUTs:', & - & j,AerosolName(j) - READ(NIAERCM) - READ(NIAERCM) - READ(NIAERCM) n_bin, density(j), sigma(j) - READ(NIAERCM) - READ(NIAERCM) (RH(i,j),i=1, n_bin) - READ(NIAERCM) - READ(NIAERCM) (rm(i,j),i=1, n_bin) - READ(NIAERCM) - READ(NIAERCM) (reff(i,j),i=1, n_bin) - -! --- check n_bin - if (n_bin /= KRHLEV ) then - print *, "Incorrect rh levels, abort ", n_bin - stop 1005 - endif +! --- read LUTs for non-dust aerosols + do ib = 2, num_gc ! loop thru SS, SU, BC, OC + fin='optics_'//gridcomp(ib)//'.dat' + inquire (file=trim(fin), exist=file_exist) + if ( file_exist ) then + close(niaercm) + open (unit=niaercm, file=fin, status='OLD') + rewind(niaercm) + else + print *,' Requested luts file ',trim(fin),' not found' + print *,' ** Stopped in rd_gocart_luts ** ' + stop 1222 + endif ! end if_file_exist_block + + ibeg = radius_lower(ib) - kcm1 + iradius = num_radius(ib) + +! read lambda and compute mpwavelength (m) + read(niaercm,'(a40)') dummy + read(niaercm,*) (lambda(i), i=1, kaerbndd) +! read rh, relative humidity (fraction) + read(niaercm,'(a40)') dummy + read(niaercm,*) (rh(i), i=1, krhlev) +! read bext + do k = 1, iradius + read(niaercm,'(a40)') dummy + do j=1, krhlev + read(niaercm,*) (bext(i,j,k), i=1,kaerbndd) + enddo + enddo +! read bsca + do k = 1, iradius + read(niaercm,'(a40)') dummy + do j=1, krhlev + read(niaercm,*) (bsca(i,j,k), i=1, kaerbndd) + enddo + enddo +! read g + do k = 1, iradius + read(niaercm,'(a40)') dummy + do j=1, krhlev + read(niaercm,*) (g(i,j,k), i=1, kaerbndd) + enddo + enddo -! --- read luts - DO k = 1, NW - READ(NIAERCM) wave,(ext0(k,L,j),L=1,n_bin) - READ(NIAERCM) (sca0(k,L,j),L=1,n_bin) - READ(NIAERCM) (asy0(k,L,j),L=1,n_bin) - READ(NIAERCM) (ph0(1:NP2,L,k,j),L=1,n_bin) - END DO - -! --- map luts input to module variables - if (AerosolName(j) == ' Dust ' ) then - if ( KCM1 > 0) then !<-- only if rh independent aerosols are needed - do i = 1, KCM1 - rhidext0_grt(1:KAERBND,i)=ext0(1:KAERBND,indx_dust(i),j) - rhidssa0_grt(1:KAERBND,i)=sca0(1:KAERBND,indx_dust(i),j) - rhidasy0_grt(1:KAERBND,i)=asy0(1:KAERBND,indx_dust(i),j) +! fill rhdpext0 local arrays for non-dust aerosols (flip i-index) + do i = 1, kaerbndd ! convert from m to micron + j = kaerbndd -i + 1 ! flip i-index + wavelength(j) = 1.e6 * lambda(i) + enddo + do k = 1, iradius + ik = ibeg + k - 1 + do i = 1, kaerbndd + ii = kaerbndd -i + 1 + do j = 1, krhlev + rhdpext0_grt(ii,j,ik) = bext(i,j,k) + rhdpsca0_grt(ii,j,ik) = bsca(i,j,k) + if ( bext(i,j,k) /= f_zero) then + rhdpssa0_grt(ii,j,ik) = bsca(i,j,k)/bext(i,j,k) + else + rhdpssa0_grt(ii,j,ik) = f_one + endif + rhdpasy0_grt(ii,j,ik) = g(i,j,k) enddo - endif - else - if ( KCM2 > 0) then !<-- only if rh dependent aerosols are needed - if (AerosolName(j) == ' Soot ') ij = isoot - if (AerosolName(j) == ' SUSO ') ij = isuso - if (AerosolName(j) == ' WASO ') ij = iwaso - if (AerosolName(j) == ' SSAM ') ij = issam - if (AerosolName(j) == ' SSCM ') ij = isscm - if ( ij .ne. -999 ) then - rhdpext0_grt(1:KAERBND,1:KRHLEV,ij) = & - & ext0(1:KAERBND,1:KRHLEV,j) - rhdpssa0_grt(1:KAERBND,1:KRHLEV,ij) = & - & sca0(1:KAERBND,1:KRHLEV,j) - rhdpasy0_grt(1:KAERBND,1:KRHLEV,ij) = & - & asy0(1:KAERBND,1:KRHLEV,j) - endif ! if_ij - endif ! if_KCM2 - endif - END DO + enddo + enddo + + enddo !! ib-loop return !................................... end subroutine rd_gocart_luts !----------------------------------- -! ! -!>\ingroup module_radiation_aerosols -!> This subroutine computes mean aerosols optical properties over each -!! SW/LW radiation spectral band for each of the species components. -!! This program follows GFDL's approach for thick cloud optical property -!! in SW radiation scheme (2000). -!>\section optavg_grt_gen optavg_grt General Algorithm -!! @{ -!----------------------------- - subroutine optavg_grt -!............................. -! --- inputs: (in scope variables) -! --- outputs: (in scope variables) + +!-------------------------------- + subroutine optavg_gocart +!................................ +! --- inputs: (in-scope variables, module variables) +! --- outputs: (module variables) ! ==================================================================== ! ! ! -! subprogram: optavg_grt ! +! subprogram: optavg_gocart ! ! ! -! compute mean aerosols optical properties over each sw/lw radiation ! +! compute mean aerosol optical properties over each sw radiation ! ! spectral band for each of the species components. This program ! -! follows gfdl's approach for thick cloud opertical property in ! -! sw radiation scheme (2000). ! +! follows optavg routine (in turn follows gfdl's approach for thick ! +! cloud opertical property in sw radiation scheme (2000). ! ! ! ! ==================== defination of variables =================== ! ! ! -! input arguments: ! -! nv1,nv2 (NBDSW) - start/end spectral band indices of aerosol data ! +! major input variables: ! +! nv1,nv2 (nswbnd) - start/end spectral band indices of aerosol data ! +! for each sw radiation spectral band ! +! nr1,nr2 (nlwbnd) - start/end spectral band indices of aerosol data ! +! for each ir radiation spectral band ! +! nv1_du,nv2_du(nswbnd) - start/end spectral band indices of aer data! ! for each sw radiation spectral band ! -! nr1,nr2 (NLWBND) - start/end spectral band indices of aerosol data ! +! nr1_du,nr2_du(nlwbnd) - start/end spectral band indices of aer data! ! for each ir radiation spectral band ! -! solwaer (NBDSW,KAERBND) ! +! solwaer (nswbnd,kaerbndd) ! ! - solar flux weight over each sw radiation band ! ! vs each aerosol data spectral band ! -! eirwaer (NLWBND,KAERBND) ! +! eirwaer (nlwbnd,kaerbndd) ! ! - ir flux weight over each lw radiation band ! ! vs each aerosol data spectral band ! -! solbnd (NBDSW) - solar flux weight over each sw radiation band ! -! eirbnd (NLWBND) - ir flux weight over each lw radiation band ! -! NBDSW - total number of sw spectral bands ! -! NLWBND - total number of lw spectral bands ! -! NSWLWBD - total number of sw+lw spectral bands ! +! solwaer_du (nswbnd,kaerbndi) ! +! - solar flux weight over each sw radiation band ! +! vs each aerosol data spectral band ! +! eirwaer_du (nlwbnd,kaerbndi) ! +! - ir flux weight over each lw radiation band ! +! vs each aerosol data spectral band ! +! solbnd (nswbnd) - solar flux weight over each sw radiation band ! +! eirbnd (nlwbnd) - ir flux weight over each lw radiation band ! +! solbnd_du(nswbnd) - solar flux weight over each sw radiation band ! +! eirbnd_du(nlwbnd) - ir flux weight over each lw radiation band ! +! nswbnd - total number of sw spectral bands ! +! nlwbnd - total number of lw spectral bands ! +! ! +! external module variables: (in physparam) ! +! laswflg - control flag for sw spectral region ! +! lalwflg - control flag for lw spectral region ! ! ! -! output arguments: (to module variables) ! +! output variables: (to module variables) ! ! ! ! ================================================================== ! -! - implicit none ! --- inputs: ! --- output: ! --- locals: - real (kind=kind_phys) :: sumk, sumok, sumokg, sumreft, & + real (kind=kind_phys) :: sumk, sums, sumok, sumokg, sumreft, & & sp, refb, reft, rsolbd, rirbd integer :: ib, nb, ni, nh, nc ! !===> ... begin here - -! --- ... allocate aerosol optical data - if (.not. allocated(extrhd_grt) .and. KCM2 > 0 ) then - allocate ( extrhd_grt(KRHLEV,KCM2,NSWLWBD) ) - allocate ( ssarhd_grt(KRHLEV,KCM2,NSWLWBD) ) - allocate ( asyrhd_grt(KRHLEV,KCM2,NSWLWBD) ) - endif - if (.not. allocated(extrhi_grt) .and. KCM1 > 0 ) then - allocate ( extrhi_grt(KCM1,NSWLWBD) ) - allocate ( ssarhi_grt(KCM1,NSWLWBD) ) - allocate ( asyrhi_grt(KCM1,NSWLWBD) ) - endif ! ! --- ... loop for each sw radiation spectral band - do nb = 1, NBDSW - rsolbd = f_one / solbnd(nb) - -! --- for rh independent aerosol species - - lab_rhi: if (KCM1 > 0 ) then - do nc = 1, KCM1 - sumk = f_zero - sumok = f_zero - sumokg = f_zero - sumreft = f_zero - - do ni = nv1(nb), nv2(nb) - sp = sqrt( (f_one - rhidssa0_grt(ni,nc)) & - & / (f_one - rhidssa0_grt(ni,nc)*rhidasy0_grt(ni,nc)) ) - reft = (f_one - sp) / (f_one + sp) - sumreft = sumreft + reft*solwaer(nb,ni) - - sumk = sumk + rhidext0_grt(ni,nc)*solwaer(nb,ni) - sumok = sumok + rhidssa0_grt(ni,nc)*solwaer(nb,ni) & - & * rhidext0_grt(ni,nc) - sumokg = sumokg + rhidssa0_grt(ni,nc)*solwaer(nb,ni) & - & * rhidext0_grt(ni,nc)*rhidasy0_grt(ni,nc) - enddo - - refb = sumreft * rsolbd - - extrhi_grt(nc,nb) = sumk * rsolbd - asyrhi_grt(nc,nb) = sumokg / (sumok + 1.0e-10) - ssarhi_grt(nc,nb) = 4.0*refb & - & / ( (f_one+refb)**2 - asyrhi_grt(nc,nb)*(f_one-refb)**2 ) - - enddo ! end do_nc_block for rh-ind aeros - endif lab_rhi - -! --- for rh dependent aerosols species - - lab_rhd: if (KCM2 > 0 ) then - do nc = 1, KCM2 - do nh = 1, KRHLEV + if ( laswflg ) then + do nb = 1, nswbnd + rsolbd = f_one / solbnd_du(nb) + do nc = 1, kcm1 ! --- for rh independent aerosol species sumk = f_zero + sums = f_zero sumok = f_zero sumokg = f_zero sumreft = f_zero - do ni = nv1(nb), nv2(nb) - sp = sqrt( (f_one - rhdpssa0_grt(ni,nh,nc)) & - & /(f_one-rhdpssa0_grt(ni,nh,nc)*rhdpasy0_grt(ni,nh,nc))) + do ni = nv1_du(nb), nv2_du(nb) + sp = sqrt( (f_one - rhidssa0_grt(ni,nc)) & + & / (f_one - rhidssa0_grt(ni,nc)*rhidasy0_grt(ni,nc)) ) reft = (f_one - sp) / (f_one + sp) - sumreft = sumreft + reft*solwaer(nb,ni) - - sumk = sumk + rhdpext0_grt(ni,nh,nc)*solwaer(nb,ni) - sumok = sumok + rhdpssa0_grt(ni,nh,nc)*solwaer(nb,ni) & - & * rhdpext0_grt(ni,nh,nc) - sumokg = sumokg + rhdpssa0_grt(ni,nh,nc)*solwaer(nb,ni) & - & * rhdpext0_grt(ni,nh,nc)*rhdpasy0_grt(ni,nh,nc) + sumreft = sumreft + reft*solwaer_du(nb,ni) + + sumk = sumk + rhidext0_grt(ni,nc)*solwaer_du(nb,ni) + sums = sums + rhidsca0_grt(ni,nc)*solwaer_du(nb,ni) + sumok = sumok + rhidssa0_grt(ni,nc)*solwaer_du(nb,ni) & + & * rhidext0_grt(ni,nc) + sumokg = sumokg + rhidssa0_grt(ni,nc)*solwaer_du(nb,ni) & + & * rhidext0_grt(ni,nc)*rhidasy0_grt(ni,nc) enddo refb = sumreft * rsolbd - extrhd_grt(nh,nc,nb) = sumk * rsolbd - asyrhd_grt(nh,nc,nb) = sumokg / (sumok + 1.0e-10) - ssarhd_grt(nh,nc,nb) = 4.0*refb & - & /((f_one+refb)**2 - asyrhd_grt(nh,nc,nb)*(f_one-refb)**2) - enddo ! end do_nh_block - enddo ! end do_nc_block for rh-dep aeros - endif lab_rhd + extrhi_grt(nc,nb) = sumk * rsolbd + scarhi_grt(nc,nb) = sums * rsolbd + asyrhi_grt(nc,nb) = sumokg / (sumok + 1.0e-10) + ssarhi_grt(nc,nb) = 4.0*refb & + & / ( (f_one+refb)**2 - asyrhi_grt(nc,nb)*(f_one-refb)**2 ) + enddo ! end do_nc_block for rh-ind aeros - enddo ! end do_nb_block for sw + rsolbd = f_one / solbnd(nb) + do nc = 1, kcm2 ! --- for rh dependent aerosol species + do nh = 1, krhlev + sumk = f_zero + sums = f_zero + sumok = f_zero + sumokg = f_zero + sumreft = f_zero -! --- ... loop for each lw radiation spectral band + do ni = nv1(nb), nv2(nb) + sp = sqrt( (f_one - rhdpssa0_grt(ni,nh,nc)) & + & /(f_one-rhdpssa0_grt(ni,nh,nc)*rhdpasy0_grt(ni,nh,nc))) + reft = (f_one - sp) / (f_one + sp) + sumreft = sumreft + reft*solwaer(nb,ni) - do nb = 1, NLWBND + sumk = sumk + rhdpext0_grt(ni,nh,nc)*solwaer(nb,ni) + sums = sums + rhdpsca0_grt(ni,nh,nc)*solwaer(nb,ni) + sumok = sumok + rhdpssa0_grt(ni,nh,nc)*solwaer(nb,ni) & + & * rhdpext0_grt(ni,nh,nc) + sumokg = sumokg + rhdpssa0_grt(ni,nh,nc)*solwaer(nb,ni)& + & * rhdpext0_grt(ni,nh,nc)*rhdpasy0_grt(ni,nh,nc) + enddo - ib = NBDSW + nb - rirbd = f_one / eirbnd(nb) + refb = sumreft * rsolbd -! --- for rh independent aerosol species + extrhd_grt(nh,nc,nb) = sumk * rsolbd + scarhd_grt(nh,nc,nb) = sums * rsolbd + asyrhd_grt(nh,nc,nb) = sumokg / (sumok + 1.0e-10) + ssarhd_grt(nh,nc,nb) = 4.0*refb & + & /((f_one+refb)**2 - asyrhd_grt(nh,nc,nb)*(f_one-refb)**2) - lab_rhi_lw: if (KCM1 > 0 ) then - do nc = 1, KCM1 - sumk = f_zero - sumok = f_zero - sumokg = f_zero - sumreft = f_zero + enddo ! end do_nh_block + enddo ! end do_nc_block for rh-dep aeros - do ni = nr1(nb), nr2(nb) - sp = sqrt( (f_one - rhidssa0_grt(ni,nc)) & - & / (f_one - rhidssa0_grt(ni,nc)*rhidasy0_grt(ni,nc)) ) - reft = (f_one - sp) / (f_one + sp) - sumreft = sumreft + reft*eirwaer(nb,ni) - - sumk = sumk + rhidext0_grt(ni,nc)*eirwaer(nb,ni) - sumok = sumok + rhidssa0_grt(ni,nc)*eirwaer(nb,ni) & - & * rhidext0_grt(ni,nc) - sumokg = sumokg + rhidssa0_grt(ni,nc)*eirwaer(nb,ni) & - & * rhidext0_grt(ni,nc)*rhidasy0_grt(ni,nc) - enddo + enddo ! end do_nb_block for sw + endif ! end if_laswflg_block - refb = sumreft * rirbd +! --- ... loop for each lw radiation spectral band + + if ( lalwflg ) then - extrhi_grt(nc,ib) = sumk * rirbd - asyrhi_grt(nc,ib) = sumokg / (sumok + 1.0e-10) - ssarhi_grt(nc,ib) = 4.0*refb & - & / ( (f_one+refb)**2 - asyrhi_grt(nc,ib)*(f_one-refb)**2 ) - enddo ! end do_nc_block for rh-ind aeros - endif lab_rhi_lw + do nb = 1, nlwbnd -! --- for rh dependent aerosols species + ib = nswbnd + nb - lab_rhd_lw: if (KCM2 > 0 ) then - do nc = 1, KCM2 - do nh = 1, KRHLEV + rirbd = f_one / eirbnd_du(nb) + do nc = 1, kcm1 ! --- for rh independent aerosol species sumk = f_zero + sums = f_zero sumok = f_zero sumokg = f_zero sumreft = f_zero - do ni = nr1(nb), nr2(nb) - sp = sqrt( (f_one - rhdpssa0_grt(ni,nh,nc)) & - & /(f_one - rhdpssa0_grt(ni,nh,nc)*rhdpasy0_grt(ni,nh,nc)) ) + do ni = nr1_du(nb), nr2_du(nb) + sp = sqrt( (f_one - rhidssa0_grt(ni,nc)) & + & / (f_one - rhidssa0_grt(ni,nc)*rhidasy0_grt(ni,nc)) ) reft = (f_one - sp) / (f_one + sp) - sumreft = sumreft + reft*eirwaer(nb,ni) - - sumk = sumk + rhdpext0_grt(ni,nh,nc)*eirwaer(nb,ni) - sumok = sumok + rhdpssa0_grt(ni,nh,nc)*eirwaer(nb,ni) & - & * rhdpext0_grt(ni,nh,nc) - sumokg = sumokg+ rhdpssa0_grt(ni,nh,nc)*eirwaer(nb,ni) & - & * rhdpext0_grt(ni,nh,nc)*rhdpasy0_grt(ni,nh,nc) + sumreft = sumreft + reft*eirwaer_du(nb,ni) + + sumk = sumk + rhidext0_grt(ni,nc)*eirwaer_du(nb,ni) + sums = sums + rhidsca0_grt(ni,nc)*eirwaer_du(nb,ni) + sumok = sumok + rhidssa0_grt(ni,nc)*eirwaer_du(nb,ni) & + & * rhidext0_grt(ni,nc) + sumokg = sumokg + rhidssa0_grt(ni,nc)*eirwaer_du(nb,ni) & + & * rhidext0_grt(ni,nc)*rhidasy0_grt(ni,nc) enddo refb = sumreft * rirbd - extrhd_grt(nh,nc,ib) = sumk * rirbd - asyrhd_grt(nh,nc,ib) = sumokg / (sumok + 1.0e-10) - ssarhd_grt(nh,nc,ib) = 4.0*refb & - & /((f_one+refb)**2 - asyrhd_grt(nh,nc,ib)*(f_one-refb)**2 ) - enddo ! end do_nh_block - enddo ! end do_nc_block for rh-dep aeros - endif lab_rhd_lw - - enddo ! end do_nb_block for lw - -! - return -!................................ - end subroutine optavg_grt -!! @} -!-------------------------------- -! -!>\ingroup module_radiation_aerosols -!! -!! This subroutine: -!! - Read in aerosol dry mass and surface pressure from GEOS3-GOCART -!! C3.1 2000 monthly dataset or aerosol mixing ratio and surface -!! pressure from GEOS4-GOCART 2000-2007 averaged monthly data set. -!! - Compute goes lat/lon array (for horizontal mapping) -!\section rd_gocart_clim_gen rd_gocart_clim General Algorithm -! @{ -!----------------------------------- - subroutine rd_gocart_clim -!................................... -! --- inputs: (in scope variables) -! --- outputs: (in scope variables) - -! ================================================================== ! -! ! -! subprogram: rd_gocart_clim ! -! ! -! 1. read in aerosol dry mass and surface pressure from GEOS3-GOCART ! -! C3.1 2000 monthly data set ! -! or aerosol mixing ratio and surface pressure from GEOS4-GOCART ! -! 2000-2007 averaged monthly data set ! -! 2. compute goes lat/lon array (for horizontal mapping) ! -! ! -! ==================== defination of variables =================== ! -! ! -! inputs arguments: ! -! imon - month of the year ! -! me - print message control flag ! -! ! -! outputs arguments: (to the module variables) ! -! psclmg - pressure (sfc to toa) cb IMXG*JMXG*KMXG ! -! dmclmg - aerosol dry mass/mixing ratio IMXG*JMXG*KMXG*NMXG ! -! geos_rlon - goes longitude deg IMXG ! -! geos_rlat - goes latitude deg JMXG ! -! ! -! usage: call rd_gocart_clim ! -! ! -! program history: ! -! 05/18/2010 --- Lu Add the option to read GEOS4-GOCART climo ! -! ================================================================== ! -! - implicit none - -! --- inputs: -! --- output: - -! --- locals: - integer, parameter :: MAXSPC = 5 - real (kind=kind_io4), parameter :: PINT = 0.01 - real (kind=kind_io4), parameter :: EPSQ = 0.0 - - integer :: i, j, k, numspci, ii - integer :: icmp, nrecl, nt1, nt2, nn(MAXSPC) - character :: ymd*6, yr*4, mn*2, tp*2, & - & fname*30, fin*30, aerosol_file*40 - logical :: file_exist - - real (kind=kind_io4), dimension(KMXG) :: sig - real (kind=kind_io4), dimension(IMXG,JMXG) :: ps - real (kind=kind_io4), dimension(IMXG,JMXG,KMXG) :: temp - real (kind=kind_io4), dimension(IMXG,JMXG,KMXG,MAXSPC):: buff - real (kind=kind_phys) :: pstmp - -! Add the following variables for GEOS4-GOCART - real (kind=kind_io4), dimension(KMXG):: hyam, hybm - real (kind=kind_io4) :: p0 - - data yr /'2000'/ !!<=== use 2000 as the climo proxy - -!* sigma_coordinate for GEOS3-GOCART -!* P(i,j,k) = PINT + SIG(k) * (PS(i,j) - PINT) - data SIG / & - & 9.98547E-01,9.94147E-01,9.86350E-01,9.74300E-01,9.56950E-01, & - & 9.33150E-01,9.01750E-01,8.61500E-01,8.11000E-01,7.50600E-01, & - & 6.82900E-01,6.10850E-01,5.37050E-01,4.63900E-01,3.93650E-01, & - & 3.28275E-01,2.69500E-01,2.18295E-01,1.74820E-01,1.38840E-01, & - & 1.09790E-01,8.66900E-02,6.84150E-02,5.39800E-02,4.25750E-02, & - & 3.35700E-02,2.39900E-02,1.36775E-02,5.01750E-03,5.30000E-04 / - -!* hybrid_sigma_pressure_coordinate for GEOS4-GOCART -!* p(i,j,k) = a(k)*p0 + b(k)*ps(i,j) - data hyam/ & - & 0, 0.0062694, 0.02377049, 0.05011813, 0.08278809, 0.1186361, & - & 0.1540329, 0.1836373, 0.2043698, 0.2167788, 0.221193, & - & 0.217729, 0.2062951, 0.1865887, 0.1615213, 0.1372958, & - & 0.1167039, 0.09920014, 0.08432171, 0.06656809, 0.04765031, & - & 0.03382346, 0.0237648, 0.01435208, 0.00659734, 0.002826232, & - & 0.001118959, 0.0004086494, 0.0001368611, 3.750308e-05/ - - data hybm / & - & 0.992555, 0.9642, 0.90556, 0.816375, 0.703815, 0.576585, & - & 0.44445, 0.324385, 0.226815, 0.149165, 0.089375, & - & 0.045865, 0.017485, 0.00348, 0, 0, 0, 0, 0, & - & 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 / - - data p0 /1013.25 / - -!===> ... begin here - -! --- allocate and initialize gocart climatological data - if ( .not. allocated (dmclmg) ) then - allocate ( dmclmg(IMXG,JMXG,KMXG,NMXG) ) - allocate ( psclmg(IMXG,JMXG,KMXG) ) - allocate ( molwgt(NMXG) ) - endif + extrhi_grt(nc,ib) = sumk * rirbd + scarhi_grt(nc,ib) = sums * rirbd + asyrhi_grt(nc,ib) = sumokg / (sumok + 1.0e-10) + ssarhi_grt(nc,ib) = 4.0*refb & + & / ( (f_one+refb)**2 - asyrhi_grt(nc,ib)*(f_one-refb)**2 ) - dmclmg(:,:,:,:) = f_zero - psclmg(:,:,:) = f_zero - molwgt(:) = f_zero + enddo ! end do_nc_block for rh-ind aeros -! --- allocate and initialize geos lat and lon arrays - if ( .not. allocated ( geos_rlon )) then - allocate (geos_rlon(IMXG)) - allocate (geos_rlat(JMXG)) - endif + rirbd = f_one / eirbnd(nb) + do nc = 1, kcm2 ! --- for rh dependent aerosol species + do nh = 1, krhlev + sumk = f_zero + sums = f_zero + sumok = f_zero + sumokg = f_zero + sumreft = f_zero - geos_rlon(:) = f_zero - geos_rlat(:) = f_zero - -! --- compute geos lat and lon arrays - do i = 1, IMXG - geos_rlon(i) = -180. + (i-1)* dltx - end do - do j = 2, JMXG-1 - geos_rlat(j) = -90. + (j-1)* dlty - end do - geos_rlat(1) = -89.5 - geos_rlat(JMXG) = 89.5 - -! --- determine whether GEOS3 or GEOS4 data set is provided - if ( gocart_climo == 'xxxx' ) then - gocart_climo='0000' -! check geos3-gocart climo - aerosol_file = '200001.PS.avg' - inquire (file = aerosol_file, exist = file_exist) - if ( file_exist ) gocart_climo='ver3' -! check geos4-gocart climo - aerosol_file = 'gocart_climo_2000x2007_ps_01.bin' - inquire (file = aerosol_file, exist = file_exist) - if ( file_exist ) gocart_climo='ver4' - endif -! -! -! --- read ps (sfc pressure) and compute 3d pressure field (psclmg) -! - write(mn,'(i2.2)') imon - ymd = yr//mn - aerosol_file = 'null' - if ( gocart_climo == 'ver3' ) then - aerosol_file = ymd//'.PS.avg' - elseif ( gocart_climo == 'ver4' ) then - aerosol_file = 'gocart_climo_2000x2007_ps_'//mn//'.bin' - endif -! - inquire (file = aerosol_file, exist = file_exist) - lab_if_ps : if ( file_exist ) then - - close(NIAERCM) - if ( gocart_climo == 'ver3' ) then - nrecl = 4 * (IMXG * JMXG) - open(NIAERCM, file=trim(aerosol_file), & - & action='read',access='direct',recl=nrecl) - read(NIAERCM, rec=1) ps - do j = 1, JMXG - do i = 1, IMXG - do k = 1, KMXG - pstmp = pint + sig(k) * (ps(i,j) - pint) - psclmg(i,j,k) = 0.1 * pstmp ! convert mb to cb - enddo - enddo - enddo + do ni = nr1(nb), nr2(nb) + sp = sqrt( (f_one - rhdpssa0_grt(ni,nh,nc)) & + & /(f_one-rhdpssa0_grt(ni,nh,nc)*rhdpasy0_grt(ni,nh,nc))) + reft = (f_one - sp) / (f_one + sp) + sumreft = sumreft + reft*eirwaer(nb,ni) - elseif ( gocart_climo == 'ver4' ) then - open(NIAERCM, file=trim(aerosol_file), & - & action='read',status='old', form='unformatted') - read(NIAERCM) ps(:,:) - do j = 1, JMXG - do i = 1, IMXG - do k = 1, KMXG - pstmp = hyam(k)*p0 + hybm(k)*ps(i,j) - psclmg(i,j,k) = 0.1 * pstmp ! convert mb to cb - enddo - enddo - enddo + sumk = sumk + rhdpext0_grt(ni,nh,nc)*eirwaer(nb,ni) + sums = sums + rhdpsca0_grt(ni,nh,nc)*eirwaer(nb,ni) + sumok = sumok + rhdpssa0_grt(ni,nh,nc)*eirwaer(nb,ni) & + & * rhdpext0_grt(ni,nh,nc) + sumokg = sumokg+ rhdpssa0_grt(ni,nh,nc)*eirwaer(nb,ni) & + & * rhdpext0_grt(ni,nh,nc)*rhdpasy0_grt(ni,nh,nc) + enddo - endif ! ---- end if_gocart_climo + refb = sumreft * rirbd - else lab_if_ps + extrhd_grt(nh,nc,ib) = sumk * rirbd + scarhd_grt(nh,nc,ib) = sums * rirbd + asyrhd_grt(nh,nc,ib) = sumokg / (sumok + 1.0e-10) + ssarhd_grt(nh,nc,ib) = 4.0*refb & + & /((f_one+refb)**2 - asyrhd_grt(nh,nc,ib)*(f_one-refb)**2) + enddo ! end do_nh_block + enddo ! end do_nc_block for rh-dep aeros - print *,' *** Requested aerosol data file "', & - & trim(aerosol_file), '" not found!' - print *,' *** Stopped in RD_GOCART_CLIM ! ', me - stop 1006 - endif lab_if_ps -! -! --- read aerosol dry mass (g/m3) or mixing ratios (mol/mol,kg/kg) -! - lab_do_icmp : do icmp = 1, num_gridcomp - - tp = gridcomp(icmp) - -! determine aerosol_file - aerosol_file = 'null' - if ( gocart_climo == 'ver3' ) then - if(tp == 'DU') fname='.DU.STD.tv20.g.avg' - if(tp == 'SS') fname='.SS.STD.tv17.g.avg' - if(tp == 'SU') fname='.SU.STD.tv15.g.avg' - if(tp == 'OC') fname='.CC.STD.tv15.g.avg' - if(tp == 'BC') fname='.CC.STD.tv15.g.avg' - aerosol_file=ymd//trim(fname) - elseif ( gocart_climo == 'ver4' ) then - fin = 'gocart_climo_2000x2007_' - if(tp == 'DU') fname=trim(fin)//'du_' - if(tp == 'SS') fname=trim(fin)//'ss_' - if(tp == 'SU') fname=trim(fin)//'su_' - if(tp == 'OC') fname=trim(fin)//'cc_' - if(tp == 'BC') fname=trim(fin)//'cc_' - aerosol_file=trim(fname)//mn//'.bin' - endif - - numspci = 4 - if(tp == 'DU') numspci = 5 - inquire (file=trim(aerosol_file), exist = file_exist) - lab_if_aer: if ( file_exist ) then + enddo ! end do_nb_block for lw + endif ! end if_lalwflg_block ! - close(NIAERCM) - if ( gocart_climo == 'ver3' ) then - nrecl = 4 * numspci * (IMXG * JMXG * KMXG + 3) - open (NIAERCM, file=trim(aerosol_file), & - & action='read',access='direct', recl=nrecl) - read(NIAERCM,rec=1)(nt1,nt2,nn(i),buff(:,:,:,i),i=1,numspci) - - elseif ( gocart_climo == 'ver4' ) then - open (NIAERCM, file=trim(aerosol_file), & - & action='read',status='old', form='unformatted') - do i = 1, numspci - do k = 1, KMXG - read(NIAERCM) temp(:,:,k) - buff(:,:,k,i) = temp(:,:,k) - enddo - enddo - endif - -!!===> fill dmclmg with working array buff - select case ( tp ) - -! fill in DU from DU: du1, du2, du3, du4, du5 - case ('DU' ) - if ( dm_indx%dust1 /= -999) then - do ii = 1, 5 - dmclmg(:,:,:,dm_indx%dust1+ii-1) = buff(:,:,:,ii) - enddo - else - print *, 'ERROR: invalid DU index, abort! ',me - stop 1007 - endif - -! fill in BC from CC: bc_phobic, oc_phobic, bc_philic, oc_philic - case ('BC' ) - if ( dm_indx%soot_phobic /= -999) then - dmclmg(:,:,:,dm_indx%soot_phobic)=buff(:,:,:,1) - dmclmg(:,:,:,dm_indx%soot_philic)=buff(:,:,:,3) - molwgt(dm_indx%soot_phobic) = 12. - molwgt(dm_indx%soot_philic) = 12. - else - print *, 'ERROR: invalid BC index, abort! ',me - stop 1008 - endif - -! fill in SU from SU: dms, so2, so4, msa - case ('SU' ) - if ( dm_indx%suso /= -999) then - dmclmg(:,:,:,dm_indx%suso) = buff(:,:,:,3) - molwgt(dm_indx%suso) = 96. - else - print *, 'ERROR: invalid SU index, abort! ',me - stop 1009 - endif - -! fill in OC from CC: bc_phobic, oc_phobic, bc_philic, oc_philic - case ('OC' ) - if ( dm_indx%waso_phobic /= -999) then - dmclmg(:,:,:,dm_indx%waso_phobic) = 1.4*buff(:,:,:,2) - dmclmg(:,:,:,dm_indx%waso_philic) = 1.4*buff(:,:,:,4) - molwgt(dm_indx%waso_phobic) = 12. - molwgt(dm_indx%waso_philic) = 12. - else - print *, 'ERROR: invalid OC index, abort! ',me - stop 1010 - endif - -! fill in SS from SS: ss1, ss2, ss3, ss4 - case ('SS' ) - if ( dm_indx%ssam /= -999) then - dmclmg(:,:,:,dm_indx%ssam) = buff(:,:,:,1) - dmclmg(:,:,:,dm_indx%sscm) = buff(:,:,:,2) + & - & buff(:,:,:,3)+buff(:,:,:,4) - else - print *, 'ERROR: invalid SS index, abort! ',me - stop 1011 - endif - - case default - - print *, 'ERROR: invalid aerosol species, abort ',tp - stop 1012 - - end select - - else lab_if_aer - print *,' *** Requested aerosol data file "',aerosol_file, & - & '" not found!' - print *,' *** Stopped in RD_GOCART_CLIM ! ', me - stop 1013 - endif lab_if_aer - - enddo lab_do_icmp - + return return !................................... - end subroutine rd_gocart_clim -! @} + end subroutine optavg_gocart !----------------------------------- -! + !................................... - end subroutine gocart_init + end subroutine gocart_aerinit !----------------------------------- !! @} -!>\ingroup module_radiation_aerosols -!> This subroutine computes SW + LW aerosol optical properties for -!! gocart aerosol species (merged from fcst and clim fields). -!! -!>\param alon IMAX, longitude of given points in degree -!!\param alat IMAX, latitude of given points in degree -!!\param prslk (IMAX,NLAY), pressure in cb -!!\param rhlay (IMAX,NLAY), layer mean relative humidity -!!\param dz (IMAX,NLAY), layer thickness in m -!!\param hz (IMAX,NLP1), level high in m -!!\param NSWLWBD total number of sw+ir bands for aeros opt prop -!!\param prsl (IMAX,NLAY), layer mean pressure in mb -!!\param tvly (IMAX,NLAY), layer mean virtual temperature in K -!!\param trcly (IMAX,NLAY,NTRAC), layer mean specific tracer in g/g -!!\param IMAX horizontal dimension of arrays -!!\param NLAY,NLP1 vertical dimensions of arrays -!!\param ivflip control flag for direction of vertical index -!!\n =0: index from toa to surface -!!\n =1: index from surface to toa -!!\param lsswr,lslwr logical flag for sw/lw radiation calls -!!\param aerosw (IMAX,NLAY,NBDSW,NF_AESW), aeros opt properties for SW -!!\n (:,:,:,1): optical depth -!!\n (:,:,:,2): single scattering albedo -!!\n (:,:,:,3): asymmetry parameter -!!\param aerolw (IMAX,NLAY,NBDLW,NF_AELW), aeros opt properties for LW -!!\n (:,:,:,1): optical depth -!!\n (:,:,:,2): single scattering albedo -!!\n (:,:,:,3): asymmetry parameter -!>\section gen_setgo setgocartaer General Algorithm -!!@{ +!> This subroutine compute aerosol optical properties for SW +!! and LW radiations. +!!\param prsi (IMAX,NLP1), pressure at interface in mb +!!\param prsl (IMAX,NLAY), layer mean pressure(not used) +!!\param prslk (IMAX,NLAY), exner function=\f$(p/p0)^{rocp}\f$ (not used) +!!\param tvly (IMAX,NLAY), layer virtual temperature (not used) +!!\param rhlay (IMAX,NLAY), layer mean relative humidity +!!\param dz (IMAX,NLAY), layer thickness in m +!!\param hz (IMAX,NLP1), level high in m +!!\param tracer (IMAX,NLAY,NTRAC), aer tracer concentrations +!!\param aerfld (IMAX,NLAY,NTRCAER), aer tracer concentrations +!!\param alon, alat (IMAX), longitude and latitude of given points in degree +!!\param slmsk (IMAX), sea/land mask (sea:0,land:1,sea-ice:2) +!!\param laersw,laerlw logical flag for sw/lw aerosol calculations +!!\param IMAX horizontal dimension of arrays +!!\param NLAY,NLP1 vertical dimensions of arrays +!!\param NSPC num of species for optional aod output fields +!!\param aerosw (IMAX,NLAY,NBDSW,NF_AESW), aeros opt properties for sw +!!\n (:,:,:,1): optical depth +!!\n (:,:,:,2): single scattering albedo +!!\n (:,:,:,3): asymmetry parameter +!!\param aerolw (IMAX,NLAY,NBDLW,NF_AELW), aeros opt properties for lw +!!\n (:,:,:,1): optical depth +!!\n (:,:,:,2): single scattering albedo +!!\n (:,:,:,3): asymmetry parameter +!!\param aerodp (IMAX,NSPC+1), vertically integrated aer-opt-depth +!!\section gel_go_aer_pro General Algorithm +!! @{ !----------------------------------- - subroutine setgocartaer & - & ( alon,alat,prslk,rhlay,dz,hz,NSWLWBD, & ! --- inputs: - & prsl,tvly,trcly, & - & IMAX,NLAY,NLP1, ivflip, lsswr,lslwr, & - & aerosw,aerolw & ! --- outputs: - & ) + subroutine aer_property_gocart & +!................................... +! --- inputs: + & ( prsi,prsl,prslk,tvly,rhlay,dz,hz,tracer,aerfld, & + & alon,alat,slmsk, laersw,laerlw, & + & imax,nlay,nlp1, & +! --- outputs: + & aerosw,aerolw,aerodp & + & ) ! ================================================================== ! ! ! -! setgocartaer computes sw + lw aerosol optical properties for gocart ! -! aerosol species (merged from fcst and clim fields) ! +! aer_property_gocart maps prescribed gocart aerosol data set onto ! +! model grids, and compute aerosol optical properties for sw and ! +! lw radiations. ! ! ! ! inputs: ! +! prsi - pressure at interface mb IMAX*NLP1 ! +! prsl - layer mean pressure (not used) IMAX*NLAY ! +! prslk - exner function=(p/p0)**rocp (not used) IMAX*NLAY ! +! tvly - layer virtual temperature (not used) IMAX*NLAY ! +! rhlay - layer mean relative humidity IMAX*NLAY ! +! dz - layer thickness m IMAX*NLAY ! +! hz - level high m IMAX*NLP1 ! +! tracer - aer tracer concentrations (not used) IMAX*NLAY*NTRAC! +! aerfld - prescribed aer tracer mixing ratios IMAX*NLAY*NTRCAER! ! alon, alat IMAX ! ! - longitude and latitude of given points in degree ! -! prslk - pressure cb IMAX*NLAY ! -! rhlay - layer mean relative humidity IMAX*NLAY ! -! dz - layer thickness m IMAX*NLAY ! -! hz - level high m IMAX*NLP1 ! -! NSWLWBD - total number of sw+ir bands for aeros opt prop 1 ! -! prsl - layer mean pressure mb IMAX*NLAY ! -! tvly - layer mean virtual temperature k IMAX*NLAY ! -! trcly - layer mean specific tracer g/g IMAX*NLAY*NTRAC! +! slmsk - sea/land mask (sea:0,land:1,sea-ice:2) IMAX ! +! laersw,laerlw 1 ! +! - logical flag for sw/lw aerosol calculations ! ! IMAX - horizontal dimension of arrays 1 ! ! NLAY,NLP1-vertical dimensions of arrays 1 ! -! ivflip - control flag for direction of vertical index 1 ! -! =0: index from toa to surface ! -! =1: index from surface to toa ! -! lsswr,lslwr ! -! - logical flag for sw/lw radiation calls 1 ! ! ! ! outputs: ! ! aerosw - aeros opt properties for sw IMAX*NLAY*NBDSW*NF_AESW! @@ -5138,577 +4239,290 @@ subroutine setgocartaer & ! (:,:,:,1): optical depth ! ! (:,:,:,2): single scattering albedo ! ! (:,:,:,3): asymmetry parameter ! -! tau_gocart - 550nm aeros opt depth IMAX*NLAY*MAX_NUM_GRIDCOMP! +! aerodp - vertically integrated aer-opt-depth IMAX*NSPC+1 ! ! ! ! module parameters and constants: ! -! NBDSW - total number of sw bands for aeros opt prop 1 ! -! NLWBND - total number of ir bands for aeros opt prop 1 ! +! NSWBND - total number of actual sw spectral bands computed ! +! NLWBND - total number of actual lw spectral bands computed ! +! NSWLWBD - total number of sw+lw bands computed ! ! ! -! module variable: (set by subroutine gocart_init) ! -! dmclmg - aerosols dry mass/mixing ratios IMXG*JMXG*KMXG*NMXG ! -! psclmg - pressure cb IMXG*JMXG*KMXG ! +! external module variables: (in physparam) ! +! ivflip - control flag for direction of vertical index ! +! =0: index from toa to surface ! +! =1: index from surface to toa ! ! ! -! usage: call setgocartaer ! +! module variable: (set by subroutine aer_init) ! ! ! -! subprograms called: map_aermr, aeropt_grt ! +! usage: call aer_property_gocart ! ! ! ! ================================================================== ! -! - implicit none ! --- inputs: - integer, intent(in) :: IMAX,NLAY,NLP1,ivflip,NSWLWBD - logical, intent(in) :: lsswr, lslwr + integer, intent(in) :: IMAX, NLAY, NLP1 + logical, intent(in) :: laersw, laerlw - real (kind=kind_phys), dimension(:,:), intent(in) :: prslk, & - & prsl, rhlay, tvly, dz, hz - real (kind=kind_phys), dimension(:), intent(in) :: alon, alat - real (kind=kind_phys), dimension(:,:,:), intent(in) :: trcly + real (kind=kind_phys), dimension(:,:), intent(in) :: prsi, prsl, & + & prslk, tvly, rhlay, dz, hz + real (kind=kind_phys), dimension(:), intent(in) :: alon, alat, & + & slmsk + real (kind=kind_phys), dimension(:,:,:),intent(in):: tracer + real (kind=kind_phys), dimension(:,:,:),intent(in):: aerfld ! --- outputs: real (kind=kind_phys), dimension(:,:,:,:), intent(out) :: & & aerosw, aerolw + real (kind=kind_phys), dimension(:,:) , intent(out) :: aerodp ! --- locals: - real (kind=kind_phys), dimension(NLAY) :: rh1, dz1 - real (kind=kind_phys), dimension(NLAY,NSWLWBD)::tauae,ssaae,asyae - real (kind=kind_phys), dimension(NLAY,max_num_gridcomp) :: & - & tauae_gocart - - real (kind=kind_phys) :: tmp1, tmp2 - - integer :: i, i1, i2, j1, j2, k, m, m1, kp + real (kind=kind_phys), dimension(nlay,nswlwbd):: tauae,ssaae,asyae + real (kind=kind_phys), dimension(nspc) :: spcodp -! prognostic aerosols on gfs grids - real (kind=kind_phys), dimension(:,:,:),allocatable:: aermr,dmfcs + real (kind=kind_phys),dimension(nlay,kcm) :: aerms + real (kind=kind_phys),dimension(nlay) :: dz1, rh1 + real (kind=kind_phys) :: plv, tv, rho + integer :: i, m, m1, k -! aerosol (dry mass) on gfs grids/levels - real (kind=kind_phys), dimension(:,:), allocatable :: & - & dmanl,dmclm, dmclmx - real (kind=kind_phys), dimension(KMXG) :: pstmp, pkstr - real (kind=kind_phys) :: ptop, psfc, tem, plv, tv, rho - -! --- conversion constants - real (kind=kind_phys), parameter :: hdltx = 0.5 * dltx - real (kind=kind_phys), parameter :: hdlty = 0.5 * dlty - -!===> ... begin here ! - if ( .not. allocated(dmanl) ) then - allocate ( dmclmx(KMXG,NMXG) ) - allocate ( dmanl(NLAY,NMXG) ) - allocate ( dmclm(NLAY,NMXG) ) - - allocate ( aermr(IMAX,NLAY,NMXG) ) - allocate ( dmfcs(IMAX,NLAY,NMXG) ) - endif -! -!> -# Call map_aermr() to map input tracer array (trcly) to local -!! tracer array (aermr). - dmfcs(:,:,:) = f_zero - lab_if_fcst : if ( get_fcst ) then - - call map_aermr -! --- inputs: (in scope variables) -! --- outputs: (in scope variables) - - endif lab_if_fcst +!===> ... begin here ! -!> -# Map geos-gocart climo (dmclmg) to gfs grids (dmclm). - lab_do_IMAX : do i = 1, IMAX - - dmclm(:,:) = f_zero - - lab_if_clim : if ( get_clim ) then -! --- map grid in longitude direction - i2 = 1 - j2 = 1 - tmp1 = alon(i) - if (tmp1 > 180.) tmp1 = tmp1 - 360.0 - lab_do_IMXG : do i1 = 1, IMXG - tmp2 = geos_rlon(i1) - if (tmp2 > 180.) tmp2 = tmp2 - 360.0 - if (abs(tmp1-tmp2) <= hdltx) then - i2 = i1 - exit lab_do_IMXG - endif - enddo lab_do_IMXG - -! --- map grid in latitude direction - lab_do_JMXG : do j1 = 1, JMXG - if (abs(alat(i)-geos_rlat(j1)) <= hdlty) then - j2 = j1 - exit lab_do_JMXG - endif - enddo lab_do_JMXG + lab_do_IMAXg : do i = 1, IMAX -! --- update local arrays pstmp and dmclmx - pstmp(:)= psclmg(i2,j2,:)*1000.0 ! cb to Pa - dmclmx(:,:) = dmclmg(i2,j2,:,:) +! --- initialize tauae, ssaae, asyae + do m = 1, NSWLWBD + do k = 1, NLAY + tauae(k,m) = f_zero + ssaae(k,m) = f_one + asyae(k,m) = f_zero + enddo + enddo -! --- map geos-gocart climo (dmclmx) to gfs level (dmclm) - pkstr(:)=fpkap(pstmp(:)) - psfc = pkstr(1) ! pressure at sfc - ptop = pkstr(KMXG) ! pressure at toa +! --- set floor value for aerms (kg/m3) + do k = 1, NLAY + do m = 1, kcm + aerms(k,m) = 1.e-15 + enddo + enddo -! --- map grid in verical direction (follow how ozone is mapped -! in radiation_gases routine) - do k = 1, NLAY - kp = k ! from sfc to toa - if(ivflip==0) kp = NLAY - k + 1 ! from toa to sfc - tmp1 = prslk(i,kp) - - do m1 = 1, KMXG - 1 ! from sfc to toa - if(tmp1 > pkstr(m1+1) .and. tmp1 <= pkstr(m1)) then - tmp2 = f_one / (pkstr(m1)-pkstr(m1+1)) - tem = (pkstr(m1) - tmp1) * tmp2 - dmclm(kp,:) = tem * dmclmx(m1+1,:)+ & - & (f_one-tem) * dmclmx(m1,:) - endif - enddo - -!* if(tmp1 > psfc) dmclm(kp,:) = dmclmx(1,:) -!* if(tmp1 < ptop) dmclm(kp,:) = dmclmx(KMXG,:) + do m = 1, nspc + spcodp(m) = f_zero + enddo + do k = 1, NLAY + rh1(k) = rhlay(i,k) ! + dz1(k) = 1000.*dz (i,k) ! thickness converted from km to m + plv = 100.*prsl(i,k) ! convert pressure from mb to Pa + tv = tvly(i,k) ! virtual temp in K + rho = plv / ( con_rd * tv) ! air density in kg/m3 + + do m = 1, KCM + aerms(k,m) = aerfld(i,k,m)*rho ! dry mass (kg/m3) enddo - endif lab_if_clim ! -! --- compute fcst/clim merged aerosol loading (dmanl) and the -! radiation optical properties (aerosw, aerolw) -! - do k = 1, NLAY +! --- calculate sw/lw aerosol optical properties for the +! corresponding frequency bands -! --- map global to local arrays (rh1 and dz1) - rh1(k) = rhlay(i,k) - dz1(k) = dz (i,k) + call aeropt +! --- inputs: (in-scope variables) +! --- outputs: (in-scope variables) -! --- convert from mixing ratio to dry mass (g/m3) - plv = 100. * prsl(i,k) ! convert pressure from mb to Pa - tv = tvly(i,k) ! virtual temp in K - rho = plv / (con_rd * tv) ! air density in kg/m3 - if ( get_fcst ) then - do m = 1, NMXG ! mixing ratio (g/g) - dmfcs(i,k,m) = max(1000.*(rho*aermr(i,k,m)),f_zero) - enddo ! m_do_loop - endif - if ( get_clim .and. (gocart_climo == 'ver4') ) then - do m = 1, NMXG - dmclm(k,m)=1000.*dmclm(k,m)*rho !mixing ratio (g/g) - if ( molwgt(m) /= 0. ) then !mixing ratio (mol/mol) - dmclm(k,m)=dmclm(k,m) * (molwgt(m)/con_amd) - endif - enddo ! m_do_loop - endif + enddo ! end_do_k_loop +! ---------------------------------------------------------------------- -! --- determine dmanl from dmclm and dmfcs - do m = 1, NMXG - dmanl(k,m)= ctaer*dmfcs(i,k,m) + & - & ( f_one-ctaer)*dmclm(k,m) +! --- update aerosw and aerolw arrays + if ( laersw ) then + + do m = 1, NBDSW + do k = 1, NLAY + aerosw(i,k,m,1) = tauae(k,m) + aerosw(i,k,m,2) = ssaae(k,m) + aerosw(i,k,m,3) = asyae(k,m) + enddo enddo - enddo -!> -# Call aeropt_grt() to alculate sw/lw aerosol optical properties -!! for the corresponding frequency bands. +! --- update diagnostic aod arrays + do k = 1, NLAY + aerodp(i,1) = aerodp(i,1) + tauae(k,nv_aod) + enddo - call aeropt_grt -! --- inputs: (in scope variables) -! --- outputs: (in scope variables) + do m = 1, NSPC + aerodp(i,m+1) = spcodp(m) + enddo - if ( lsswr ) then + endif ! end if_larsw_block - if ( laswflg ) then + if ( laerlw ) then - do m = 1, NBDSW + if ( NLWBND == 1 ) then + m1 = NSWBND + 1 + do m = 1, NBDLW do k = 1, NLAY - aerosw(i,k,m,1) = tauae(k,m) - aerosw(i,k,m,2) = ssaae(k,m) - aerosw(i,k,m,3) = asyae(k,m) + aerolw(i,k,m,1) = tauae(k,m1) + aerolw(i,k,m,2) = ssaae(k,m1) + aerolw(i,k,m,3) = asyae(k,m1) enddo enddo - else - - aerosw(:,:,:,:) = f_zero - - endif - - endif ! end if_lsswr_block - - if ( lslwr ) then - - if ( lalwflg ) then - - if ( NLWBND == 1 ) then - m1 = NBDSW + 1 - do m = 1, NBDLW - do k = 1, NLAY - aerolw(i,k,m,1) = tauae(k,m1) - aerolw(i,k,m,2) = ssaae(k,m1) - aerolw(i,k,m,3) = asyae(k,m1) - enddo - enddo - else - do m = 1, NBDLW - m1 = NBDSW + m - do k = 1, NLAY - aerolw(i,k,m,1) = tauae(k,m1) - aerolw(i,k,m,2) = ssaae(k,m1) - aerolw(i,k,m,3) = asyae(k,m1) - enddo + do m = 1, NBDLW + m1 = NSWBND + m + do k = 1, NLAY + aerolw(i,k,m,1) = tauae(k,m1) + aerolw(i,k,m,2) = ssaae(k,m1) + aerolw(i,k,m,3) = asyae(k,m1) enddo - endif - - else - - aerolw(:,:,:,:) = f_zero - + enddo endif - endif ! end if_lslwr_block - enddo lab_do_IMAX + endif ! end if_laerlw_block + + enddo lab_do_IMAXg ! ================= contains ! ================= -!>\ingroup module_radiation_aerosols -!> This subroutine maps input tracer fields (trcly) to local tracer -!! array (aermr). -!>\section map_aermr_gen map_aermr General Algorithm -!! @{ -!----------------------------- - subroutine map_aermr -!............................. -! --- inputs: (in scope variables) -! --- outputs: (in scope variables) - -! ==================================================================== ! -! ! -! subprogram: map_aermr ! -! ! -! map input tracer fields (trcly) to local tracer array (aermr) ! -! ! -! ==================== defination of variables =================== ! -! ! -! input arguments: ! -! IMAX - horizontal dimension of arrays 1 ! -! NLAY - vertical dimensions of arrays 1 ! -! trcly - layer tracer mass mixing ratio g/g IMAX*NLAY*NTRAC! -! output arguments: (to module variables) ! -! aermr - layer aerosol mass mixing ratio g/g IMAX*NLAY*NMXG ! -! ! -! note: ! -! NTRAC is the number of tracers excluding water vapor ! -! NMXG is the number of prognostic aerosol species ! -! ================================================================== ! -! - implicit none - -! --- inputs: -! --- output: - -! --- local: - integer :: i, indx, ii - character :: tp*2 - -! initialize - aermr(:,:,:) = f_zero - ii = 1 !! <---- trcly does not contain q - -! ==> DU: du1 (submicron bins), du2, du3, du4, du5 - if( gfs_phy_tracer%doing_DU ) then - aermr(:,:,dm_indx%dust1) = trcly(:,:,dmfcs_indx%du001-ii) - aermr(:,:,dm_indx%dust2) = trcly(:,:,dmfcs_indx%du002-ii) - aermr(:,:,dm_indx%dust3) = trcly(:,:,dmfcs_indx%du003-ii) - aermr(:,:,dm_indx%dust4) = trcly(:,:,dmfcs_indx%du004-ii) - aermr(:,:,dm_indx%dust5) = trcly(:,:,dmfcs_indx%du005-ii) - endif - -! ==> OC: oc_phobic, oc_philic - if( gfs_phy_tracer%doing_OC ) then - aermr(:,:,dm_indx%waso_phobic) = & - & trcly(:,:,dmfcs_indx%ocphobic-ii) - aermr(:,:,dm_indx%waso_philic) = & - & trcly(:,:,dmfcs_indx%ocphilic-ii) - endif - -! ==> BC: bc_phobic, bc_philic - if( gfs_phy_tracer%doing_BC ) then - aermr(:,:,dm_indx%soot_phobic) = & - & trcly(:,:,dmfcs_indx%bcphobic-ii) - aermr(:,:,dm_indx%soot_philic) = & - & trcly(:,:,dmfcs_indx%bcphilic-ii) - endif - -! ==> SS: ss1, ss2 (submicron bins), ss3, ss4, ss5 - if( gfs_phy_tracer%doing_SS ) then - aermr(:,:,dm_indx%ssam) = trcly(:,:,dmfcs_indx%ss001-ii) & - & + trcly(:,:,dmfcs_indx%ss002-ii) - aermr(:,:,dm_indx%sscm) = trcly(:,:,dmfcs_indx%ss003-ii) & - & + trcly(:,:,dmfcs_indx%ss004-ii) & - & + trcly(:,:,dmfcs_indx%ss005-ii) - endif - -! ==> SU: so4 - if( gfs_phy_tracer%doing_SU ) then - aermr(:,:,dm_indx%suso) = trcly(:,:,dmfcs_indx%so4-ii) - endif - - return -!................................... - end subroutine map_aermr -!! @} -!----------------------------------- - +!-------------------------------- + subroutine aeropt +!................................ -!>\ingroup module_radiation_aerosols -!! This subroutine computes aerosols optical properties in NSWLWBD -!! SW/LW bands. Aerosol distribution at each grid point is composed -!! from up to NMXG aerosol species (from NUM_GRIDCOMP components). -!>\section aeropt_grt_gen aeropt_grt General Algorithm -!! @{ -!----------------------------------- - subroutine aeropt_grt -!................................... ! --- inputs: (in scope variables) ! --- outputs: (in scope variables) ! ================================================================== ! ! ! -! subprogram: aeropt_grt ! -! ! -! compute aerosols optical properties in NSWLWBD sw/lw bands. ! -! Aerosol distribution at each grid point is composed from up to ! -! NMXG aerosol species (from NUM_GRIDCOMP components). ! +! compute aerosols optical properties in NSWLWBD bands for gocart ! +! aerosol species ! ! ! ! input variables: ! -! dmanl - aerosol dry mass g/m3 NLAY*NMXG ! ! rh1 - relative humidity % NLAY ! -! dz1 - layer thickness km NLAY ! +! dz1 - layer thickness m NLAY ! +! aerms - aerosol mass concentration kg/m3 NLAY*KCM ! ! NLAY - vertical dimensions - 1 ! -! ivflip - control flag for direction of vertical index ! -! =0: index from toa to surface ! -! =1: index from surface to toa ! ! ! ! output variables: ! -! tauae - aerosol optical depth - NLAY*NSWLWBD ! -! ssaae - aerosol single scattering albedo - NLAY*NSWLWBD ! -! asyae - aerosol asymmetry parameter - NLAY*NSWLWBD ! +! tauae - optical depth - NLAY*NSWLWBD! +! ssaae - single scattering albedo - NLAY*NSWLWBD! +! asyae - asymmetry parameter - NLAY*NSWLWBD! +! aerodp - vertically integrated aer-opt-depth - IMAX*NSPC+1 ! ! ! ! ================================================================== ! -! - implicit none ! --- inputs: ! --- outputs: ! --- locals: - real (kind=kind_phys) :: aerdm - real (kind=kind_phys) :: ext1, ssa1, asy1, ex00, ss00, as00, & - & ex01, ss01, as01, exint - real (kind=kind_phys) :: tau, ssa, asy, & - & sum_tau, sum_ssa, sum_asy - -! --- subgroups for sub-micron dust -! --- corresponds to 0.1-0.18, 0.18-0.3, 0.3-0.6, 0.6-1.0 micron - - real (kind=kind_phys) :: fd(4) - data fd / 0.01053,0.08421,0.25263,0.65263 / - - character :: tp*2 - integer :: icmp, n, kk, ib, ih2, ih1, ii, ij, ijk real (kind=kind_phys) :: drh0, drh1, rdrh - - real (kind=kind_phys) :: qmin !<--lower bound for opt calc - data qmin / 1.e-20 / - -!===> ... begin here - -! --- initialize (assume no aerosols) - tauae = f_zero - ssaae = f_one - asyae = f_zero - - tauae_gocart = f_zero - -!===> ... loop over vertical layers -! - lab_do_layer : do kk = 1, NLAY + real (kind=kind_phys) :: cm, ext01, sca01, asy01, ssa01 + real (kind=kind_phys) :: ext1, asy1, ssa1, sca1 + real (kind=kind_phys) :: sum_tau,sum_asy,sum_ssa,tau,asy,ssa + integer :: ih1, ih2, nbin, ib, ntrc, ktrc ! --- linear interp coeffs for rh-dep species - ih2 = 1 - do while ( rh1(kk) > rhlev_grt(ih2) ) + do while ( rh1(k) > rhlev_grt(ih2) ) ih2 = ih2 + 1 - if ( ih2 > KRHLEV ) exit + if ( ih2 > krhlev ) exit enddo ih1 = max( 1, ih2-1 ) - ih2 = min( KRHLEV, ih2 ) + ih2 = min( krhlev, ih2 ) drh0 = rhlev_grt(ih2) - rhlev_grt(ih1) - drh1 = rh1(kk) - rhlev_grt(ih1) + drh1 = rh1(k) - rhlev_grt(ih1) if ( ih1 == ih2 ) then - rdrh = f_zero + rdrh = f_zero else - rdrh = drh1 / drh0 + rdrh = drh1 / drh0 endif -! --- loop through sw/lw spectral bands - - lab_do_ib : do ib = 1, NSWLWBD - sum_tau = f_zero - sum_ssa = f_zero - sum_asy = f_zero +! --- compute optical properties for each spectral bands + do ib = 1, nswlwbd + + sum_tau = f_zero + sum_ssa = f_zero + sum_asy = f_zero + +! --- determine tau, ssa, asy for dust aerosols + ext1 = f_zero + asy1 = f_zero + sca1 = f_zero + ssa1 = f_zero + do m = 1, kcm1 + cm = max(aerms(k,m),0.0) * dz1(k) + ext1 = ext1 + cm*extrhi_grt(m,ib) + sca1 = sca1 + cm*scarhi_grt(m,ib) + ssa1 = ssa1 + cm*extrhi_grt(m,ib) * ssarhi_grt(m,ib) + asy1 = asy1 + cm*scarhi_grt(m,ib) * asyrhi_grt(m,ib) + enddo ! m-loop + tau = ext1 + if (ext1 > f_zero) ssa=min(f_one, ssa1/ext1) + if (sca1 > f_zero) asy=min(f_one, asy1/sca1) + +! --- update aod from individual species + if ( ib==nv_aod ) then + spcodp(1) = spcodp(1) + tau + endif +! --- update sum_tau, sum_ssa, sum_asy + sum_tau = sum_tau + tau + sum_ssa = sum_ssa + tau * ssa + sum_asy = sum_asy + tau * ssa * asy -! --- loop through aerosol grid components - lab_do_icmp : do icmp = 1, NUM_GRIDCOMP +! --- determine tau, ssa, asy for non-dust aerosols + do ntrc = 2, nspc ext1 = f_zero - ssa1 = f_zero asy1 = f_zero - - tp = gridcomp(icmp) - - select case ( tp ) - -! -- dust aerosols: no humidification effect - case ( 'DU') - do n = 1, KCM1 - - if (n <= 4) then - aerdm = dmanl(kk,dm_indx%dust1) * fd(n) - else - aerdm = dmanl(kk,dm_indx%dust1+n-4 ) - endif - - if (aerdm < qmin) aerdm = f_zero - ex00 = extrhi_grt(n,ib)*(1000.*dz1(kk))*aerdm - ss00 = ssarhi_grt(n,ib) - as00 = asyrhi_grt(n,ib) - ext1 = ext1 + ex00 - ssa1 = ssa1 + ex00 * ss00 - asy1 = asy1 + ex00 * ss00 * as00 - - enddo - -! -- suso aerosols: with humidification effect - case ( 'SU') - ij = isuso - exint = extrhd_grt(ih1,ij,ib) & - & + rdrh*(extrhd_grt(ih2,ij,ib) - extrhd_grt(ih1,ij,ib)) - ss00 = ssarhd_grt(ih1,ij,ib) & - & + rdrh*(ssarhd_grt(ih2,ij,ib) - ssarhd_grt(ih1,ij,ib)) - as00 = asyrhd_grt(ih1,ij,ib) & - & + rdrh*(asyrhd_grt(ih2,ij,ib) - asyrhd_grt(ih1,ij,ib)) - - aerdm = dmanl(kk, dm_indx%suso) - if (aerdm < qmin) aerdm = f_zero - ex00 = exint*(1000.*dz1(kk))*aerdm - ext1 = ex00 - ssa1 = ex00 * ss00 - asy1 = ex00 * ss00 * as00 - -! -- seasalt aerosols: with humidification effect - case ( 'SS') - do n = 1, 2 !<---- ssam, sscm - ij = issam + (n-1) - exint = extrhd_grt(ih1,ij,ib) & - & + rdrh*(extrhd_grt(ih2,ij,ib) - extrhd_grt(ih1,ij,ib)) - ss00 = ssarhd_grt(ih1,ij,ib) & - & + rdrh*(ssarhd_grt(ih2,ij,ib) - ssarhd_grt(ih1,ij,ib)) - as00 = asyrhd_grt(ih1,ij,ib) & - & + rdrh*(asyrhd_grt(ih2,ij,ib) - asyrhd_grt(ih1,ij,ib)) - - aerdm = dmanl(kk, dm_indx%ssam+n-1) - if (aerdm < qmin) aerdm = f_zero - ex00 = exint*(1000.*dz1(kk))*aerdm - ext1 = ext1 + ex00 - ssa1 = ssa1 + ex00 * ss00 - asy1 = asy1 + ex00 * ss00 * as00 - - enddo - -! -- organic carbon/black carbon: -! using 'waso' and 'soot' for hydrophilic OC and BC -! using 'waso' and 'soot' at RH=0 for hydrophobic OC and BC - case ( 'OC', 'BC') - if(tp == 'OC') then - ii = dm_indx%waso_phobic - ij = iwaso - else - ii = dm_indx%soot_phobic - ij = isoot - endif - -! --- hydrophobic - aerdm = dmanl(kk, ii) - if (aerdm < qmin) aerdm = f_zero - ex00 = extrhd_grt(1,ij,ib)*(1000.*dz1(kk))*aerdm - ss00 = ssarhd_grt(1,ij,ib) - as00 = asyrhd_grt(1,ij,ib) -! --- hydrophilic - aerdm = dmanl(kk, ii+1) - if (aerdm < qmin) aerdm = f_zero - exint = extrhd_grt(ih1,ij,ib) & - & + rdrh*(extrhd_grt(ih2,ij,ib) - extrhd_grt(ih1,ij,ib)) - ex01 = exint*(1000.*dz1(kk))*aerdm - ss01 = ssarhd_grt(ih1,ij,ib) & - & + rdrh*(ssarhd_grt(ih2,ij,ib) - ssarhd_grt(ih1,ij,ib)) - as01 = asyrhd_grt(ih1,ij,ib) & - & + rdrh*(asyrhd_grt(ih2,ij,ib) - asyrhd_grt(ih1,ij,ib)) - - ext1 = ex00 + ex01 - ssa1 = (ex00 * ss00) + (ex01 * ss01) - asy1 = (ex00 * ss00 * as00) + (ex01 * ss01 * as01) - - end select - -! --- determine tau, ssa, asy for each grid component + sca1 = f_zero + ssa1 = f_zero + ktrc = trc_to_aod(ntrc) + do nbin = 1, num_radius(ntrc) + m1 = radius_lower(ntrc) + nbin - 1 + m = m1 - num_radius(1) ! exclude dust aerosols + cm = max(aerms(k,m1),0.0) * dz1(k) + ext01 = extrhd_grt(ih1,m,ib) + & + & rdrh * (extrhd_grt(ih2,m,ib)-extrhd_grt(ih1,m,ib)) + sca01 = scarhd_grt(ih1,m,ib) + & + & rdrh * (scarhd_grt(ih2,m,ib)-scarhd_grt(ih1,m,ib)) + ssa01 = ssarhd_grt(ih1,m,ib) + & + & rdrh * (ssarhd_grt(ih2,m,ib)-ssarhd_grt(ih1,m,ib)) + asy01 = asyrhd_grt(ih1,m,ib) + & + & rdrh * (asyrhd_grt(ih2,m,ib)-asyrhd_grt(ih1,m,ib)) + ext1 = ext1 + cm*ext01 + sca1 = sca1 + cm*sca01 + ssa1 = ssa1 + cm*ext01 * ssa01 + asy1 = asy1 + cm*sca01 * asy01 + enddo ! end_do_nbin_loop tau = ext1 - if (ext1 > f_zero) ssa=min(f_one,ssa1/ext1) - if (ssa1 > f_zero) asy=min(f_one,asy1/ssa1) - -! --- save tau at 550 nm for each grid component - if ( ib == nv_aod ) then - do ijk = 1, max_num_gridcomp - if ( tp == max_gridcomp(ijk) ) then - tauae_gocart(kk,ijk) = tau - endif - enddo + if (ext1 > f_zero) ssa=min(f_one, ssa1/ext1) + if (sca1 > f_zero) asy=min(f_one, asy1/sca1) +! --- update aod from individual species + if ( ib==nv_aod ) then + spcodp(ktrc) = spcodp(ktrc) + tau endif - ! --- update sum_tau, sum_ssa, sum_asy sum_tau = sum_tau + tau sum_ssa = sum_ssa + tau * ssa sum_asy = sum_asy + tau * ssa * asy - - enddo lab_do_icmp - + enddo ! end_do_ntrc_loop ! --- determine total tau, ssa, asy for aerosol mixture - tauae(kk,ib) = sum_tau - if (sum_tau > f_zero) ssaae(kk,ib) = sum_ssa / sum_tau - if (sum_ssa > f_zero) asyae(kk,ib) = sum_asy / sum_ssa - - enddo lab_do_ib - - enddo lab_do_layer + tauae(k,ib) = sum_tau + if (sum_tau > f_zero) ssaae(k,ib) = sum_ssa / sum_tau + if (sum_ssa > f_zero) asyae(k,ib) = sum_asy / sum_ssa + enddo ! end_do_ib_loop ! return -!................................... - end subroutine aeropt_grt -!! @} -!-------------------------------- - !................................ - end subroutine setgocartaer + end subroutine aeropt !-------------------------------- + +!................................... + end subroutine aer_property_gocart +!----------------------------------- !! @} ! -! GOCART code modification end here (Sarah Lu) ------------------------! ! ======================================================================= !..........................................! end module module_radiation_aerosols ! !==========================================! +!> @} diff --git a/physics/radlw_main.meta b/physics/radlw_main.meta index 73977e5cb..e91fc10df 100644 --- a/physics/radlw_main.meta +++ b/physics/radlw_main.meta @@ -257,7 +257,7 @@ intent = in optional = F [hlwc] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step_and_radiation_levels long_name = longwave total sky heating rate units = K s-1 dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) @@ -291,7 +291,7 @@ intent = inout optional = F [hlw0] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step + standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels long_name = longwave clear sky heating rate units = K s-1 dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) diff --git a/physics/radlw_param.meta b/physics/radlw_param.meta index a06a89512..61aee1d37 100644 --- a/physics/radlw_param.meta +++ b/physics/radlw_param.meta @@ -23,3 +23,9 @@ units = DDT dimensions = () type = sfcflw_type +[proflw_type] + standard_name = proflw_type + long_name = definition of type proflw_type + units = DDT + dimensions = () + type = proflw_type diff --git a/physics/radsw_main.meta b/physics/radsw_main.meta index c5cbe768a..c8074cf47 100644 --- a/physics/radsw_main.meta +++ b/physics/radsw_main.meta @@ -318,7 +318,7 @@ intent = in optional = F [hswc] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step_and_radiation_levels long_name = shortwave total sky heating rate units = K s-1 dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) @@ -352,7 +352,7 @@ intent = inout optional = F [hsw0] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels long_name = shortwave clear sky heating rate units = K s-1 dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) diff --git a/physics/radsw_param.meta b/physics/radsw_param.meta index 9f7c8a35a..e0eb5ece8 100644 --- a/physics/radsw_param.meta +++ b/physics/radsw_param.meta @@ -34,3 +34,9 @@ units = DDT dimensions = () type = cmpfsw_type +[profsw_type] + standard_name = profsw_type + long_name = definition of type profsw_type + units = DDT + dimensions = () + type = profsw_type diff --git a/physics/rascnv.F90 b/physics/rascnv.F90 new file mode 100644 index 000000000..be3b928a8 --- /dev/null +++ b/physics/rascnv.F90 @@ -0,0 +1,4158 @@ +!> \file rascnv.F90 +!! This file contains the entire Relaxed Arakawa-Schubert convection +!! parameteriztion + + module rascnv + + USE machine , ONLY : kind_phys + implicit none + public :: rascnv_init, rascnv_run, rascnv_finalize + private + logical :: is_initialized = .False. +! + integer, parameter :: nrcmax=32 ! Maximum # of random clouds per 1200s + + integer, parameter :: idnmax=999 + real (kind=kind_phys), parameter :: delt_c=1800.0/3600.0 & +! Adjustment time scales in hrs for deep and shallow clouds +! &, adjts_d=3.0, adjts_s=0.5 +! &, adjts_d=2.5, adjts_s=0.5 + &, adjts_d=2.0, adjts_s=0.5 +! + logical, parameter :: fix_ncld_hr=.true. + +! + real (kind=kind_phys), parameter :: ZERO=0.0, HALF=0.5 & + &, pt25=0.25 & + &, ONE=1.0, TWO=2.0, FOUR=4.& + &, twoo3=two/3.0 & + &, FOUR_P2=4.E2, ONE_M10=1.E-10 & + &, ONE_M6=1.E-6, ONE_M5=1.E-5 & + &, ONE_M2=1.E-2, ONE_M1=1.E-1 & + &, oneolog10=one/log(10.0) & + &, facmb = 0.01 & ! conversion factor from Pa to hPa (or mb) + &, cmb2pa = 100.0 ! Conversion from hPa to Pa +! + real(kind=kind_phys), parameter :: frac=0.5, crtmsf=0.0 & + &, rhfacs=0.70, rhfacl=0.70 & + &, face=5.0, delx=10000.0 & + &, ddfac=face*delx*0.001 & + &, max_neg_bouy=0.15 & +! &, max_neg_bouy=pt25 & + &, testmb=0.1, testmbi=one/testmb & + &, dpd=0.5, rknob=1.0, eknob=1.0 + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + logical, parameter :: do_aw=.true., cumfrc=.true. & + &, updret=.false., vsmooth=.false. & + &, wrkfun=.false., crtfun=.true. & + &, calkbl=.true., botop=.true., revap=.true. & + &, advcld=.true., advups=.false.,advtvd=.true. +! &, advcld=.true., advups=.true., advtvd=.false. +! &, advcld=.true., advups=.false.,advtvd=.false. + + + real(kind=kind_phys), parameter :: TF=233.16, TCR=273.16 & + &, TCRF=1.0/(TCR-TF), TCL=2.0 + +! +! For pressure gradient force in momentum mixing +! real (kind=kind_phys), parameter :: pgftop=0.80, pgfbot=0.30 & +! No pressure gradient force in momentum mixing + real (kind=kind_phys), parameter :: pgftop=0.0, pgfbot=0.0 & +! real (kind=kind_phys), parameter :: pgftop=0.55, pgfbot=0.55 & + &, pgfgrad=(pgfbot-pgftop)*0.001 & + &, cfmax=0.1 +! +! For Tilting Angle Specification +! + real(kind=kind_phys) REFP(6), REFR(6), TLAC(8), PLAC(8), TLBPL(7) & + &, drdp(5) +! + DATA PLAC/100.0, 200.0, 300.0, 400.0, 500.0, 600.0, 700.0, 800.0/ + DATA TLAC/ 35.0, 25.0, 20.0, 17.5, 15.0, 12.5, 10.0, 7.5/ + DATA REFP/500.0, 300.0, 250.0, 200.0, 150.0, 100.0/ + DATA REFR/ 1.0, 2.0, 3.0, 4.0, 6.0, 8.0/ +! + real(kind=kind_phys) AC(16), AD(16) +! + integer, parameter :: nqrp=500001 + real(kind=kind_phys) C1XQRP, C2XQRP, TBQRP(NQRP), TBQRA(NQRP) & + &, TBQRB(NQRP) +! + integer, parameter :: nvtp=10001 + real(kind=kind_phys) C1XVTP, C2XVTP, TBVTP(NVTP) +! + real(kind=kind_phys) afc, facdt, & + grav, cp, alhl, alhf, rgas, rkap, nu, pi, & + t0c, rv, cvap, cliq, csol, ttp, eps, epsm1,& +! + ONEBG, GRAVCON, onebcp, GRAVFAC, ELOCP, & + ELFOCP, oneoalhl, CMPOR, picon, zfac, & + deg2rad, PIINV, testmboalhl, & + rvi, facw, faci, hsub, tmix, DEN + + + contains + +! ----------------------------------------------------------------------- +! CCPP entry points for gfdl cloud microphysics +! ----------------------------------------------------------------------- + +!>\brief The subroutine initializes rascnv +!! +!> \section arg_table_rascnv_init Argument Table +!! \htmlinclude rascnv_init.html +!! + subroutine rascnv_init(me, dt, con_g, con_cp, con_rd, & + con_rv, con_hvap, con_hfus, con_fvirt, & + con_t0c, con_ttp, con_cvap, con_cliq, & + con_csol, con_eps, con_epsm1, & + errmsg, errflg) +! + Implicit none +! + integer, intent(in) :: me + real(kind=kind_phys), intent(in) :: dt, & + con_g, con_cp, con_rd, con_rv, con_hvap, & + con_hfus, con_fvirt, con_t0c, con_cvap, con_cliq, & + con_csol, con_ttp, con_eps, con_epsm1 + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +! + real(kind=kind_phys), parameter :: actp=1.7, facm=1.00 +! + real(kind=kind_phys) PH(15), A(15) +! + DATA PH/150.0, 200.0, 250.0, 300.0, 350.0, 400.0, 450.0, 500.0 & + &, 550.0, 600.0, 650.0, 700.0, 750.0, 800.0, 850.0/ +! + DATA A/ 1.6851, 1.1686, 0.7663, 0.5255, 0.4100, 0.3677 & + &, 0.3151, 0.2216, 0.1521, 0.1082, 0.0750, 0.0664 & + &, 0.0553, 0.0445, 0.0633/ +! + real(kind=kind_phys) tem, actop, tem1, tem2 + integer i, l + logical first + data first/.true./ +! +! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + if (is_initialized) return +! set critical workfunction arrays + ACTOP = ACTP*FACM + DO L=1,15 + A(L) = A(L)*FACM + ENDDO + DO L=2,15 + TEM = one / (PH(L) - PH(L-1)) + AC(L) = (PH(L)*A(L-1) - PH(L-1)*A(L)) * TEM + AD(L) = (A(L) - A(L-1)) * TEM + ENDDO + AC(1) = ACTOP + AC(16) = A(15) + AD(1) = zero + AD(16) = zero +! + CALL SETQRP + CALL SETVTP +! + do i=1,7 + tlbpl(i) = (tlac(i)-tlac(i+1)) / (plac(i)-plac(i+1)) + enddo + do i=1,5 + drdp(i) = (REFR(i+1)-REFR(i)) / (REFP(i+1)-REFP(i)) + enddo +! +! VTP = 36.34*SQRT(1.2)* (0.001)**0.1364 +! + AFC = -(1.01097E-4*DT)*(3600./DT)**0.57777778 +! + grav = con_g ; cp = con_cp ; alhl = con_hvap + alhf = con_hfus ; rgas = con_rd + nu = con_FVirt ; t0c = con_t0c + rv = con_rv ; cvap = con_cvap + cliq = con_cliq ; csol = con_csol ; ttp = con_ttp + eps = con_eps ; epsm1 = con_epsm1 +! + pi = four*atan(one) ; PIINV = one/PI + ONEBG = ONE / GRAV ; GRAVCON = cmb2pa * ONEBG + onebcp = one / cp ; GRAVFAC = GRAV / CMB2PA + rkap = rgas * onebcp ; deg2rad = pi/180.d0 + ELOCP = ALHL * onebcp ; ELFOCP = (ALHL+ALHF) * onebcp + oneoalhl = one/alhl ; CMPOR = CMB2PA / RGAS + picon = half*pi*onebg ; zfac = 0.28888889E-4 * ONEBG + testmboalhl = testmb/alhl +! + rvi = one/rv ; facw=CVAP-CLIQ + faci = CVAP-CSOL ; hsub=alhl+alhf + tmix = TTP-20.0 ; DEN=one/(TTP-TMIX) +! + + if (me == 0) write(0,*) ' NO DOWNDRAFT FOR CLOUD TYPES' & + &, ' DETRAINING AT NORMALIZED PRESSURE ABOVE ',DPD +! + is_initialized = .true. + +! + end subroutine rascnv_init +! +!! \section arg_table_rascnv_finalize Argument Table +!! \htmlinclude rascnv_finalize.html +!! + subroutine rascnv_finalize (errmsg, errflg) + + implicit none + + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + end subroutine rascnv_finalize +!! +!! +!!===================================================================== ! +!! rascnv_run: ! +!! ! +!! program history log: ! +!! Oct 2019 -- shrinivas moorthi ! +!! ! +!! ! +!! ==================== defination of variables ==================== +!! ! +!! ! +!! inputs: size +!! ! +!! im - integer, horiz dimension and num of used pts 1 ! +!! ix - integer, maximum horiz dimension 1 ! +!! k - integer, vertical dimension 1 ! +!! dt - real, time step in seconds 1 ! +!! dtf - real, dynamics time step in seconds 1 ! +!! rannum - real, array holding random numbers between 0 an 1 (ix,nrcm) ! +!! tin - real, input temperature (K) +!! qin - real, input specific humidity (kg/kg) +!! uin - real, input zonal wind component +!! vin - real, input meridional wind component +!! ccin - real, input condensates+tracers +!! fscav - real +!! prsi - real, layer interface pressure +!! prsl - real, layer mid pressure +!! prsik - real, layer interface Exner function +!! prslk - real, layer mid Exner function +!! phil - real, layer mid geopotential height +!! phii - real, layer interface geopotential height +!! kpbl - integer pbl top index +!! cdrag - real, drag coefficient +!! rainc - real, convectinve rain (m/sec) +!! kbot - integer, cloud bottom index +!! ktop - integer, cloud top index +!! knv - integer, 0 - no convvection; 1 - convection +!! ddvel - downdraft induced surface wind +!! flipv - logical, true if input data from bottom to top +!! me - integer, current pe number +!! area - real, grid area +!! ccwf - real, multiplication factor for critical workfunction +!! nrcm - integer, number of random numbers at each grid point +!! rhc - real, critical relative humidity +!! ud_mf - real, updraft mass flux +!! dd_mf - real, downdraft mass flux +!! dt_mf - real, detrained mass flux +!! qw0 - real, min cloud water before autoconversion +!! qi0 - real, min cloud ice before autoconversion +!! dlqfac - real,fraction of condensated detrained in layers +!! kdt - integer, current teime step +!! revap - logial, when true reevaporate falling rain/snow +!! qlcn - real +!! qicn - real +!! w_upi - real +!! cf_upi - real +!! cnv_mfd - real +!! cnv_dqldt- real +!! clcn - real +!! cnv_fice - real +!! cnv_ndrop- real +!! cnv_nice - real +!! mp_phys - integer, microphysics option +!! mp_phys_mg - integer, flag for MG microphysics option +!! trcmin - real, floor value for tracers +!! ntk - integer, index representing TKE in the tracer array +!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +!! \section arg_table_rascnv_run Argument Table +!! \htmlinclude rascnv_run.html +!! + subroutine rascnv_run(IM, IX, k, ntr, dt, dtf & + &, ccwf, area, dxmin, dxinv & + &, psauras, prauras, wminras, dlqf, flipv & + &, me, rannum, nrcm, mp_phys, mp_phys_mg & + &, ntk, kdt, rhc & + &, tin, qin, uin, vin, ccin, fscav & + &, prsi, prsl, prsik, prslk, phil, phii & + &, KPBL, CDRAG, RAINC, kbot, ktop, kcnv & + &, DDVEL, ud_mf, dd_mf, dt_mf & + &, QLCN, QICN, w_upi, cf_upi, CNV_MFD & + &, CNV_DQLDT,CLCN,CNV_FICE,CNV_NDROP,CNV_NICE & + &, errmsg, errflg) +! +!********************************************************************* +!********************************************************************* +!************ Relaxed Arakawa-Schubert ****************** +!************ Parameterization ****************** +!************ Plug Compatible Driver ****************** +!************ 23 May 2002 ****************** +!************ ****************** +!************ Developed By ****************** +!************ ****************** +!************ Shrinivas Moorthi ****************** +!************ ****************** +!************ EMC/NCEP ****************** +!********************************************************************* +!********************************************************************* +! +! + Implicit none +! + LOGICAL FLIPV +! +! input +! + integer, intent(in) :: im, ix, k, ntr, me, nrcm, ntk, kdt & + &, mp_phys, mp_phys_mg + integer, dimension(im) :: kbot, ktop, kcnv, kpbl +! + real(kind=kind_phys), intent(in) :: dxmin, dxinv, ccwf(2) & + &, psauras(2), prauras(2) & + &, wminras(2), dlqf(2) +! + real(kind=kind_phys), dimension(ix,k) :: tin, qin, uin, vin & + &, prsl, prslk, phil + real(kind=kind_phys), dimension(ix,k+1) :: prsi, prsik, phii + real(kind=kind_phys), dimension(im,k) :: ud_mf, dd_mf, dt_mf & + &, rhc, qlcn, qicn, w_upi & + &, cnv_mfd & + &, cnv_dqldt, clcn & + &, cnv_fice, cnv_ndrop & + &, cnv_nice, cf_upi + real(kind=kind_phys), dimension(im) :: area, cdrag & + &, rainc, ddvel + real(kind=kind_phys), dimension(ix,nrcm):: rannum + real(kind=kind_phys) ccin(ix,k,ntr+2) + real(kind=kind_phys) trcmin(ntr+2) + + real(kind=kind_phys) DT, dtf, qw0, qi0 +! +! Added for aerosol scavenging for GOCART +! + real(kind=kind_phys), intent(in) :: fscav(ntr) + +! &, ctei_r(im), ctei_rm + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg +! +! locals +! + real(kind=kind_phys), dimension(k) :: toi, qoi, tcu, qcu & + &, pcu, clw, cli, qii, qli& + &, phi_l, prsm,psjm & + &, alfinq, alfind, rhc_l & + &, qoi_l, qli_l, qii_l + real(kind=kind_phys), dimension(k+1) :: prs, psj, phi_h, flx, flxd + + + integer, dimension(100) :: ic + real(kind=kind_phys), parameter :: clwmin=1.0e-10 +! + real(kind=kind_phys), allocatable :: ALFINT(:,:), uvi(:,:) & + &, trcfac(:,:), rcu(:,:) + real(kind=kind_phys) dtvd(2,4) +! &, DPI(K) + real(kind=kind_phys) CFAC, TEM, sgc, ccwfac, tem1, tem2, rain & + &, wfnc,tla,pl,qiid,qlid, c0, c0i, dlq_fac, sumq& + &, rainp +! integer :: nrcmax ! Maximum # of random clouds per 1200s +! + Integer KCR, KFX, NCMX, NC, KTEM, I, ii, Lm1, l & + &, ntrc, ia, ll, km1, kp1, ipt, lv, KBL, n & + &, KRMIN, KRMAX, KFMAX, kblmx, irnd,ib & + &, kblmn, ksfc, ncrnd + real(kind=kind_phys) sgcs(k,im) +! +! Scavenging related parameters +! + real fscav_(ntr+2) ! Fraction scavenged per km +! + fscav_ = zero ! By default no scavenging + if (ntr > 0) then + do i=1,ntr + fscav_(i) = fscav(i) + enddo + endif + trcmin = -99999.0 + if (ntk-2 > 0) trcmin(ntk-2) = 1.0d-4 + +!> - Initialize CCPP error handling variables + + errmsg = '' + errflg = 0 +! + km1 = k - 1 + kp1 = k + 1 + if (flipv) then + ksfc = 1 + else + ksfc = kp1 + endif +! + ntrc = ntr + IF (CUMFRC) THEN + ntrc = ntrc + 2 + ENDIF + if (ntrc > 0) then + if (.not. allocated(trcfac)) allocate (trcfac(k,ntrc)) + if (.not. allocated(uvi)) allocate (uvi(k,ntrc)) + if (.not. allocated(rcu)) allocate (rcu(k,ntrc)) + do n=1, ntrc + do l=1,k + trcfac(l,n) = one ! For other tracers + rcu(l,n) = zero + enddo + enddo + endif +! +!!!!! initialization for microphysics ACheng + if(mp_phys == 10) then + do l=1,K + do i=1,im + QLCN(i,l) = zero + QICN(i,l) = zero + w_upi(i,l) = zero + cf_upi(i,l) = zero + CNV_MFD(i,l) = zero +! CNV_PRC3(i,l) = zero + CNV_DQLDT(i,l) = zero + CLCN(i,l) = zero + CNV_FICE(i,l) = zero + CNV_NDROP(i,l) = zero + CNV_NICE(i,l) = zero + enddo + enddo + endif +! + if (.not. allocated(alfint)) allocate(alfint(k,ntrc+4)) +! +! call set_ras_afc(dt) +! AFC = -(1.04E-4*DT)*(3600./DT)**0.578 +! AFC = -(1.01097E-4*DT)*(3600./DT)**0.57777778 +! + do l=1,k + do i=1,im + ud_mf(i,l) = zero + dd_mf(i,l) = zero + dt_mf(i,l) = zero + enddo + enddo + DO IPT=1,IM + + tem1 = max(zero, min(one, (log(area(ipt)) - dxmin) * dxinv)) + tem2 = one - tem1 + ccwfac = ccwf(1)*tem1 + ccwf(2)*tem2 + dlq_fac = dlqf(1)*tem1 + dlqf(2)*tem2 + tem = one + dlq_fac + c0i = (psauras(1)*tem1 + psauras(2)*tem2) * tem + c0 = (prauras(1)*tem1 + prauras(2)*tem2) * tem + if (ccwfac == zero) ccwfac = half + +! +! ctei = .false. +! if (ctei_r(ipt) > ctei_rm) ctei = .true. +! +! Compute NCRND : +! if flipv is true, then input variables are from bottom +! to top while RAS goes top to bottom +! + tem = one / prsi(ipt,ksfc) + + KRMIN = 1 + KRMAX = km1 + KFMAX = KRMAX + kblmx = 1 + kblmn = 1 + DO L=1,KM1 + ll = l + if (flipv) ll = kp1 -l ! Input variables are bottom to top! + SGC = prsl(ipt,ll) * tem + sgcs(l,ipt) = sgc + IF (SGC <= 0.050) KRMIN = L +! IF (SGC <= 0.700) KRMAX = L +! IF (SGC <= 0.800) KRMAX = L + IF (SGC <= 0.760) KRMAX = L +! IF (SGC <= 0.930) KFMAX = L + IF (SGC <= 0.970) KFMAX = L ! Commented on 20060202 +! IF (SGC <= 0.700) kblmx = L ! Commented on 20101015 + IF (SGC <= 0.600) kblmx = L ! +! IF (SGC <= 0.650) kblmx = L ! Commented on 20060202 + IF (SGC <= 0.980) kblmn = L ! + ENDDO + krmin = max(krmin,2) + +! + if (fix_ncld_hr) then +!!! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1200) + 0.50001 + NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1800) + 0.10001 +! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/1200) + 0.10001 +! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/900) + 0.50001 +! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/600) + 0.50001 +! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * (DTF/360) + 0.50001 +! & + 0.50001 +! NCRND = min(nrcmax, (KRMAX-KRMIN+1)) * min(1.0,DTF/360) + 0.1 + facdt = delt_c / dt + else + NCRND = min(nrcmax, (KRMAX-KRMIN+1)) + facdt = one / 3600.0 + endif + NCRND = min(nrcm,max(NCRND, 1)) +! + KCR = MIN(K,KRMAX) + KTEM = MIN(K,KFMAX) + KFX = KTEM - KCR + + IF (KFX > 0) THEN + IF (BOTOP) THEN + DO NC=1,KFX + IC(NC) = KTEM + 1 - NC + ENDDO + ELSE + DO NC=KFX,1,-1 + IC(NC) = KTEM + 1 - NC + ENDDO + ENDIF + ENDIF +! + NCMX = KFX + NCRND + IF (NCRND > 0) THEN + DO I=1,NCRND + II = mod(i-1,nrcm) + 1 + IRND = (RANNUM(ipt,II)-0.0005)*(KCR-KRMIN+1) + IC(KFX+I) = IRND + KRMIN + ENDDO + ENDIF +! + do l=1,k + CLW(l) = zero + CLI(l) = zero + ! to be zero i.e. no environmental condensate!!! + QII(l) = zero + QLI(l) = zero +! Initialize heating, drying, cloudiness etc. + tcu(l) = zero + qcu(l) = zero + pcu(l) = zero + flx(l) = zero + flxd(l) = zero + do n=1,ntrc + rcu(l,n) = zero + enddo + enddo + flx(kp1) = zero + flxd(kp1) = zero + rain = zero +! + if (flipv) then ! Input variables are bottom to top! + do l=1,k + ll = kp1 - l + ! Transfer input prognostic data into local variable + toi(l) = tin(ipt,ll) + qoi(l) = qin(ipt,ll) + + PRSM(L) = prsl(ipt,ll) * facmb + PSJM(L) = prslk(ipt,ll) + phi_l(L) = phil(ipt,ll) + rhc_l(L) = rhc(ipt,ll) +! + if (ntrc > ntr) then ! CUMFRC is true + uvi(l,ntr+1) = uin(ipt,ll) + uvi(l,ntr+2) = vin(ipt,ll) + endif +! + if (ntr > 0) then ! tracers such as O3, dust etc + do n=1,ntr + uvi(l,n) = ccin(ipt,ll,n+2) + if (abs(uvi(l,n)) < 1.0e-20) uvi(l,n) = zero + enddo + endif + enddo + do l=1,kp1 + ll = kp1 + 1 - l ! Input variables are bottom to top! + PRS(LL) = prsi(ipt,L) * facmb + PSJ(LL) = prsik(ipt,L) + phi_h(LL) = phii(ipt,L) + enddo +! + if (ccin(ipt,1,2) <= -999.0) then ! input ice/water are together + do l=1,k + ll = kp1 -l + tem = ccin(ipt,ll,1) & + & * MAX(ZERO, MIN(ONE, (TCR-toi(L))*TCRF)) + ccin(ipt,ll,2) = ccin(ipt,ll,1) - tem + ccin(ipt,ll,1) = tem + enddo + endif + if (advcld) then + do l=1,k + ll = kp1 -l ! Input variables are bottom to top! + QII(L) = ccin(ipt,ll,1) + QLI(L) = ccin(ipt,ll,2) + enddo + endif + KBL = MAX(MIN(k, kp1-KPBL(ipt)), k/2) +! + else ! Input variables are top to bottom! + + do l=1,k + ! Transfer input prognostic data into local variable + toi(l) = tin(ipt,l) + qoi(l) = qin(ipt,l) + + PRSM(L) = prsl(ipt, L) * facmb + PSJM(L) = prslk(ipt,L) + phi_l(L) = phil(ipt,L) + rhc_l(L) = rhc(ipt,L) +! + if (ntrc > ntr) then ! CUMFRC is true + uvi(l,ntr+1) = uin(ipt,l) + uvi(l,ntr+2) = vin(ipt,l) + endif +! + if (ntr > 0) then ! tracers such as O3, dust etc + do n=1,ntr + uvi(l,n) = ccin(ipt,l,n+2) + if (abs(uvi(l,n)) < 1.0e-20) uvi(l,n) = zero + enddo + endif + enddo + DO L=1,kp1 + PRS(L) = prsi(ipt,L) * facmb + PSJ(L) = prsik(ipt,L) + phi_h(L) = phii(ipt,L) + ENDDO +! + if (ccin(ipt,1,2) <= -999.0) then ! input ice/water are together + do l=1,k + tem = ccin(ipt,l,1) & + & * MAX(ZERO, MIN(ONE, (TCR-toi(L))*TCRF)) + ccin(ipt,l,2) = ccin(ipt,l,1) - tem + ccin(ipt,l,1) = tem + enddo + endif + if (advcld) then + do l=1,k + QII(L) = ccin(ipt,l,1) + QLI(L) = ccin(ipt,l,2) + enddo + endif +! + KBL = KPBL(ipt) +! + endif ! end of if (flipv) then +! +! do l=k,kctop(1),-1 +!! DPI(L) = 1.0 / (PRS(L+1) - PRS(L)) +! enddo +! +! print *,' ipt=',ipt + + if (advups) then ! For first order upstream for updraft + alfint(:,:) = one + elseif (advtvd) then ! TVD flux limiter scheme for updraft + alfint(:,:) = one + l = krmin + lm1 = l - 1 + dtvd(1,1) = cp*(toi(l)-toi(lm1)) + phi_l(l)-phi_l(lm1) & + & + alhl*(qoi(l)-qoi(lm1)) + dtvd(1,2) = qoi(l) - qoi(lm1) + dtvd(1,3) = qli(l) - qli(lm1) + dtvd(1,4) = qii(l) - qii(lm1) + do l=krmin+1,k + lm1 = l - 1 + +! write(0,*)' toi=',toi(l),toi(lm1),' phi_l=',phi_l(l),phi_l(lm1) +! &,' qoi=',qoi(l),qoi(lm1),' cp=',cp,' alhl=',alhl + + dtvd(2,1) = cp*(toi(l)-toi(lm1)) + phi_l(l)-phi_l(lm1) & + & + alhl*(qoi(l)-qoi(lm1)) + +! write(0,*)' l=',l,' dtvd=',dtvd(:,1) + + if (abs(dtvd(2,1)) > 1.0e-10) then + tem1 = dtvd(1,1) / dtvd(2,1) + tem2 = abs(tem1) + alfint(l,1) = one - half*(tem1 + tem2)/(one + tem2) ! for h + endif + +! write(0,*)' alfint=',alfint(l,1),' l=',l,' ipt=',ipt + + dtvd(1,1) = dtvd(2,1) +! + dtvd(2,2) = qoi(l) - qoi(lm1) + +! write(0,*)' l=',l,' dtvd2=',dtvd(:,2) + + if (abs(dtvd(2,2)) > 1.0e-10) then + tem1 = dtvd(1,2) / dtvd(2,2) + tem2 = abs(tem1) + alfint(l,2) = one - half*(tem1 + tem2)/(one + tem2) ! for q + endif + dtvd(1,2) = dtvd(2,2) +! + dtvd(2,3) = qli(l) - qli(lm1) + +! write(0,*)' l=',l,' dtvd3=',dtvd(:,3) + + if (abs(dtvd(2,3)) > 1.0e-10) then + tem1 = dtvd(1,3) / dtvd(2,3) + tem2 = abs(tem1) + alfint(l,3) = one - half*(tem1 + tem2)/(one + tem2) ! for ql + endif + dtvd(1,3) = dtvd(2,3) +! + dtvd(2,4) = qii(l) - qii(lm1) + +! write(0,*)' l=',l,' dtvd4=',dtvd(:,4) + + if (abs(dtvd(2,4)) > 1.0e-10) then + tem1 = dtvd(1,4) / dtvd(2,4) + tem2 = abs(tem1) + alfint(l,4) = one - half*(tem1 + tem2)/(one + tem2) ! for qi + endif + dtvd(1,4) = dtvd(2,4) + enddo +! + if (ntrc > 0) then + do n=1,ntrc + l = krmin + dtvd(1,1) = uvi(l,n) - uvi(l-1,n) + do l=krmin+1,k + dtvd(2,1) = uvi(l,n) - uvi(l-1,n) + +! write(0,*)' l=',l,' dtvdn=',dtvd(:,1),' n=',n,' l=',l + + if (abs(dtvd(2,1)) > 1.0e-10) then + tem1 = dtvd(1,1) / dtvd(2,1) + tem2 = abs(tem1) + alfint(l,n+4) = one - half*(tem1 + tem2)/(one + tem2) ! for tracers + endif + dtvd(1,1) = dtvd(2,1) + enddo + enddo + endif + else + alfint(:,:) = half ! For second order scheme + endif + alfind(:) = half +! +! write(0,*)' after alfint for ipt=',ipt + +! Resolution dependent press grad correction momentum mixing + + if (CUMFRC) then + do l=krmin,k + tem = one - max(pgfbot, min(pgftop, pgftop+pgfgrad*prsm(l))) + trcfac(l,ntr+1) = tem + trcfac(l,ntr+2) = tem + enddo + endif +! +! if (calkbl) kbl = k + + if (calkbl) then + kbl = kblmn + else + kbl = min(kbl, kblmn) + endif +! + DO NC=1,NCMX ! multi cloud loop +! + IB = IC(NC) ! cloud top level index + if (ib > kbl-1) cycle + +! +!**************************************************************************** +! if (advtvd) then ! TVD flux limiter scheme for updraft +! l = ib +! lm1 = l - 1 +! dtvd(1,1) = cp*(toi(l)-toi(lm1)) + phi_l(l)-phi_l(lm1) +! & + alhl*(qoi(l)-qoi(lm1)) +! dtvd(1,2) = qoi(l) - qoi(lm1) +! dtvd(1,3) = qli(l) - qli(lm1) +! dtvd(1,4) = qii(l) - qii(lm1) +! do l=ib+1,k +! lm1 = l - 1 +! dtvd(2,1) = cp*(toi(l)-toi(lm1)) + phi_l(l)-phi_l(lm1) +! & + alhl*(qoi(l)-qoi(lm1)) +! if (abs(dtvd(2,1)) > 1.0e-10) then +! tem1 = dtvd(1,1) / dtvd(2,1) +! tem2 = abs(tem1) +! alfint(l,1) = 1.0 - 0.5*(tem1 + tem2)/(1.0 + tem2) ! for h +! endif +! dtvd(1,1) = dtvd(2,1) +! +! dtvd(2,2) = qoi(l) - qoi(lm1) +! if (abs(dtvd(2,2)) > 1.0e-10) then +! tem1 = dtvd(1,2) / dtvd(2,2) +! tem2 = abs(tem1) +! alfint(l,2) = 1.0 - 0.5*(tem1 + tem2)/(1.0 + tem2) ! for q +! endif +! dtvd(1,2) = dtvd(2,2) +! +! dtvd(2,3) = qli(l) - qli(lm1) +! if (abs(dtvd(2,3)) > 1.0e-10) then +! tem1 = dtvd(1,3) / dtvd(2,3) +! tem2 = abs(tem1) +! alfint(l,3) = 1.0 - 0.5*(tem1 + tem2)/(1.0 + tem2) ! for ql +! endif +! dtvd(1,3) = dtvd(2,3) +! +! dtvd(2,4) = qii(l) - qii(lm1) +! if (abs(dtvd(2,4)) > 1.0e-10) then +! tem1 = dtvd(1,4) / dtvd(2,4) +! tem2 = abs(tem1) +! alfint(l,4) = 1.0 - 0.5*(tem1 + tem2)/(1.0 + tem2) ! for qi +! endif +! dtvd(1,4) = dtvd(2,4) +! enddo +! +! if (ntrc > 0) then +! do n=1,ntrc +! l = ib +! dtvd(1,1) = uvi(l,n) - uvi(l-1,n) +! do l=ib+1,k +! dtvd(2,1) = uvi(l,n) - uvi(l-1,n) +! if (abs(dtvd(2,1)) > 1.0e-10) then +! tem1 = dtvd(1,1) / dtvd(2,1) +! tem2 = abs(tem1) +! alfint(l,n+4) = 1.0 - 0.5*(tem1 + tem2)/(1.0 + tem2) ! for tracers +! endif +! dtvd(1,1) = dtvd(2,1) +! enddo +! enddo +! endif +! endif +!**************************************************************************** +! + WFNC = zero + do L=IB,KP1 + FLX(L) = zero + FLXD(L) = zero + enddo +! + TLA = -10.0 +! + qiid = qii(ib) ! cloud top level ice before convection + qlid = qli(ib) ! cloud top level water before convection +! + rainp = rain + + CALL CLOUD(K, KP1, IB, ntrc, kblmx, kblmn & + &, FRAC, MAX_NEG_BOUY, vsmooth, do_aw & + &, REVAP, WRKFUN, CALKBL, CRTFUN & + &, DT, KDT, TLA, DPD & + &, ALFINT, rhfacl, rhfacs, area(ipt) & + &, ccwfac, CDRAG(ipt), trcfac & + &, alfind, rhc_l, phi_l, phi_h, PRS, PRSM,sgcs(1,ipt) & + &, TOI, QOI, UVI, QLI, QII, KBL, DDVEL(ipt) & + &, TCU, QCU, RCU, PCU, FLX, FLXD, RAIN, WFNC, fscav_ & + &, trcmin, ntk-2, c0, wminras(1), c0i, wminras(2) & + &, dlq_fac) +! &, ctei) + +! + if (flipv) then + do L=IB,K + ll = kp1 -l ! Input variables are bottom to top! + ud_mf(ipt,ll) = ud_mf(ipt,ll) + flx(l+1) + dd_mf(ipt,ll) = dd_mf(ipt,ll) + flxd(l+1) + enddo + ll = kp1 - ib + dt_mf(ipt,ll) = dt_mf(ipt,ll) + flx(ib) + + if (mp_phys == 10) then ! Anning Cheng for microphysics 11/14/2015 + + CNV_MFD(ipt,ll) = CNV_MFD(ipt,ll) + flx(ib)/dt + +! CNV_DQLDT(ipt,ll) = CNV_DQLDT(ipt,ll) +! & + max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt + CNV_DQLDT(ipt,ll) = CNV_DQLDT(ipt,ll) + flx(ib)* & + & max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt +! & max(0.,(QLI(ib)+QII(ib)))/dt/3. + if(flx(ib)<0) write(*,*)"AAA666", flx(ib),QLI(ib),QII(ib) & + & ,ipt,ll + endif + + else + + do L=IB,K + ud_mf(ipt,l) = ud_mf(ipt,l) + flx(l+1) + dd_mf(ipt,l) = dd_mf(ipt,l) + flxd(l+1) + enddo + dt_mf(ipt,ib) = dt_mf(ipt,ib) + flx(ib) + + if (mp_phys == 10) then ! Anning Cheng for microphysics 11/14/2015 + CNV_MFD(ipt,ib) = CNV_MFD(ipt,ib) + flx(ib)/dt +! CNV_DQLDT(ipt,ib) = CNV_DQLDT(ipt,ib) +! & + max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt + CNV_DQLDT(ipt,ib) = CNV_DQLDT(ipt,ib) + flx(ib)* & + & max(0.,(QLI(ib)+QII(ib)-qiid-qlid))/dt +! & max(0.,(QLI(ib)+QII(ib)))/dt/3. + if(flx(ib)<0) write(*,*)"AAA666", flx(ib),QLI(ib),QII(ib) & + & ,ipt,ib + endif + endif +! +! +! Warning!!!! +! ------------ +! By doing the following, CLOUD does not contain environmental +! condensate! +! + if (.not. advcld) then + do l=1,K + clw(l) = clw(l) + QLI(L) + cli(l) = cli(l) + QII(L) + QLI(L) = zero + QII(L) = zero + enddo + endif +! + ENDDO ! End of the NC loop! +! + RAINC(ipt) = rain * 0.001 ! Output rain is in meters + + ktop(ipt) = kp1 + kbot(ipt) = 0 + + kcnv(ipt) = 0 + + + do l=k,1,-1 +! qli(l) = max(qli(l), zero) +! qii(l) = max(qii(l), zero) +! clw(i) = max(clw(i), zero) +! cli(i) = max(cli(i), zero) + + if (sgcs(l,ipt) < 0.93 .and. abs(tcu(l)) > one_m10) then +! if (sgcs(l,ipt) < 0.90 .and. tcu(l) .ne. 0.0) then +! if (sgcs(l,ipt) < 0.85 .and. tcu(l) .ne. 0.0) then + kcnv(ipt) = 1 + endif +! New test for convective clouds ! added in 08/21/96 + if (clw(l)+cli(l) > zero .OR. & + & qli(l)+qii(l) > clwmin) ktop(ipt) = l + enddo + do l=1,km1 + if (clw(l)+cli(l) > zero .OR. & + & qli(l)+qii(l) > clwmin) kbot(ipt) = l + enddo +! + if (flipv) then + do l=1,k + ll = kp1 - l + tin(ipt,ll) = toi(l) ! Temperature + qin(ipt,ll) = qoi(l) ! Specific humidity + uin(ipt,ll) = uvi(l,ntr+1) ! U momentum + vin(ipt,ll) = uvi(l,ntr+2) ! V momentum + +!! for 2M microphysics, always output these variables + if (mp_phys == 10) then + if (advcld) then + QLCN(ipt,ll) = max(qli(l)-ccin(ipt,ll,2), zero) + QICN(ipt,ll) = max(qii(l)-ccin(ipt,ll,1), zero) + CNV_FICE(ipt,ll) = QICN(ipt,ll) & + & / max(1.e-10,QLCN(ipt,ll)+QICN(ipt,ll)) + else + QLCN(ipt,ll) = qli(l) + QICN(ipt,ll) = qii(l) + CNV_FICE(ipt,ll) = qii(l)/max(1.e-10,qii(l)+qli(l)) + endif + cf_upi(ipt,ll) = max(zero,min(0.02*log(one+ & + & 500*ud_mf(ipt,ll)/dt), cfmax)) +! & 500*ud_mf(ipt,ll)/dt), 0.60)) + CLCN(ipt,ll) = cf_upi(ipt,ll) !downdraft is below updraft + w_upi(ipt,ll) = ud_mf(ipt,ll)*toi(l)*rgas / & + & (dt*max(cf_upi(ipt,ll),1.e-12)*prsl(ipt,ll)) + endif + + if (ntr > 0) then + do n=1,ntr + ccin(ipt,ll,n+2) = uvi(l,n) ! Tracers + enddo + endif + enddo + if (advcld) then + do l=1,k + ll = kp1 - l + ccin(ipt,ll,1) = qii(l) ! Cloud ice + ccin(ipt,ll,2) = qli(l) ! Cloud water + enddo + else + do l=1,k + ll = kp1 - l + ccin(ipt,ll,1) = ccin(ipt,ll,1) + cli(l) + ccin(ipt,ll,2) = ccin(ipt,ll,2) + clw(l) + enddo + endif +! + ktop(ipt) = kp1 - ktop(ipt) + kbot(ipt) = kp1 - kbot(ipt) +! + else + + do l=1,k + tin(ipt,l) = toi(l) ! Temperature + qin(ipt,l) = qoi(l) ! Specific humidity + uin(ipt,l) = uvi(l,ntr+1) ! U momentum + vin(ipt,l) = uvi(l,ntr+2) ! V momentum + +!! for 2M microphysics, always output these variables + if (mp_phys == 10) then + if (advcld) then + QLCN(ipt,l) = max(qli(l)-ccin(ipt,l,2), zero) + QICN(ipt,l) = max(qii(l)-ccin(ipt,l,1), zero) + CNV_FICE(ipt,l) = QICN(ipt,l) & + & / max(1.e-10,QLCN(ipt,l)+QICN(ipt,l)) + else + QLCN(ipt,l) = qli(l) + QICN(ipt,l) = qii(l) + CNV_FICE(ipt,l) = qii(l)/max(1.e-10,qii(l)+qli(l)) + endif +!! CNV_PRC3(ipt,l) = PCU(l)/dt +! CNV_PRC3(ipt,l) = zero +! if(PCU(l) < zero) write(*,*)"AAA777",PCU(l),ipt,l + cf_upi(ipt,l) = max(zero,min(0.02*log(one+ & + & 500*ud_mf(ipt,l)/dt), cfmax)) +! & 500*ud_mf(ipt,l)/dt), 0.60)) + CLCN(ipt,l) = cf_upi(ipt,l) !downdraft is below updraft + w_upi(ipt,l) = ud_mf(ipt,l)*toi(l)*rgas / & + & (dt*max(cf_upi(ipt,l),1.e-12)*prsl(ipt,l)) + endif + + if (ntr > 0) then + do n=1,ntr + ccin(ipt,l,n+2) = uvi(l,n) ! Tracers + enddo + endif + enddo + if (advcld) then + do l=1,k + ccin(ipt,l,1) = qii(l) ! Cloud ice + ccin(ipt,l,2) = qli(l) ! Cloud water + enddo + else + do l=1,k + ccin(ipt,l,1) = ccin(ipt,l,1) + cli(l) + ccin(ipt,l,2) = ccin(ipt,l,2) + clw(l) + enddo + endif + endif +! +! Velocity scale from the downdraft! +! + DDVEL(ipt) = DDVEL(ipt) * DDFAC * GRAV / (prs(KP1)-prs(K)) +! + ENDDO ! End of the IPT Loop! + + deallocate (alfint, uvi, trcfac, rcu) +! + RETURN + end subroutine rascnv_run + SUBROUTINE CLOUD( & + & K, KP1, KD, NTRC, KBLMX, kblmn & + &, FRACBL, MAX_NEG_BOUY, vsmooth, do_aw & + &, REVAP, WRKFUN, CALKBL, CRTFUN & + &, DT, KDT, TLA, DPD & + &, ALFINT, RHFACL, RHFACS, area, ccwf, cd, trcfac & + &, alfind, rhc_ls, phil, phih, prs, prsm, sgcs & + &, TOI, QOI, ROI, QLI, QII, KPBL, DSFC & + &, TCU, QCU, RCU, PCU, FLX, FLXD, CUP, WFNC,fscav_ & + &, trcmin, ntk, c0, qw0, c0i, qi0, dlq_fac) +! &, ctei) + +! +!*********************************************************************** +!******************** Relaxed Arakawa-Schubert ************************ +!****************** Plug Compatible Scalar Version ********************* +!************************ SUBROUTINE CLOUD **************************** +!************************ October 2004 **************************** +!******************** VERSION 2.0 (modified) ************************* +!************* Shrinivas.Moorthi@noaa.gov (301) 683-3718 ***** ******** +!*********************************************************************** +!*References: +!----------- +! NOAA Technical Report NWS/NCEP 99-01: +! Documentation of Version 2 of Relaxed-Arakawa-Schubert +! Cumulus Parameterization with Convective Downdrafts, June 1999. +! by S. Moorthi and M. J. Suarez. +! +! Relaxed Arakawa-Schubert Cumulus Parameterization (Version 2) +! with Convective Downdrafts - Unpublished Manuscript (2002) +! by Shrinivas Moorthi and Max J. Suarez. +! +!*********************************************************************** +! +!===> UPDATES CLOUD TENDENCIES DUE TO A SINGLE CLOUD +!===> DETRAINING AT LEVEL KD. +! +!*********************************************************************** +! +!===> TOI(K) INOUT TEMPERATURE KELVIN +!===> QOI(K) INOUT SPECIFIC HUMIDITY NON-DIMENSIONAL +!===> ROI(K,NTRC)INOUT TRACER ARBITRARY +!===> QLI(K) INOUT LIQUID WATER NON-DIMENSIONAL +!===> QII(K) INOUT ICE NON-DIMENSIONAL + +!===> PRS(KP1) INPUT PRESSURE @ EDGES MB +!===> PRSM(K) INPUT PRESSURE @ LAYERS MB +!===> SGCS(K) INPUT Local sigma +!===> PHIH(KP1) INPUT GEOPOTENTIAL @ EDGES IN MKS units +!===> PHIL(K) INPUT GEOPOTENTIAL @ LAYERS IN MKS units +!===> PRJ(KP1) INPUT (P/P0)^KAPPA @ EDGES NON-DIMENSIONAL +!===> PRJM(K) INPUT (P/P0)^KAPPA @ LAYERS NON-DIMENSIONAL + +!===> K INPUT THE RISE & THE INDEX OF THE SUBCLOUD LAYER +!===> KD INPUT DETRAINMENT LEVEL ( 1<= KD < K ) +!===> NTRC INPUT NUMBER OF TRACERS. MAY BE ZERO. +!===> kblmx INPUT highest level the pbl can take +!===> kblmn INPUT lowest level the pbl can take +!===> DPD INPUT Critical normalized pressure (i.e. sigma) at the cloud top +! No downdraft calculation if the cloud top pressure is higher +! than DPD*PRS(KP1) +! +!===> TCU(K ) UPDATE TEMPERATURE TENDENCY DEG +!===> QCU(K ) UPDATE WATER VAPOR TENDENCY (G/G) +!===> RCU(K,NTRC)UPDATE TRACER TENDENCIES ND +!===> PCU(K) UPDATE PRECIP @ BASE OF LAYER KG/M^2 +!===> FLX(K ) UPDATE MASS FLUX @ TOP OF LAYER KG/M^2 +!===> CUP UPDATE PRECIPITATION AT THE SURFACE KG/M^2 +! + IMPLICIT NONE +! + real (kind=kind_phys), parameter :: RHMAX=1.0 & ! MAX RELATIVE HUMIDITY + &, QUAD_LAM=1.0 & ! MASK FOR QUADRATIC LAMBDA + &, RHRAM=0.05 & ! PBL RELATIVE HUMIDITY RAMP +! &, RHRAM=0.15 !& ! PBL RELATIVE HUMIDITY RAMP + &, HCRITD=4000.0 & ! Critical Moist Static Energy for Deep clouds + &, HCRITS=2000.0 & ! Critical Moist Static Energy for Shallow clouds + &, pcrit_lcl=250.0 & ! Critical pressure difference between boundary layer top + ! layer top and lifting condensation level (hPa) +! &, hpert_fac=1.01 !& ! Perturbation on hbl when ctei=.true. +! &, hpert_fac=1.005 !& ! Perturbation on hbl when ctei=.true. + &, qudfac=quad_lam*half & + &, shalfac=3.0 & +! &, qudfac=quad_lam*pt25, shalfac=3.0 !& ! Yogesh's + &, c0ifac=0.07 & ! following Han et al, 2016 MWR + &, dpnegcr = 150.0 +! &, dpnegcr = 100.0 +! &, dpnegcr = 200.0 +! + real(kind=kind_phys), parameter :: ERRMIN=0.0001 & + &, ERRMI2=0.1*ERRMIN & +! &, rainmin=1.0e-9 !& + &, rainmin=1.0e-8 & + &, oneopt9=1.0/0.09 & + &, oneopt4=1.0/0.04 + real(kind=kind_phys), parameter :: almax=1.0e-2 & + &, almin1=0.0, almin2=0.0 + real(kind=kind_phys), parameter :: bldmax = 300.0, bldmin=25.0 +! +! INPUT ARGUMENTS + +! LOGICAL REVAP, WRKFUN, CALKBL, CRTFUN, CALCUP, ctei + LOGICAL REVAP, WRKFUN, CALKBL, CRTFUN, CALCUP + logical vsmooth, do_aw + INTEGER K, KP1, KD, NTRC, kblmx, kblmn, ntk + + + real(kind=kind_phys), dimension(K) :: TOI, QOI, PRSM, QLI, QII& + &, PHIL, SGCS, rhc_ls & + &, alfind + real(kind=kind_phys), dimension(KP1) :: PRS, PHIH + real(kind=kind_phys), dimension(K,NTRC) :: ROI, trcfac + real(kind=kind_phys), dimension(ntrc) :: trcmin + real(kind=kind_phys) :: CD, DSFC + INTEGER :: KPBL, KBL, KB1, kdt + + real(kind=kind_phys) ALFINT(K,NTRC+4) + real(kind=kind_phys) FRACBL, MAX_NEG_BOUY, DPD & + &, RHFACL, RHFACS, area, ccwf & + &, c0, qw0, c0i, qi0, dlq_fac + +! UPDATE ARGUMENTS + + real(kind=kind_phys), dimension(K) :: TCU, QCU, TCD, QCD, PCU + real(kind=kind_phys), dimension(KP1) :: FLX, FLXD + real(kind=kind_phys), dimension(K,NTRC) :: RCU + real(kind=kind_phys) :: CUP +! +! TEMPORARY WORK SPACE + + real(kind=kind_phys), dimension(KD:K) :: HOL, QOL, HST, QST & + &, TOL, GMH, AKT, AKC, BKC, LTL, RNN & + &, FCO, PRI, QIL, QLL, ZET, XI, RNS & + &, Q0U, Q0D, vtf, CIL, CLL, ETAI, dlq & + &, wrk1, wrk2, dhdp, qrb, qrt, evp & + &, ghd, gsd, etz, cldfr, sigf, rho + + real(kind=kind_phys), dimension(KD:KP1) :: GAF, GMS, GAM, DLB & + &, DLT, ETA, PRL, BUY, ETD, HOD, QOD, wvl + real(kind=kind_phys), dimension(KD:K-1) :: etzi + + real(kind=kind_phys) fscav_(ntrc) + + LOGICAL ep_wfn, cnvflg, LOWEST, DDFT, UPDRET + + real(kind=kind_phys) ALM, DET, HCC, CLP & + &, HSU, HSD, QTL, QTV & + &, AKM, WFN, HOS, QOS & + &, AMB, TX1, TX2, TX3 & + &, TX4, TX5, QIS, QLS & + &, HBL, QBL, RBL(NTRC), wcbase & + &, QLB, QIB, PRIS & + &, WFNC, TX6, ACR & + &, TX7, TX8, TX9, RHC & + &, hstkd, qstkd, ltlkd, q0ukd, q0dkd, dlbkd & + &, qtp, qw00, qi00, qrbkd & + &, hstold, rel_fac, prism & + &, TL, PL, QL, QS, DQS, ST1, SGN, TAU, & + & QTVP, HB, QB, TB, QQQ, & + & HCCP, DS, DH, AMBMAX, X00, EPP, QTLP, & + & DPI, DPHIB, DPHIT, DEL_ETA, DETP, & + & TEM, TEM1, TEM2, TEM3, TEM4, & + & ST2, ST3, ST4, ST5, & + & ERRH, ERRW, ERRE, TEM5, & + & TEM6, HBD, QBD, st1s, shal_fac, hmax, hmin, & + & dhdpmn, avt, avq, avr, avh & + &, TRAIN, DOF, CLDFRD, tla, gmf & + &, FAC, RSUM1, RSUM2, RSUM3, dpneg, hcrit & + &, ACTEVAP,AREARAT,DELTAQ,MASS,MASSINV,POTEVAP & + &, TEQ,QSTEQ,DQDT,QEQ & + &, CLFRAC, DT, clvfr, delzkm, fnoscav, delp +! &, CLFRAC, DT, clf, clvfr, delzkm, fnoscav, delp +! &, almin1, almin2 + + INTEGER I, L, N, KD1, II, iwk, idh, lcon & + &, IT, KM1, KTEM, KK, KK1, LM1, LL, LP1, kbls, kmxh & + &, kblh, kblm, kblpmn, kmax, kmaxm1, kmaxp1, klcl, kmin, kmxb +! +!*********************************************************************** +! +! almin2 = 0.2 * sqrt(pi/area) +! almin1 = almin2 + + KM1 = K - 1 + KD1 = KD + 1 + + do l=1,K + tcd(L) = zero + qcd(L) = zero + enddo +! + CLDFRD = zero + DOF = zero + PRL(KP1) = PRS(KP1) +! + DO L=KD,K + RNN(L) = zero + ZET(L) = zero + XI(L) = zero +! + TOL(L) = TOI(L) + QOL(L) = QOI(L) + PRL(L) = PRS(L) + CLL(L) = QLI(L) + CIL(L) = QII(L) + BUY(L) = zero + + wvl(l) = zero + ENDDO + wvl(kp1) = zero +! + if (vsmooth) then + do l=kd,k + wrk1(l) = tol(l) + wrk2(l) = qol(l) + enddo + do l=kd1,km1 + tol(l) = pt25*wrk1(l-1) + half*wrk1(l) + pt25*wrk1(l+1) + qol(l) = pt25*wrk2(l-1) + half*wrk2(l) + pt25*wrk2(l+1) + enddo + endif +! + DO L=KD, K + DPI = ONE / (PRL(L+1) - PRL(L)) + PRI(L) = GRAVFAC * DPI +! + PL = PRSM(L) + TL = TOL(L) + + rho(l) = cmb2pa * pl / (rgas*tl*(one+nu*qol(l))) + + AKT(L) = (PRL(L+1) - PL) * DPI +! + CALL QSATCN(TL, PL, QS, DQS) +! + QST(L) = QS + GAM(L) = DQS * ELOCP + ST1 = ONE + GAM(L) + GAF(L) = ONEOALHL * GAM(L) / ST1 + + QL = MAX(MIN(QS*RHMAX,QOL(L)), ONE_M10) + QOL(L) = QL + + TEM = CP * TL + LTL(L) = TEM * ST1 / (ONE+NU*(QST(L)+TL*DQS)) + vtf(L) = one + NU * QL + ETA(L) = ONE / (LTL(L) * VTF(L)) + + HOL(L) = TEM + QL * ALHL + HST(L) = TEM + QS * ALHL +! + ENDDO +! + ETA(KP1) = ZERO + GMS(K) = ZERO +! + AKT(KD) = HALF + GMS(KD) = ZERO +! + CLP = ZERO +! + GAM(KP1) = GAM(K) + GAF(KP1) = GAF(K) +! + DO L=K,KD1,-1 + DPHIB = PHIL(L) - PHIH(L+1) + DPHIT = PHIH(L) - PHIL(L) +! + DLB(L) = DPHIB * ETA(L) ! here eta contains 1/(L*(1+nu*q)) + DLT(L) = DPHIT * ETA(L) +! + QRB(L) = DPHIB + QRT(L) = DPHIT +! + ETA(L) = ETA(L+1) + DPHIB + + HOL(L) = HOL(L) + ETA(L) + hstold = hst(l) + HST(L) = HST(L) + ETA(L) +! + ETA(L) = ETA(L) + DPHIT + ENDDO +! +! For the cloud top layer +! + L = KD + + DPHIB = PHIL(L) - PHIH(L+1) +! + DLB(L) = DPHIB * ETA(L) +! + QRB(L) = DPHIB + QRT(L) = DPHIB +! + ETA(L) = ETA(L+1) + DPHIB + + HOL(L) = HOL(L) + ETA(L) + HST(L) = HST(L) + ETA(L) +! +! To determine KBL internally -- If KBL is defined externally +! the following two loop should be skipped +! + hcrit = hcritd + if (sgcs(kd) > 0.65) hcrit = hcrits + IF (CALKBL) THEN + KTEM = MAX(KD+1, KBLMX) + hmin = hol(k) + kmin = k + do l=km1,kd,-1 + if (hmin > hol(l)) then + hmin = hol(l) + kmin = l + endif + enddo + if (kmin == k) return + hmax = hol(k) + kmax = k + do l=km1,ktem,-1 + if (hmax < hol(l)) then + hmax = hol(l) + kmax = l + endif + enddo + kmxb = kmax + if (kmax < kmin) then + kmax = k + kmxb = k + hmax = hol(kmax) + elseif (kmax < k) then + do l=kmax+1,k + if (abs(hol(kmax)-hol(l)) > half * hcrit) then + kmxb = l - 1 + exit + endif + enddo + endif + kmaxm1 = kmax - 1 + kmaxp1 = kmax + 1 + kblpmn = kmax +! + dhdp(kmax:k) = zero + dhdpmn = dhdp(kmax) + do l=kmaxm1,ktem,-1 + dhdp(l) = (HOL(L)-HOL(L+1)) / (PRL(L+2)-PRL(L)) + if (dhdp(l) < dhdpmn) then + dhdpmn = dhdp(l) + kblpmn = l + 1 + elseif (dhdp(l) > zero .and. l <= kmin) then + exit + endif + enddo + kbl = kmax + if (kblpmn < kmax) then + do l=kblpmn,kmaxm1 + if (hmax-hol(l) < half*hcrit) then + kbl = l + exit + endif + enddo + endif + +! + klcl = kd1 + if (kmax > kd1) then + do l=kmaxm1,kd1,-1 + if (hmax > hst(l)) then + klcl = l+1 + exit + endif + enddo + endif +! if (klcl == kd .or. klcl < ktem) return + +! This is to handle mid-level convection from quasi-uniform h + + if (kmax < kmxb) then + kmax = max(kd1, min(kmxb,k)) + kmaxm1 = kmax - 1 + kmaxp1 = kmax + 1 + endif + + +! if (prl(Kmaxp1) - prl(klcl) > 250.0 ) return + + ii = max(kbl,kd1) + kbl = max(klcl,kd1) + tem = min(50.0,max(10.0,(prl(kmaxp1)-prl(kd))*0.10)) + if (prl(kmaxp1) - prl(ii) > tem .and. ii > kbl) kbl = ii + + + if (kbl .ne. ii) then + if (PRL(kmaxp1)-PRL(KBL) > bldmax) kbl = max(kbl,ii) + endif + if (kbl < ii) then + if (hol(ii)-hol(ii-1) > half*hcrit) kbl = ii + endif + + if (prl(kbl) - prl(klcl) > pcrit_lcl) return +! +! KBL = min(kmax, MAX(KBL,KBLMX)) + KBL = min(kblmn, MAX(KBL,KBLMX)) +! kbl = min(kblh,kbl) +!!! +! tem1 = max(prl(kP1)-prl(k), & +! & min((prl(kbl) - prl(kd))*0.05, 10.0)) +!! & min((prl(kbl) - prl(kd))*0.05, 20.0)) +!! & min((prl(kbl) - prl(kd))*0.05, 30.0)) +! if (prl(kp1)-prl(kbl) < tem1) then +! KTEM = MAX(KD+1, KBLMX) +! do l=k,KTEM,-1 +! tem = prl(kp1) - prl(l) +! if (tem > tem1) then +! kbl = min(kbl,l) +! exit +! endif +! enddo +! endif +! if (kbl == kblmx .and. kmax >= km1) kbl = k - 1 +!!! + + KPBL = KBL + + ELSE + KBL = KPBL + ENDIF +! + KBL = min(kmax,MAX(KBL,KD+2)) + KB1 = KBL - 1 +!! + + if (PRL(Kmaxp1)-PRL(KBL) > bldmax .or. kb1 <= kd ) then +! & .or. PRL(Kmaxp1)-PRL(KBL) < bldmin) then + return + endif +! +! + PRIS = ONE / (PRL(KP1)-PRL(KBL)) + PRISM = ONE / (PRL(Kmaxp1)-PRL(KBL)) + TX1 = ETA(KBL) ! geopotential height at KBL +! + GMS(KBL) = zero + XI(KBL) = zero + ZET(KBL) = zero +! + shal_fac = one +! if (prl(kbl)-prl(kd) < 300.0 .and. kmax == k) shal_fac = shalfac + if (prl(kbl)-prl(kd) < 350.0 .and. kmax == k) shal_fac = shalfac + DO L=Kmax,KD,-1 + IF (L >= KBL) THEN + ETA(L) = (PRL(Kmaxp1)-PRL(L)) * PRISM + ELSE + ZET(L) = (ETA(L) - TX1) * ONEBG + XI(L) = ZET(L) * ZET(L) * (QUDFAC*shal_fac) + ETA(L) = ZET(L) - ZET(L+1) + GMS(L) = XI(L) - XI(L+1) + ENDIF + ENDDO + if (kmax < k) then + do l=kmaxp1,kp1 + eta(l) = zero + enddo + endif +! + HBL = HOL(Kmax) * ETA(Kmax) + QBL = QOL(Kmax) * ETA(Kmax) + QLB = CLL(Kmax) * ETA(Kmax) + QIB = CIL(Kmax) * ETA(Kmax) + TX1 = QST(Kmax) * ETA(Kmax) +! + DO L=Kmaxm1,KBL,-1 + TEM = ETA(L) - ETA(L+1) + HBL = HBL + HOL(L) * TEM + QBL = QBL + QOL(L) * TEM + QLB = QLB + CLL(L) * TEM + QIB = QIB + CIL(L) * TEM + TX1 = TX1 + QST(L) * TEM + ENDDO + +! if (ctei .and. sgcs(kd) > 0.65) then +! hbl = hbl * hpert_fac +! qbl = qbl * hpert_fac +! endif + +! Find Min value of HOL in TX2 + TX2 = HOL(KD) + IDH = KD1 + DO L=KD1,KB1 + IF (HOL(L) < TX2) THEN + TX2 = HOL(L) + IDH = L ! Level of minimum moist static energy! + ENDIF + ENDDO + IDH = 1 +! IDH = MAX(KD1, IDH) + IDH = MAX(KD, IDH) ! Moorthi May, 31, 2019 +! + TEM1 = HBL - HOL(KD) + TEM = HBL - HST(KD1) - LTL(KD1) * NU *(QOL(KD1)-QST(KD1)) + LOWEST = KD == KB1 + + lcon = kd + do l=kb1,kd1,-1 + if (hbl >= hst(l)) then + lcon = l + exit + endif + enddo +! + if (lcon == kd .or. kbl <= kd .or. prl(kbl)-prsm(lcon) > 150.0) & + & return +! + TX1 = RHFACS - QBL / TX1 ! Average RH + + cnvflg = (TEM > ZERO .OR. (LOWEST .AND. TEM1 >= ZERO)) & + & .AND. TX1 < RHRAM + + IF (.NOT. cnvflg) RETURN +! + RHC = MAX(ZERO, MIN(ONE, EXP(-20.0*TX1) )) +! + wcbase = 0.1 + if (ntrc > 0) then + DO N=1,NTRC + RBL(N) = ROI(Kmax,N) * ETA(Kmax) + ENDDO + DO N=1,NTRC + DO L=KmaxM1,KBL,-1 + RBL(N) = RBL(N) + ROI(L,N)*(ETA(L)-ETA(L+1)) + ENDDO + ENDDO +! +! if (ntk > 0 .and. do_aw) then + if (ntk > 0) then + if (rbl(ntk) > 0.0) then + wcbase = min(2.0, max(wcbase, sqrt(twoo3*rbl(ntk)))) +! wcbase = min(1.0, max(wcbase, sqrt(twoo3*rbl(ntk)))) + endif + endif + + endif +! + TX4 = zero + TX5 = zero +! + TX3 = QST(KBL) - GAF(KBL) * HST(KBL) + DO L=KBL,K + QIL(L) = MAX(ZERO, MIN(ONE, (TCR-TCL-TOL(L))*TCRF)) + ENDDO +! + DO L=KB1,KD1,-1 + lp1 = l + 1 + TEM = QST(L) - GAF(L) * HST(L) + TEM1 = (TX3 + TEM) * half + ST2 = (GAF(L)+GAF(LP1)) * half +! + FCO(LP1) = TEM1 + ST2 * HBL + + RNN(LP1) = ZET(LP1) * TEM1 + ST2 * TX4 + GMH(LP1) = XI(LP1) * TEM1 + ST2 * TX5 +! + TX3 = TEM + TX4 = TX4 + ETA(L) * HOL(L) + TX5 = TX5 + GMS(L) * HOL(L) +! + QIL(L) = MAX(ZERO, MIN(ONE, (TCR-TCL-TOL(L))*TCRF)) + QLL(LP1) = (half*ALHF) * ST2 * (QIL(L)+QIL(LP1)) + ONE + ENDDO +! +! FOR THE CLOUD TOP -- L=KD +! + L = KD +! + lp1 = l + 1 + TEM = QST(L) - GAF(L) * HST(L) + TEM1 = (TX3 + TEM) * half + ST2 = (GAF(L)+GAF(LP1)) * half +! + FCO(LP1) = TEM1 + ST2 * HBL + RNN(LP1) = ZET(LP1) * TEM1 + ST2 * TX4 + GMH(LP1) = XI(LP1) * TEM1 + ST2 * TX5 +! + FCO(L) = TEM + GAF(L) * HBL + RNN(L) = TEM * ZET(L) + (TX4 + ETA(L)*HOL(L)) * GAF(L) + GMH(L) = TEM * XI(L) + (TX5 + GMS(L)*HOL(L)) * GAF(L) +! +! Replace FCO for the Bottom +! + FCO(KBL) = QBL + RNN(KBL) = zero + GMH(KBL) = zero +! + QIL(KD) = MAX(ZERO, MIN(ONE, (TCR-TCL-TOL(KD))*TCRF)) + QLL(KD1) = (half*ALHF) * ST2 * (QIL(KD) + QIL(KD1)) + ONE + QLL(KD ) = ALHF * GAF(KD) * QIL(KD) + ONE +! + st1 = qil(kd) + st2 = c0i * st1 * exp(c0ifac*min(tol(kd)-t0c,0.0)) + tem = c0 * (one-st1) + tem2 = st2*qi0 + tem*qw0 +! + DO L=KD,KB1 + lp1 = l + 1 + tx2 = akt(l) * eta(l) + tx1 = tx2 * tem2 + q0u(l) = tx1 + FCO(L) = FCO(LP1) - FCO(L) + tx1 + RNN(L) = RNN(LP1) - RNN(L) & + & + ETA(L)*(QOL(L)+CLL(L)+CIL(L)) + tx1*zet(l) + GMH(L) = GMH(LP1) - GMH(L) & + & + GMS(L)*(QOL(L)+CLL(L)+CIL(L)) + tx1*xi(l) +! + tem1 = (one-akt(l)) * eta(l) + + AKT(L) = QLL(L) + (st2 + tem) * tx2 + + AKC(L) = one / AKT(L) +! + st1 = half * (qil(l)+qil(lp1)) + st2 = c0i * st1 * exp(c0ifac*min(tol(lp1)-t0c,0.0)) + tem = c0 * (one-st1) + tem2 = st2*qi0 + tem*qw0 +! + BKC(L) = QLL(LP1) - (st2 + tem) * tem1 +! + tx1 = tem1*tem2 + q0d(l) = tx1 + FCO(L) = FCO(L) + tx1 + RNN(L) = RNN(L) + tx1*zet(lp1) + GMH(L) = GMH(L) + tx1*xi(lp1) + ENDDO + + qw00 = qw0 + qi00 = qi0 + ii = 0 + 777 continue +! + ep_wfn = .false. + RNN(KBL) = zero + TX3 = bkc(kb1) * (QIB + QLB) + TX4 = zero + TX5 = zero + DO L=KB1,KD1,-1 + TEM = BKC(L-1) * AKC(L) + TX3 = (TX3 + FCO(L)) * TEM + TX4 = (TX4 + RNN(L)) * TEM + TX5 = (TX5 + GMH(L)) * TEM + ENDDO + IF (KD < KB1) THEN + HSD = HST(KD1) + LTL(KD1) * NU *(QOL(KD1)-QST(KD1)) + ELSE + HSD = HBL + ENDIF +! + TX3 = (TX3 + FCO(KD)) * AKC(KD) + TX4 = (TX4 + RNN(KD)) * AKC(KD) + TX5 = (TX5 + GMH(KD)) * AKC(KD) + ALM = ALHF*QIL(KD) - LTL(KD) * VTF(KD) +! + HSU = HST(KD) + LTL(KD) * NU * (QOL(KD)-QST(KD)) + +! +!===> VERTICAL INTEGRALS NEEDED TO COMPUTE THE ENTRAINMENT PARAMETER +! + TX1 = ALM * TX4 + TX2 = ALM * TX5 + + DO L=KD,KB1 + TAU = HOL(L) - HSU + TX1 = TX1 + TAU * ETA(L) + TX2 = TX2 + TAU * GMS(L) + ENDDO +! +! MODIFY HSU TO INCLUDE CLOUD LIQUID WATER AND ICE TERMS +! + HSU = HSU - ALM * TX3 +! + CLP = ZERO + ALM = -100.0 + HOS = HOL(KD) + QOS = QOL(KD) + QIS = CIL(KD) + QLS = CLL(KD) + + cnvflg = HBL > HSU .and. abs(tx1) > 1.0e-4 + +!*********************************************************************** + + ST1 = HALF*(HSU + HSD) + + IF (cnvflg) THEN +! +! STANDARD CASE: +! CLOUD CAN BE NEUTRALLY BOUYANT AT MIDDLE OF LEVEL KD W/ +VE LAMBDA. +! EPP < .25 IS REQUIRED TO HAVE REAL ROOTS. +! + clp = one + st2 = hbl - hsu + + if (tx2 == zero) then + alm = - st2 / tx1 + if (alm > almax) alm = -100.0 + else + x00 = tx2 + tx2 + epp = tx1 * tx1 - (x00+x00)*st2 + if (epp > zero) then + x00 = one / x00 + tem = sqrt(epp) + tem1 = (-tx1-tem)*x00 + tem2 = (-tx1+tem)*x00 + if (tem1 > almax) tem1 = -100.0 + if (tem2 > almax) tem2 = -100.0 + alm = max(tem1,tem2) + + endif + endif + +! +! CLIP CASE: +! NON-ENTRAINIG CLOUD DETRAINS IN LOWER HALF OF TOP LAYER. +! NO CLOUDS ARE ALLOWED TO DETRAIN BELOW THE TOP LAYER. +! + ELSEIF (HBL <= HSU .AND. HBL > ST1) THEN + ALM = ZERO +! CLP = (HBL-ST1) / (HSU-ST1) ! commented on Jan 16, 2010 + ENDIF +! + cnvflg = .TRUE. + IF (ALMIN1 > zero) THEN + IF (ALM >= ALMIN1) cnvflg = .FALSE. + ELSE + LOWEST = KD == KB1 + IF ( (ALM > ZERO) .OR. & + & (.NOT. LOWEST .AND. ALM == ZERO) ) cnvflg = .FALSE. + ENDIF +! +!===> IF NO SOUNDING MEETS SECOND CONDITION, RETURN +! + IF (cnvflg) THEN + IF (ii > 0 .or. (qw00 == zero .and. qi00 == zero)) RETURN + CLP = one + ep_wfn = .true. + GO TO 888 + ENDIF +! + st1s = ONE + IF(CLP > ZERO .AND. CLP < ONE) THEN + ST1 = HALF*(ONE+CLP) + ST2 = ONE - ST1 + st1s = st1 + hstkd = hst(kd) + qstkd = qst(kd) + ltlkd = ltl(kd) + q0ukd = q0u(kd) + q0dkd = q0d(kd) + dlbkd = dlb(kd) + qrbkd = qrb(kd) +! + HST(KD) = HST(KD)*ST1 + HST(KD1)*ST2 + HOS = HOL(KD)*ST1 + HOL(KD1)*ST2 + QST(KD) = QST(KD)*ST1 + QST(KD1)*ST2 + QOS = QOL(KD)*ST1 + QOL(KD1)*ST2 + QLS = CLL(KD)*ST1 + CLL(KD1)*ST2 + QIS = CIL(KD)*ST1 + CIL(KD1)*ST2 + LTL(KD) = LTL(KD)*ST1 + LTL(KD1)*ST2 +! + DLB(KD) = DLB(KD)*CLP + qrb(KD) = qrb(KD)*CLP + ETA(KD) = ETA(KD)*CLP + GMS(KD) = GMS(KD)*CLP + Q0U(KD) = Q0U(KD)*CLP + Q0D(KD) = Q0D(KD)*CLP + ENDIF +! +! +!*********************************************************************** +! +! Critical workfunction is included in this version +! + ACR = zero + TEM = PRL(KD1) - (PRL(KD1)-PRL(KD)) * CLP * HALF + tx1 = PRL(KBL) - TEM + tx2 = min(900.0, max(tx1,100.0)) + tem1 = log(tx2*0.01) * oneolog10 + tem2 = one - tem1 + if ( kdt == 1 ) then +! rel_fac = (dt * facdt) / (tem1*12.0 + tem2*3.0) + rel_fac = (dt * facdt) / (tem1*6.0 + tem2*adjts_s) + else + rel_fac = (dt * facdt) / (tem1*adjts_d + tem2*adjts_s) + endif +! +! rel_fac = max(zero, min(one,rel_fac)) + rel_fac = max(zero, min(half,rel_fac)) + + IF (CRTFUN) THEN + iwk = tem*0.02-0.999999999 + iwk = MAX(1, MIN(iwk, 16)) + ACR = tx1 * (AC(iwk) + tem * AD(iwk)) * CCWF + ENDIF +! +!===> NORMALIZED MASSFLUX +! +! ETA IS THE THICKNESS COMING IN AND normalized MASS FLUX GOING OUT. +! GMS IS THE THICKNESS SQUARE ; IT IS LATER REUSED FOR GAMMA_S +! +! ETA(K) = ONE + + DO L=KB1,KD,-1 + ETA(L) = ETA(L+1) + ALM * (ETA(L) + ALM * GMS(L)) + ETAI(L) = one / ETA(L) + ENDDO + ETAI(KBL) = one + +! +!===> CLOUD WORKFUNCTION +! + WFN = ZERO + AKM = ZERO + DET = ZERO + HCC = HBL + cnvflg = .FALSE. + QTL = QST(KB1) - GAF(KB1)*HST(KB1) + TX1 = HBL +! + qtv = qbl + det = qlb + qib +! + tx2 = zero + dpneg = zero +! + DO L=KB1,KD1,-1 + lm1 = l - 1 + lp1 = l + 1 + DEL_ETA = ETA(L) - ETA(LP1) + HCCP = HCC + DEL_ETA*HOL(L) +! + QTLP = QST(LM1) - GAF(LM1)*HST(LM1) + QTVP = half * ((QTLP+QTL)*ETA(L) & + & + (GAF(L)+GAF(LM1))*HCCP) + ST1 = ETA(L)*Q0U(L) + ETA(LP1)*Q0D(L) + DETP = (BKC(L)*DET - (QTVP-QTV) & + & + DEL_ETA*(QOL(L)+CLL(L)+CIL(L)) + ST1) * AKC(L) + + TEM1 = AKT(L) - QLL(L) + TEM2 = QLL(LP1) - BKC(L) + RNS(L) = TEM1*DETP + TEM2*DET - ST1 + + qtp = half * (qil(L)+qil(LM1)) + tem2 = min(qtp*(detp-eta(l)*qw00), & + & (one-qtp)*(detp-eta(l)*qi00)) + st1 = min(tx2,tem2) + tx2 = tem2 +! + IF (rns(l) < zero .or. st1 < zero) ep_wfn = .TRUE. + IF (DETP <= ZERO) cnvflg = .TRUE. + + ST1 = HST(L) - LTL(L)*NU*(QST(L)-QOL(L)) + + + TEM2 = HCCP + DETP * QTP * ALHF +! + ST2 = LTL(L) * VTF(L) + TEM5 = CLL(L) + CIL(L) + TEM3 = (TX1 - ETA(LP1)*ST1 - ST2*(DET-TEM5*eta(lp1))) * DLB(L) + TEM4 = (TEM2 - ETA(L )*ST1 - ST2*(DETP-TEM5*eta(l))) * DLT(L) +! + ST1 = TEM3 + TEM4 + + WFN = WFN + ST1 + AKM = AKM - min(ST1,ZERO) + + if (st1 < zero .and. wfn < zero) then + dpneg = dpneg + prl(lp1) - prl(l) + endif + + BUY(L) = half * (tem3/(eta(lp1)*qrb(l)) + tem4/(eta(l)*qrt(l))) +! + HCC = HCCP + DET = DETP + QTL = QTLP + QTV = QTVP + TX1 = TEM2 + + ENDDO + + DEL_ETA = ETA(KD) - ETA(KD1) + HCCP = HCC + DEL_ETA*HOS +! + QTLP = QST(KD) - GAF(KD)*HST(KD) + QTVP = QTLP*ETA(KD) + GAF(KD)*HCCP + ST1 = ETA(KD)*Q0U(KD) + ETA(KD1)*Q0D(KD) + DETP = (BKC(KD)*DET - (QTVP-QTV) & + & + DEL_ETA*(QOS+QLS+QIS) + ST1) * AKC(KD) +! + TEM1 = AKT(KD) - QLL(KD) + TEM2 = QLL(KD1) - BKC(KD) + RNS(KD) = TEM1*DETP + TEM2*DET - ST1 +! + IF (rns(kd) < zero) ep_wfn = .TRUE. + IF (DETP <= ZERO) cnvflg = .TRUE. +! + 888 continue + + if (ep_wfn) then + IF ((qw00 == zero .and. qi00 == zero)) RETURN + if (ii == 0) then + ii = 1 + if (clp > zero .and. clp < one) then + hst(kd) = hstkd + qst(kd) = qstkd + ltl(kd) = ltlkd + q0u(kd) = q0ukd + q0d(kd) = q0dkd + dlb(kd) = dlbkd + qrb(kd) = qrbkd + endif + do l=kd,kb1 + lp1 = l + 1 + FCO(L) = FCO(L) - q0u(l) - q0d(l) + RNN(L) = RNN(L) - q0u(l)*zet(l) - q0d(l)*zet(lp1) + GMH(L) = GMH(L) - q0u(l)*xi(l) - q0d(l)*zet(lp1) + ETA(L) = ZET(L) - ZET(LP1) + GMS(L) = XI(L) - XI(LP1) + Q0U(L) = zero + Q0D(L) = zero + ENDDO + qw00 = zero + qi00 = zero + + go to 777 + else + cnvflg = .true. + endif + endif +! +! +! ST1 = 0.5 * (HST(KD) - LTL(KD)*NU*(QST(KD)-QOS) & +! & + HST(KD1) - LTL(KD1)*NU*(QST(KD1)-QOL(KD1))) +! + ST1 = HST(KD) - LTL(KD)*NU*(QST(KD)-QOS) + ST2 = LTL(KD) * VTF(KD) + TEM5 = (QLS + QIS) * eta(kd1) + ST1 = HALF * (TX1-ETA(KD1)*ST1-ST2*(DET-TEM5))*DLB(KD) +! + WFN = WFN + ST1 + AKM = AKM - min(ST1,ZERO) ! Commented on 08/26/02 - does not include top +! + + BUY(KD) = ST1 / (ETA(KD1)*qrb(kd)) +! + DET = DETP + HCC = HCCP + AKM = AKM / WFN + + +!*********************************************************************** +! + IF (WRKFUN) THEN ! If only to calculate workfunction save it and return + IF (WFN >= zero) WFNC = WFN + RETURN + ELSEIF (.NOT. CRTFUN) THEN + ACR = WFNC + ENDIF +! +!===> THIRD CHECK BASED ON CLOUD WORKFUNCTION +! + CALCUP = .FALSE. + + TEM = max(0.05, MIN(CD*200.0, MAX_NEG_BOUY)) + IF (.not. cnvflg .and. WFN > ACR .and. & + & dpneg < dpnegcr .and. AKM <= TEM) CALCUP = .TRUE. + +! +!===> IF NO SOUNDING MEETS THIRD CONDITION, RETURN +! + IF (.NOT. CALCUP) RETURN +! +! This is for not LL - 20050601 +! IF (ALMIN2 .NE. zero) THEN +! IF (ALMIN1 .NE. ALMIN2) ST1 = one / max(ONE_M10,(ALMIN2-ALMIN1)) +! IF (ALM < ALMIN2) THEN +! CLP = CLP * max(zero, min(one,(0.3 + 0.7*(ALM-ALMIN1)*ST1))) +!! CLP = CLP * max(0.0, min(1.0,(0.2 + 0.8*(ALM-ALMIN1)*ST1))) +!! CLP = CLP * max(0.0, min(1.0,(0.1 + 0.9*(ALM-ALMIN1)*ST1))) +! ENDIF +! ENDIF +! + CLP = CLP * RHC + dlq = zero + tem = one / (one + dlq_fac) + do l=kd,kb1 + rnn(l) = rns(l) * tem + dlq(l) = rns(l) * tem * dlq_fac + enddo + DO L=KBL,K + RNN(L) = zero + ENDDO +! +! If downdraft is to be invoked, do preliminary check to see +! if enough rain is available and then call DDRFT. +! + DDFT = .FALSE. + IF (dpd > zero) THEN + TRAIN = zero + IF (CLP > zero) THEN + DO L=KD,KB1 + TRAIN = TRAIN + RNN(L) + ENDDO + ENDIF + + PL = (PRL(KD1) + PRL(KD))*HALF + IF (TRAIN > 1.0E-4 .AND. PL <= dpd*prl(kp1)) DDFT = .TRUE. + ENDIF +! + IF (DDFT) THEN ! Downdraft scheme based on (Cheng and Arakawa, 1997) + CALL DDRFT( & + & K, KP1, KD & + &, TLA, ALFIND, wcbase & + &, TOL, QOL, HOL, PRL, QST, HST, GAM, GAF & +! &, TOL, QOL, HOL, PRL, QST, HST, GAM, GAF, HBL, QBL & + &, QRB, QRT, BUY, KBL, IDH, ETA, RNN, ETAI & + &, ALM, WFN, TRAIN, DDFT & + &, ETD, HOD, QOD, EVP, DOF, CLDFR, ETZ & + &, GMS, GSD, GHD, wvl) + + ENDIF +! +! No Downdraft case (including case with no downdraft solution) +! --------------------------------------------------------- +! + IF (.NOT. DDFT) THEN + DO L=KD,KP1 + ETD(L) = zero + HOD(L) = zero + QOD(L) = zero + wvl(l) = zero + ENDDO + DO L=KD,K + EVP(L) = zero + ETZ(L) = zero + ENDDO + + ENDIF + +! +!===> CALCULATE GAMMAS i.e. TENDENCIES PER UNIT CLOUD BASE MASSFLUX +! Includes downdraft terms! + + avh = zero + +! +! Fraction of detrained condensate evaporated +! +! tem1 = max(ZERO, min(HALF, (prl(kd)-FOUR_P2)*ONE_M2)) +! tem1 = max(ZERO, min(HALF, (prl(kd)-300.0)*0.005)) + tem1 = zero +! tem1 = 1.0 +! if (kd1 == kbl) tem1 = 0.0 +! + tem2 = one - tem1 + TEM = DET * QIL(KD) + + + st1 = (HCC+ALHF*TEM-ETA(KD)*HST(KD)) / (one+gam(KD)) + DS = ETA(KD1) * (HOS- HOL(KD)) - ALHL*(QOS - QOL(KD)) + DH = ETA(KD1) * (HOS- HOL(KD)) + + + GMS(KD) = (DS + st1 - tem1*det*alhl-tem*alhf) * PRI(KD) + GMH(KD) = PRI(KD) * (HCC-ETA(KD)*HOS + DH) + +! +! TENDENCY FOR SUSPENDED ENVIRONMENTAL ICE AND/OR LIQUID WATER +! + QLL(KD) = (tem2*(DET-TEM) + ETA(KD1)*(QLS-CLL(KD)) & + & + (one-QIL(KD))*dlq(kd) - ETA(KD)*QLS ) * PRI(KD) + + QIL(KD) = (tem2*TEM + ETA(KD1)*(QIS-CIL(KD)) & + & + QIL(KD)*dlq(kd) - ETA(KD)*QIS ) * PRI(KD) +! + GHD(KD) = zero + GSD(KD) = zero +! + DO L=KD1,K + lm1 = l - 1 + ST1 = ONE - ALFINT(L,1) + ST2 = ONE - ALFINT(L,2) + ST3 = ONE - ALFINT(L,3) + ST4 = ONE - ALFINT(L,4) + ST5 = ONE - ALFIND(L) + HB = ALFINT(L,1)*HOL(LM1) + ST1*HOL(L) + QB = ALFINT(L,2)*QOL(LM1) + ST2*QOL(L) + + TEM = ALFINT(L,4)*CIL(LM1) + ST4*CIL(L) + TEM2 = ALFINT(L,3)*CLL(LM1) + ST3*CLL(L) + + TEM1 = ETA(L) * (TEM - CIL(L)) + TEM3 = ETA(L) * (TEM2 - CLL(L)) + + HBD = ALFIND(L)*HOL(LM1) + ST5*HOL(L) + QBD = ALFIND(L)*QOL(LM1) + ST5*QOL(L) + + TEM5 = ETD(L) * (HOD(L) - HBD) + TEM6 = ETD(L) * (QOD(L) - QBD) +! + DH = ETA(L) * (HB - HOL(L)) + TEM5 + DS = DH - ALHL * (ETA(L) * (QB - QOL(L)) + TEM6) + + GMH(L) = DH * PRI(L) + GMS(L) = DS * PRI(L) + +! + GHD(L) = TEM5 * PRI(L) + GSD(L) = (TEM5 - ALHL * TEM6) * PRI(L) +! + QLL(L) = (TEM3 + (one-QIL(L))*dlq(l)) * PRI(L) + QIL(L) = (TEM1 + QIL(L)*dlq(l)) * PRI(L) + + TEM1 = ETA(L) * (CIL(LM1) - TEM) + TEM3 = ETA(L) * (CLL(LM1) - TEM2) + + DH = ETA(L) * (HOL(LM1) - HB) - TEM5 + DS = DH - ALHL * ETA(L) * (QOL(LM1) - QB) & + & + ALHL * (TEM6 - EVP(LM1)) + + GMH(LM1) = GMH(LM1) + DH * PRI(LM1) + GMS(LM1) = GMS(LM1) + DS * PRI(LM1) +! + GHD(LM1) = GHD(LM1) - TEM5 * PRI(LM1) + GSD(LM1) = GSD(LM1) - (TEM5-ALHL*(TEM6-EVP(LM1))) * PRI(LM1) + + QIL(LM1) = QIL(LM1) + TEM1 * PRI(LM1) + QLL(LM1) = QLL(LM1) + TEM3 * PRI(LM1) +! + avh = avh + gmh(lm1)*(prs(l)-prs(lm1)) + + ENDDO +! + HBD = HOL(K) + QBD = QOL(K) + TEM5 = ETD(KP1) * (HOD(KP1) - HBD) + TEM6 = ETD(KP1) * (QOD(KP1) - QBD) + DH = - TEM5 + DS = DH + ALHL * TEM6 + TEM1 = DH * PRI(K) + TEM2 = (DS - ALHL * EVP(K)) * PRI(K) + GMH(K) = GMH(K) + TEM1 + GMS(K) = GMS(K) + TEM2 + GHD(K) = GHD(K) + TEM1 + GSD(K) = GSD(K) + TEM2 + +! + avh = avh + gmh(K)*(prs(KP1)-prs(K)) +! + tem4 = - GRAVFAC * pris + TX1 = DH * tem4 + TX2 = DS * tem4 +! + DO L=KBL,K + GMH(L) = GMH(L) + TX1 + GMS(L) = GMS(L) + TX2 + GHD(L) = GHD(L) + TX1 + GSD(L) = GSD(L) + TX2 +! + avh = avh + tx1*(prs(l+1)-prs(l)) + ENDDO + +! +!*********************************************************************** +!*********************************************************************** + +!===> KERNEL (AKM) CALCULATION BEGINS + +!===> MODIFY SOUNDING WITH UNIT MASS FLUX +! + DO L=KD,K + + TEM1 = GMH(L) + TEM2 = GMS(L) + HOL(L) = HOL(L) + TEM1*TESTMB + QOL(L) = QOL(L) + (TEM1-TEM2) * TESTMBOALHL + HST(L) = HST(L) + TEM2*(ONE+GAM(L))*TESTMB + QST(L) = QST(L) + TEM2*GAM(L) * TESTMBOALHL + CLL(L) = CLL(L) + QLL(L) * TESTMB + CIL(L) = CIL(L) + QIL(L) * TESTMB + ENDDO +! + if (alm > zero) then + HOS = HOS + GMH(KD) * TESTMB + QOS = QOS + (GMH(KD)-GMS(KD)) * TESTMBOALHL + QLS = QLS + QLL(KD) * TESTMB + QIS = QIS + QIL(KD) * TESTMB + else + st2 = one - st1s + HOS = HOS + (st1s*GMH(KD)+st2*GMH(KD1)) * TESTMB + QOS = QOS + (st1s * (GMH(KD)-GMS(KD)) & + & + st2 * (GMH(KD1)-GMS(KD1))) * TESTMBOALHL + HST(kd) = HST(kd) + (st1s*GMS(kd)*(ONE+GAM(kd)) & + & + st2*gms(kd1)*(ONE+GAM(kd1))) * TESTMB + QST(kd) = QST(kd) + (st1s*GMS(kd)*GAM(kd) & + & + st2*gms(kd1)*gam(kd1)) * TESTMBOALHL + + QLS = QLS + (st1s*QLL(KD)+st2*QLL(KD1)) * TESTMB + QIS = QIS + (st1s*QIL(KD)+st2*QIL(KD1)) * TESTMB + endif + +! + TEM = PRL(Kmaxp1) - PRL(Kmax) + HBL = HOL(Kmax) * TEM + QBL = QOL(Kmax) * TEM + QLB = CLL(Kmax) * TEM + QIB = CIL(Kmax) * TEM + DO L=KmaxM1,KBL,-1 + TEM = PRL(L+1) - PRL(L) + HBL = HBL + HOL(L) * TEM + QBL = QBL + QOL(L) * TEM + QLB = QLB + CLL(L) * TEM + QIB = QIB + CIL(L) * TEM + ENDDO + HBL = HBL * PRISM + QBL = QBL * PRISM + QLB = QLB * PRISM + QIB = QIB * PRISM + +! if (ctei .and. sgcs(kd) > 0.65) then +! hbl = hbl * hpert_fac +! qbl = qbl * hpert_fac +! endif + + +!*********************************************************************** + +!===> CLOUD WORKFUNCTION FOR MODIFIED SOUNDING, THEN KERNEL (AKM) +! + AKM = ZERO + TX1 = ZERO + QTL = QST(KB1) - GAF(KB1)*HST(KB1) + QTV = QBL + HCC = HBL + TX2 = HCC + TX4 = (ALHF*half)*MAX(ZERO,MIN(ONE,(TCR-TCL-TOL(KB1))*TCRF)) +! + qtv = qbl + tx1 = qib + qlb +! + + DO L=KB1,KD1,-1 + lm1 = l - 1 + lp1 = l + 1 + DEL_ETA = ETA(L) - ETA(LP1) + HCCP = HCC + DEL_ETA*HOL(L) +! + QTLP = QST(LM1) - GAF(LM1)*HST(LM1) + QTVP = half * ((QTLP+QTL)*ETA(L) + (GAF(L)+GAF(LM1))*HCCP) + + DETP = (BKC(L)*TX1 - (QTVP-QTV) & + & + DEL_ETA*(QOL(L)+CLL(L)+CIL(L)) & + & + ETA(L)*Q0U(L) + ETA(LP1)*Q0D(L)) * AKC(L) + IF (DETP <= ZERO) cnvflg = .TRUE. + + ST1 = HST(L) - LTL(L)*NU*(QST(L)-QOL(L)) + + TEM2 = (ALHF*half)*MAX(ZERO,MIN(ONE,(TCR-TCL-TOL(LM1))*TCRF)) + TEM1 = HCCP + DETP * (TEM2+TX4) + + ST2 = LTL(L) * VTF(L) + TEM5 = CLL(L) + CIL(L) + AKM = AKM + & + & ( (TX2 -ETA(LP1)*ST1-ST2*(TX1-TEM5*eta(lp1))) * DLB(L) & + & + (TEM1 -ETA(L )*ST1-ST2*(DETP-TEM5*eta(l))) * DLT(L) ) +! + HCC = HCCP + TX1 = DETP + TX2 = TEM1 + QTL = QTLP + QTV = QTVP + TX4 = TEM2 + ENDDO +! + if (cnvflg) return +! +! Eventhough we ignore the change in lambda, we still assume +! that the cLoud-top contribution is zero; as though we still +! had non-bouyancy there. +! +! + ST1 = HST(KD) - LTL(KD)*NU*(QST(KD)-QOS) + ST2 = LTL(KD) * VTF(KD) + TEM5 = (QLS + QIS) * eta(kd1) + AKM = AKM + HALF * (TX2-ETA(KD1)*ST1-ST2*(TX1-TEM5)) * DLB(KD) +! + AKM = (AKM - WFN) * TESTMBI + + +!*********************************************************************** + +!===> MASS FLUX +! + AMB = - (WFN-ACR) / AKM +! +!===> RELAXATION AND CLIPPING FACTORS +! + AMB = AMB * CLP * rel_fac + +!!! if (DDFT) AMB = MIN(AMB, ONE/CLDFRD) + +!===> SUB-CLOUD LAYER DEPTH LIMIT ON MASS FLUX + + AMBMAX = (PRL(KMAXP1)-PRL(KBL))*(FRACBL*GRAVCON) + AMB = MAX(MIN(AMB, AMBMAX),ZERO) + + +!*********************************************************************** +!*************************RESULTS*************************************** +!*********************************************************************** + +!===> PRECIPITATION AND CLW DETRAINMENT +! + if (amb > zero) then + +! +! if (wvl(kd) > zero) then +! tx1 = one - amb * eta(kd) / (rho(kd)*wvl(kd)) +! sigf(kd) = max(zero, min(one, tx1 * tx1)) +! endif + if (do_aw) then + tx1 = (0.2 / max(alm, 1.0e-5)) + tx2 = one - min(one, pi * tx1 * tx1 / area) + + tx2 = tx2 * tx2 + +! comnet out the following for now - 07/23/18 +! do l=kd1,kbl +! lp1 = min(K, l+1) +! if (wvl(l) > zero .and. wvl(lp1) > zero) then +! tx1 = one - amb * (eta(l)+eta(lp1)) +! & / ((wvl(l)+wvl(lp1))*rho(l)*grav) +! sigf(l) = max(zero, min(one, tx1 * tx1)) +! else +! sigf(l) = min(one,tx2) +! endif +! sigf(l) = max(sigf(l), tx2) +! enddo +! sigf(kd) = sigf(kd1) +! if (kbl < k) then +! sigf(kbl+1:k) = sigf(kbl) +! endif + sigf(kd:k) = tx2 + else + sigf(kd:k) = one + endif +! + avt = zero + avq = zero + avr = dof * sigf(kbl) +! + DSFC = DSFC + AMB * ETD(K) * (one/DT) * sigf(kbl) +! + DO L=K,KD,-1 + PCU(L) = PCU(L) + AMB*RNN(L)*sigf(l) ! (A40) + avr = avr + rnn(l) * sigf(l) + ENDDO + pcu(k) = pcu(k) + amb * dof * sigf(kbl) +! +!===> TEMPARATURE AND Q CHANGE AND CLOUD MASS FLUX DUE TO CLOUD TYPE KD +! + TX1 = AMB * ONEBCP + TX2 = AMB * ONEOALHL + DO L=KD,K + delp = prs(l+1) - prs(l) + tx3 = amb * sigf(l) + ST1 = GMS(L) * TX1 * sigf(l) + TOI(L) = TOI(L) + ST1 + TCU(L) = TCU(L) + ST1 + TCD(L) = TCD(L) + GSD(L) * TX1 * sigf(l) +! + st1 = st1 - ELOCP * (QIL(L) + QLL(L)) * tx3 + + avt = avt + st1 * delp + + FLX(L) = FLX(L) + ETA(L) * tx3 + FLXD(L) = FLXD(L) + ETD(L) * tx3 +! + QII(L) = QII(L) + QIL(L) * tx3 + TEM = zero + + QLI(L) = QLI(L) + QLL(L) * tx3 + TEM + + ST1 = (GMH(L)-GMS(L)) * TX2 * sigf(l) + + QOI(L) = QOI(L) + ST1 + QCU(L) = QCU(L) + ST1 + QCD(L) = QCD(L) + (GHD(L)-GSD(L)) * TX2 * sigf(l) +! + avq = avq + (st1 + (QLL(L)+QIL(L))*tx3) * delp +! avq = avq + st1 * (prs(l+1)-prs(l)) +! avr = avr + (QLL(L) + QIL(L)*(1+alhf/alhl)) + avr = avr + (QLL(L) + QIL(L)) * delp * sigf(l) * gravcon + +! Correction for negative condensate! + if (qii(l) < zero) then + tem = qii(l) * elfocp + QOI(L) = QOI(L) + qii(l) + qcu(l) = qcu(l) + qii(l) + toi(l) = toi(l) - tem + tcu(l) = tcu(l) - tem + qii(l) = zero + endif + if (qli(l) < zero) then + tem = qli(l) * elocp + QOI(L) = QOI(L) + qli(l) + qcu(l) = qcu(l) + qli(l) + toi(l) = toi(l) - tem + tcu(l) = tcu(l) - tem + qli(l) = zero + endif + + ENDDO + avr = avr * amb +! +! Correction for negative condensate! +! if (advcld) then +! do l=kd,k +! if (qli(l) < zero) then +! qoi(l) = qoi(l) + qli(l) +! toi(l) = toi(l) - (alhl/cp) * qli(l) +! qli(l) = zero +! endif +! if (qii(l) < zero) then +! qoi(l) = qoi(l) + qii(l) +! toi(l) = toi(l) - ((alhl+alhf)/cp) * qii(l) +! qii(l) = zero +! endif +! enddo +! endif + +! +! + TX1 = zero + TX2 = zero +! + IF (REVAP) THEN ! REEVAPORATION OF FALLING CONVECTIVE RAIN +! + tem = zero + do l=kd,kbl + IF (L < IDH .or. (.not. DDFT)) THEN + tem = tem + amb * rnn(l) * sigf(l) + endif + enddo + tem = tem + amb * dof * sigf(kbl) + tem = tem * (3600.0/dt) + tem1 = sqrt(max(one, min(100.0,(6.25E10/max(area,one))))) ! 20110530 + + clfrac = max(ZERO, min(half, rknob*clf(tem)*tem1)) + + DO L=KD,KBL ! Testing on 20070926 +! for L=KD,K + IF (L >= IDH .AND. DDFT) THEN + tem = amb * sigf(l) + TX2 = TX2 + tem * RNN(L) + CLDFRD = MIN(tem*CLDFR(L), clfrac) + ELSE + TX1 = TX1 + AMB * RNN(L) * sigf(l) + ENDIF + tx4 = zfac * phil(l) + tx4 = (one - tx4 * (one - half*tx4)) * afc +! + IF (TX1 > zero .OR. TX2 > zero) THEN + TEQ = TOI(L) + QEQ = QOI(L) + PL = half * (PRL(L+1)+PRL(L)) + + ST1 = MAX(ZERO, MIN(ONE, (TCR-TEQ)*TCRF)) + ST2 = ST1*ELFOCP + (one-ST1)*ELOCP + + CALL QSATCN ( TEQ,PL,QSTEQ,DQDT) +! + DELTAQ = half * (QSTEQ*rhc_ls(l)-QEQ) / (one+ST2*DQDT) +! + QEQ = QEQ + DELTAQ + TEQ = TEQ - DELTAQ*ST2 +! + TEM1 = MAX(ZERO, MIN(ONE, (TCR-TEQ)*TCRF)) + TEM2 = TEM1*ELFOCP + (one-TEM1)*ELOCP + + CALL QSATCN ( TEQ,PL,QSTEQ,DQDT) +! + DELTAQ = (QSTEQ*rhc_ls(l)-QEQ) / (one+TEM2*DQDT) +! + QEQ = QEQ + DELTAQ + TEQ = TEQ - DELTAQ*TEM2 + + IF (QEQ > QOI(L)) THEN + POTEVAP = (QEQ-QOI(L))*(PRL(L+1)-PRL(L))*GRAVCON + + tem4 = zero + if (tx1 > zero) & + & TEM4 = POTEVAP * (one - EXP( tx4*TX1**0.57777778 ) ) + ACTEVAP = MIN(TX1, TEM4*CLFRAC) + + + if (tx1 < rainmin*dt) actevap = min(tx1, potevap) +! + tem4 = zero + if (tx2 > zero) & + & TEM4 = POTEVAP * (one - EXP( tx4*TX2**0.57777778 ) ) + TEM4 = min(MIN(TX2, TEM4*CLDFRD), potevap-actevap) + if (tx2 < rainmin*dt) tem4 = min(tx2, potevap-actevap) +! + TX1 = TX1 - ACTEVAP + TX2 = TX2 - TEM4 + ST1 = (ACTEVAP+TEM4) * PRI(L) + QOI(L) = QOI(L) + ST1 + QCU(L) = QCU(L) + ST1 +! + + ST1 = ST1 * ELOCP + TOI(L) = TOI(L) - ST1 + TCU(L) = TCU(L) - ST1 + ENDIF + ENDIF + ENDDO +! + CUP = CUP + TX1 + TX2 + DOF * AMB * sigf(kbl) + ELSE + DO L=KD,K + TX1 = TX1 + AMB * RNN(L) * sigf(l) + ENDDO + CUP = CUP + TX1 + DOF * AMB * sigf(kbl) + ENDIF + +! +! Convective transport (mixing) of passive tracers +! + if (NTRC > 0) then + do l=kd,km1 + if (etz(l) /= zero) etzi(l) = one / etz(l) + enddo + DO N=1,NTRC ! Tracer loop ; first two are u and v + + DO L=KD,K + HOL(L) = ROI(L,N) + ENDDO +! + HCC = RBL(N) + HOD(KD) = HOL(KD) +! Compute downdraft properties for the tracer + DO L=KD1,K + lm1 = l - 1 + ST1 = ONE - ALFIND(L) + HB = ALFIND(L) * HOL(LM1) + ST1 * HOL(L) + IF (ETZ(LM1) /= ZERO) THEN + TEM = ETZI(LM1) + IF (ETD(L) > ETD(LM1)) THEN + HOD(L) = (ETD(LM1)*(HOD(LM1)-HOL(LM1)) & + & + ETD(L) *(HOL(LM1)-HB) + ETZ(LM1)*HB) * TEM + ELSE + HOD(L) = (ETD(LM1)*(HOD(LM1)-HB) + ETZ(LM1)*HB) * TEM + ENDIF + ELSE + HOD(L) = HB + ENDIF + ENDDO + + DO L=KB1,KD,-1 + HCC = HCC + (ETA(L)-ETA(L+1))*HOL(L) + ENDDO +! +! Scavenging -- fscav - fraction scavenged [km-1] +! delz - distance from the entrainment to detrainment layer [km] +! fnoscav - the fraction not scavenged +! following Liu et al. [JGR,2001] Eq 1 + + if (FSCAV_(N) > zero) then + DELZKM = ( PHIL(KD) - PHIH(KD1) ) *(onebg*0.001) + FNOSCAV = exp(- FSCAV_(N) * DELZKM) + else + FNOSCAV = one + endif + + GMH(KD) = PRI(KD) * (HCC-ETA(KD)*HOL(KD)) * trcfac(kd,n) & + & * FNOSCAV + DO L=KD1,K + if (FSCAV_(N) > zero) then + DELZKM = ( PHIL(KD) - PHIH(L+1) ) *(onebg*0.001) + FNOSCAV = exp(- FSCAV_(N) * DELZKM) + endif + lm1 = l - 1 + ST1 = ONE - ALFINT(L,N+4) + ST2 = ONE - ALFIND(L) + HB = ALFINT(L,N+4) * HOL(LM1) + ST1 * HOL(L) + HBD = ALFIND(L) * HOL(LM1) + ST2 * HOL(L) + TEM5 = ETD(L) * (HOD(L) - HBD) + DH = ETA(L) * (HB - HOL(L)) * FNOSCAV + TEM5 + GMH(L ) = DH * PRI(L) * trcfac(l,n) + DH = ETA(L) * (HOL(LM1) - HB) * FNOSCAV - TEM5 + GMH(LM1) = GMH(LM1) + DH * PRI(LM1) * trcfac(l,n) + ENDDO +! + st2 = zero + DO L=KD,K + ST1 = GMH(L)*AMB*sigf(l) + st2 + st3 = HOL(L) + st1 + st2 = st3 - trcmin(n) ! if trcmin is defined limit change + if (st2 < zero) then + ROI(L,N) = trcmin(n) + RCU(L,N) = RCU(L,N) + ST1 + if (l < k) & + & st2 = st2 * (prl(l+1)-prl(l))*pri(l+1) * (cmb2pa/grav) + else + ROI(L,N) = ST3 + RCU(L,N) = RCU(L,N) + ST1 + st2 = zero + endif + + ENDDO + ENDDO ! Tracer loop NTRC + endif + endif ! amb > zero + + RETURN + end subroutine cloud + + SUBROUTINE DDRFT( & + & K, KP1, KD & + &, TLA, ALFIND, wcbase & + &, TOL, QOL, HOL, PRL, QST, HST, GAM, GAF & +! &, TOL, QOL, HOL, PRL, QST, HST, GAM, GAF, HBL, QBL& + &, QRB, QRT, BUY, KBL, IDH, ETA, RNN, ETAI & + &, ALM, WFN, TRAIN, DDFT & + &, ETD, HOD, QOD, EVP, DOF, CLDFRD, WCB & + &, GMS, GSD, GHD, wvlu) + +! +!*********************************************************************** +!******************** Cumulus Downdraft Subroutine ********************* +!****************** Based on Cheng and Arakawa (1997) ****** ********** +!************************ SUBROUTINE DDRFT **************************** +!************************* October 2004 ****************************** +!*********************************************************************** +!*********************************************************************** +!************* Shrinivas.Moorthi@noaa.gov (301) 683-3718 *************** +!*********************************************************************** +!*********************************************************************** +!23456789012345678901234567890123456789012345678901234567890123456789012 +! +!===> TOL(K) INPUT TEMPERATURE KELVIN +!===> QOL(K) INPUT SPECIFIC HUMIDITY NON-DIMENSIONAL + +!===> PRL(KP1) INPUT PRESSURE @ EDGES MB + +!===> K INPUT THE RISE & THE INDEX OF THE SUBCLOUD LAYER +!===> KD INPUT DETRAINMENT LEVEL ( 1<= KD < K ) +! + IMPLICIT NONE +! +! INPUT ARGUMENTS +! + INTEGER K, KP1, KD, KBL + real(kind=kind_phys) ALFIND(K), wcbase + + real(kind=kind_phys), dimension(kd:k) :: HOL, QOL, HST, QST & + &, TOL, QRB, QRT, RNN & + &, RNS, ETAI + real(kind=kind_phys), dimension(kd:kp1) :: GAF, BUY, GAM, ETA & + &, PRL +! +! real(kind=kind_phys) HBL, QBL, PRIS & +! &, TRAIN, WFN, ALM +! +! TEMPORARY WORK SPACE +! + real(kind=kind_phys), dimension(KD:K) :: RNF, WCB, EVP, STLT & + &, GHD, GSD, CLDFRD & + &, GQW, QRPI, QRPS, BUD + + real(kind=kind_phys), dimension(KD:KP1) :: QRP, WVL, WVLU, ETD & + &, HOD, QOD, ROR, GMS + + real(kind=kind_phys) TL, PL, QL, QS, DQS, ST1 & + &, QQQ, DEL_ETA, HB, QB, TB & + &, TEM, TEM1, TEM2, TEM3, TEM4, ST2 & + &, ERRMIN, ERRMI2, ERRH, ERRW, ERRE, TEM5 & + &, TEM6, HBD, QBD, TX1, TX2, TX3 & + &, TX4, TX5, TX6, TX7, TX8, TX9 & + &, WFN, ALM, AL2 & + &, TRAIN, GMF, ONPG, CTLA, VTRM & + &, RPART, QRMIN, AA1, BB1, CC1, DD1 & +! &, WC2MIN, WCMIN, WCBASE, F2, F3, F5 & + &, WC2MIN, WCMIN, F2, F3, F5 & + &, GMF1, GMF5, QRAF, QRBF, del_tla & + &, TLA, STLA, CTL2, CTL3 & +! &, TLA, STLA, CTL2, CTL3, ASIN & +! &, RNT, RNB, ERRQ, RNTP, QRPF, VTPF & + &, RNT, RNB, ERRQ, RNTP & + &, EDZ, DDZ, CE, QHS, FAC, FACG & + &, RSUM1, RSUM2, RSUM3, CEE, DOF, DOFW +! &, sialf + + INTEGER I, L, N, IX, KD1, II, kb1, IP1, JJ, ntla & + &, IT, KM1, KTEM, KK, KK1, LM1, LL, LP1 & + &, IDW, IDH, IDN(K), idnm, itr +! + parameter (ERRMIN=0.0001, ERRMI2=0.1*ERRMIN) +! parameter (ERRMIN=0.00001, ERRMI2=0.1*ERRMIN) +! +! real (kind=kind_phys), parameter :: PIINV=one/PI, pio2=half*pi +! + parameter (ONPG=one+half, GMF=one/ONPG, RPART=zero) +! parameter (ONPG=1.0+0.5, GMF=1.0/ONPG, RPART=1.0) +! parameter (ONPG=1.0+0.5, GMF=1.0/ONPG, RPART=0.5) +! PARAMETER (AA1=1.0, BB1=1.5, CC1=1.1, DD1=0.85, F3=CC1, F5=2.5) +! PARAMETER (AA1=2.0, BB1=1.5, CC1=1.1, DD1=0.85, F3=CC1, F5=2.5) + PARAMETER (AA1=1.0, BB1=1.0, CC1=1.0, DD1=1.0, F3=CC1, F5=1.0) + parameter (QRMIN=1.0E-6, WC2MIN=0.01, GMF1=GMF/AA1, GMF5=GMF/F5) +! parameter (QRMIN=1.0E-6, WC2MIN=1.00, GMF1=GMF/AA1, GMF5=GMF/F5) + parameter (WCMIN=sqrt(wc2min)) +! parameter (sialf=0.5) +! + integer, parameter :: itrmu=25, itrmd=25 & + &, itrmin=15, itrmnd=12, numtla=2 + +! uncentering for vvel in dd + real(kind=kind_phys), parameter :: ddunc1=0.25, ddunc2=one-ddunc1 & +! &, ddunc1=0.4, ddunc2=one-ddunc1 & +! &, ddunc1=0.3, ddunc2=one-ddunc1 & + &, VTPEXP=-0.3636 & + &, VTP=36.34*SQRT(1.2)*(0.001)**0.1364 +! +! real(kind=kind_phys) EM(K*K), ELM(K) + real(kind=kind_phys) ELM(K), AA(KD:K,KD:KP1), QW(KD:K,KD:K) & + &, VT(2), VRW(2), TRW(2), QA(3), WA(3) + + LOGICAL SKPUP, cnvflg, DDFT, UPDRET, DDLGK + +!*********************************************************************** + + + KD1 = KD + 1 + KM1 = K - 1 + KB1 = KBL - 1 +! +! VTP = 36.34*SQRT(1.2)* (0.001)**0.1364 +! VTPEXP = -0.3636 +! PIINV = 1.0 / PI +! PICON = PIO2 * ONEBG +! +! Compute Rain Water Budget of the Updraft (Cheng and Arakawa, 1997) +! + CLDFRD = zero + RNTP = zero + DOF = zero + ERRQ = 10.0 + RNB = zero + RNT = zero + TX2 = PRL(KBL) +! + TX1 = (PRL(KD) + PRL(KD1)) * half + ROR(KD) = CMPOR*TX1 / (TOL(KD)*(one+NU*QOL(KD))) +! GMS(KD) = VTP * ROR(KD) ** VTPEXP + GMS(KD) = VTP * VTPF(ROR(KD)) +! + QRP(KD) = QRMIN +! + TEM = TOL(K) * (one + NU * QOL(K)) + ROR(KP1) = half * CMPOR * (PRL(KP1)+PRL(K)) / TEM + GMS(KP1) = VTP * VTPF(ROR(KP1)) + QRP(KP1) = QRMIN +! + kk = kbl + DO L=KD1,K + TEM = half * (TOL(L)+TOL(L-1)) & + & * (one + (half*NU) * (QOL(L)+QOL(L-1))) + ROR(L) = CMPOR * PRL(L) / TEM +! GMS(L) = VTP * ROR(L) ** VTPEXP + GMS(L) = VTP * VTPF(ROR(L)) + QRP(L) = QRMIN + if (buy(l) <= zero .and. kk == KBL) then + kk = l + endif + ENDDO + if (kk /= kbl) then + do l=kk,kbl + buy(l) = 0.9 * buy(l-1) + enddo + endif +! + do l=kd,k + qrpi(l) = buy(l) + enddo + do l=kd1,kb1 + buy(l) = 0.25 * (qrpi(l-1)+qrpi(l)+qrpi(l)+qrpi(l+1)) + enddo + +! +! CALL ANGRAD(TX1, ALM, STLA, CTL2, AL2, PI, TLA, TX2, WFN, TX3) + tx1 = 1000.0 + tx1 - prl(kp1) +! CALL ANGRAD(TX1, ALM, AL2, TLA, TX2, WFN, TX3) + CALL ANGRAD(TX1, ALM, AL2, TLA) +! +! Following Ucla approach for rain profile +! + F2 = (BB1+BB1)*ONEBG/(PI*0.2) +! WCMIN = SQRT(WC2MIN) +! WCBASE = WCMIN +! +! del_tla = TLA * 0.2 +! del_tla = TLA * 0.25 + del_tla = TLA * 0.3 + TLA = TLA - DEL_TLA +! + DO L=KD,K + RNF(L) = zero + RNS(L) = zero + STLT(L) = zero + GQW(L) = zero + QRP(L) = QRMIN + DO N=KD,K + QW(N,L) = zero + ENDDO + ENDDO +! DO L=KD,KP1 +! WVL(L) = zero +! ENDDO +! +!-----QW(N,L) = D(W(N)*W(N))/DQR(L) +! + KK = KBL + QW(KD,KD) = -QRB(KD) * GMF1 + GHD(KD) = ETA(KD) * ETA(KD) + GQW(KD) = QW(KD,KD) * GHD(KD) + GSD(KD) = ETAI(KD) * ETAI(KD) +! + GQW(KK) = - QRB(KK-1) * (GMF1+GMF1) +! + WCB(KK) = WCBASE * WCBASE + + TX1 = WCB(KK) + GSD(KK) = one + GHD(KK) = one +! + TEM = GMF1 + GMF1 + DO L=KB1,KD1,-1 + GHD(L) = ETA(L) * ETA(L) + GSD(L) = ETAI(L) * ETAI(L) + GQW(L) = - GHD(L) * (QRB(L-1)+QRT(L)) * TEM + QW(L,L) = - QRT(L) * TEM +! + st1 = half * (eta(l) + eta(l+1)) + TX1 = TX1 + BUY(L) * TEM * (qrb(l)+qrt(l)) * st1 * st1 + WCB(L) = TX1 * GSD(L) + ENDDO +! + TEM1 = (QRB(KD) + QRT(KD1) + QRT(KD1)) * GMF1 + GQW(KD1) = - GHD(KD1) * TEM1 + QW(KD1,KD1) = - QRT(KD1) * TEM + st1 = half * (eta(kd) + eta(kd1)) + WCB(KD) = (TX1 + BUY(KD)*TEM*qrb(kd)*st1*st1) * GSD(KD) +! + DO L=KD1,KBL + DO N=KD,L-1 + QW(N,L) = GQW(L) * GSD(N) + ENDDO + ENDDO + QW(KBL,KBL) = zero +! + do ntla=1,numtla ! numtla is the the maximimu number of tilting angle tries + ! ------ +! if (errq < 1.0 .or. tla > 45.0) cycle + if (errq < 0.1 .or. tla > 45.0) cycle +! + tla = tla + del_tla + STLA = SIN(TLA*deg2rad) ! sine of tilting angle + CTL2 = one - STLA * STLA ! cosine square of tilting angle +! + STLA = F2 * STLA * AL2 + CTL2 = DD1 * CTL2 + CTL3 = 0.1364 * CTL2 +! + DO L=KD,K + RNF(L) = zero + STLT(L) = zero + QRP(L) = QRMIN + ENDDO + DO L=KD,KP1 + WVL(L) = zero + ENDDO + WVL(KBL) = WCBASE + STLT(KBL) = one / WCBASE +! + DO L=KD,KP1 + DO N=KD,K + AA(N,L) = zero + ENDDO + ENDDO +! + SKPUP = .FALSE. +! + DO ITR=1,ITRMU ! Rain Profile Iteration starts! + IF (.NOT. SKPUP) THEN +! wvlu = wvl +! +!-----CALCULATING THE VERTICAL VELOCITY +! + TX1 = zero + QRPI(KBL) = one / QRP(KBL) + DO L=KB1,KD,-1 + TX1 = TX1 + QRP(L+1)*GQW(L+1) + ST1 = WCB(L) + QW(L,L)*QRP(L) + TX1*GSD(L) +! if (st1 > wc2min) then + if (st1 > zero) then + WVL(L) = max(ddunc1*SQRT(ST1) + ddunc2*WVL(L), wcmin) +! WVL(L) = SQRT(ST1) +! WVL(L) = max(half * (SQRT(ST1) + WVL(L)), wcmin) +! qrp(l) = half*((wvl(l)*wvl(l)-wcb(l)-tx1*gsd(l))/qw(l,l)& +! & + qrp(l)) + else + +! wvl(l) = 0.5*(wcmin+wvl(l)) +! wvl(l) = max(half*(wvl(l) + wvl(l+1)), wcmin) + wvl(l) = max(wvl(l),wcmin) + qrp(l) = (wvl(l)*wvl(l) - wcb(l) - tx1*gsd(l))/qw(l,l) +! qrp(l) = half*((wvl(l)*wvl(l)-wcb(l)-tx1*gsd(l))/qw(l,l)& +! & + qrp(l)) + endif + qrp(l) = max(qrp(l), qrmin) + + STLT(L) = one / WVL(L) + QRPI(L) = one / QRP(L) + ENDDO +! +!-----CALCULATING TRW, VRW AND OF +! +! VT(1) = GMS(KD) * QRP(KD)**0.1364 + VT(1) = GMS(KD) * QRPF(QRP(KD)) + TRW(1) = ETA(KD) * QRP(KD) * STLT(KD) + TX6 = TRW(1) * VT(1) + VRW(1) = F3*WVL(KD) - CTL2*VT(1) + BUD(KD) = STLA * TX6 * QRB(KD) * half + RNF(KD) = BUD(KD) + DOF = 1.1364 * BUD(KD) * QRPI(KD) + DOFW = -BUD(KD) * STLT(KD) +! + RNT = TRW(1) * VRW(1) + TX2 = zero + TX4 = zero + RNB = RNT + TX1 = half + TX8 = zero +! + IF (RNT >= zero) THEN + TX3 = (RNT-CTL3*TX6) * QRPI(KD) + TX5 = CTL2 * TX6 * STLT(KD) + ELSE + TX3 = zero + TX5 = zero + RNT = zero + RNB = zero + ENDIF +! + DO L=KD1,KB1 + KTEM = MAX(L-2, KD) + LL = L - 1 +! +! VT(2) = GMS(L) * QRP(L)**0.1364 + VT(2) = GMS(L) * QRPF(QRP(L)) + TRW(2) = ETA(L) * QRP(L) * STLT(L) + VRW(2) = F3*WVL(L) - CTL2*VT(2) + QQQ = STLA * TRW(2) * VT(2) + ST1 = TX1 * QRB(LL) + BUD(L) = QQQ * (ST1 + QRT(L)) +! + QA(2) = DOF + WA(2) = DOFW + DOF = 1.1364 * BUD(L) * QRPI(L) + DOFW = -BUD(L) * STLT(L) +! + RNF(LL) = RNF(LL) + QQQ * ST1 + RNF(L) = QQQ * QRT(L) +! + TEM3 = VRW(1) + VRW(2) + TEM4 = TRW(1) + TRW(2) +! + TX6 = pt25 * TEM3 * TEM4 + TEM4 = TEM4 * CTL3 +! +!-----BY QR ABOVE +! +! TEM1 = pt25*(TRW(1)*TEM3 - TEM4*VT(1))*TX7 + TEM1 = pt25*(TRW(1)*TEM3 - TEM4*VT(1))*QRPI(LL) + ST1 = pt25*(TRW(1)*(CTL2*VT(1)-VRW(2)) & + & * STLT(LL) + F3*TRW(2)) +!-----BY QR BELOW + TEM2 = pt25*(TRW(2)*TEM3 - TEM4*VT(2))*QRPI(L) + ST2 = pt25*(TRW(2)*(CTL2*VT(2)-VRW(1)) & + & * STLT(L) + F3*TRW(1)) +! +! From top to the KBL-2 layer +! + QA(1) = TX2 + QA(2) = QA(2) + TX3 - TEM1 + QA(3) = -TEM2 +! + WA(1) = TX4 + WA(2) = WA(2) + TX5 - ST1 + WA(3) = -ST2 +! + TX2 = TEM1 + TX3 = TEM2 + TX4 = ST1 + TX5 = ST2 +! + VT(1) = VT(2) + TRW(1) = TRW(2) + VRW(1) = VRW(2) +! + IF (WVL(KTEM) == WCMIN) WA(1) = zero + IF (WVL(LL) == WCMIN) WA(2) = zero + IF (WVL(L) == WCMIN) WA(3) = zero + DO N=KTEM,KBL + AA(LL,N) = (WA(1)*QW(KTEM,N) * STLT(KTEM) & + & + WA(2)*QW(LL,N) * STLT(LL) & + & + WA(3)*QW(L,N) * STLT(L) ) * half + ENDDO + AA(LL,KTEM) = AA(LL,KTEM) + QA(1) + AA(LL,LL) = AA(LL,LL) + QA(2) + AA(LL,L) = AA(LL,L) + QA(3) + BUD(LL) = (TX8 + RNN(LL)) * half & + & - RNB + TX6 - BUD(LL) + AA(LL,KBL+1) = BUD(LL) + RNB = TX6 + TX1 = one + TX8 = RNN(LL) + ENDDO + L = KBL + LL = L - 1 +! VT(2) = GMS(L) * QRP(L)**0.1364 + VT(2) = GMS(L) * QRPF(QRP(L)) + TRW(2) = ETA(L) * QRP(L) * STLT(L) + VRW(2) = F3*WVL(L) - CTL2*VT(2) + ST1 = STLA * TRW(2) * VT(2) * QRB(LL) + BUD(L) = ST1 + + QA(2) = DOF + WA(2) = DOFW + DOF = 1.1364 * BUD(L) * QRPI(L) + DOFW = -BUD(L) * STLT(L) +! + RNF(LL) = RNF(LL) + ST1 +! + TEM3 = VRW(1) + VRW(2) + TEM4 = TRW(1) + TRW(2) +! + TX6 = pt25 * TEM3 * TEM4 + TEM4 = TEM4 * CTL3 +! +!-----BY QR ABOVE +! + TEM1 = pt25*(TRW(1)*TEM3 - TEM4*VT(1))*QRPI(LL) + ST1 = pt25*(TRW(1)*(CTL2*VT(1)-VRW(2)) & + & * STLT(LL) + F3*TRW(2)) +!-----BY QR BELOW + TEM2 = pt25*(TRW(2)*TEM3 - TEM4*VT(2))*QRPI(L) + ST2 = pt25*(TRW(2)*(CTL2*VT(2)-VRW(1)) & + & * STLT(L) + F3*TRW(1)) +! +! For the layer next to the top of the boundary layer +! + QA(1) = TX2 + QA(2) = QA(2) + TX3 - TEM1 + QA(3) = -TEM2 +! + WA(1) = TX4 + WA(2) = WA(2) + TX5 - ST1 + WA(3) = -ST2 +! + TX2 = TEM1 + TX3 = TEM2 + TX4 = ST1 + TX5 = ST2 +! + IDW = MAX(L-2, KD) +! + IF (WVL(IDW) == WCMIN) WA(1) = zero + IF (WVL(LL) == WCMIN) WA(2) = zero + IF (WVL(L) == WCMIN) WA(3) = zero +! + KK = IDW + DO N=KK,L + AA(LL,N) = (WA(1)*QW(KK,N) * STLT(KK) & + & + WA(2)*QW(LL,N) * STLT(LL) & + & + WA(3)*QW(L,N) * STLT(L) ) * half + + ENDDO +! + AA(LL,IDW) = AA(LL,IDW) + QA(1) + AA(LL,LL) = AA(LL,LL) + QA(2) + AA(LL,L) = AA(LL,L) + QA(3) + BUD(LL) = (TX8+RNN(LL)) * half - RNB + TX6 - BUD(LL) +! + AA(LL,L+1) = BUD(LL) +! + RNB = TRW(2) * VRW(2) +! +! For the top of the boundary layer +! + IF (RNB < zero) THEN + KK = KBL + TEM = VT(2) * TRW(2) + QA(2) = (RNB - CTL3*TEM) * QRPI(KK) + WA(2) = CTL2 * TEM * STLT(KK) + ELSE + RNB = zero + QA(2) = zero + WA(2) = zero + ENDIF +! + QA(1) = TX2 + QA(2) = DOF + TX3 - QA(2) + QA(3) = zero +! + WA(1) = TX4 + WA(2) = DOFW + TX5 - WA(2) + WA(3) = zero +! + KK = KBL + IF (WVL(KK-1) == WCMIN) WA(1) = zero + IF (WVL(KK) == WCMIN) WA(2) = zero +! + DO II=1,2 + N = KK + II - 2 + AA(KK,N) = (WA(1)*QW(KK-1,N) * STLT(KK-1) & + & + WA(2)*QW(KK,N) * STLT(KK)) * half + ENDDO + FAC = half + LL = KBL + L = LL + 1 + LM1 = LL - 1 + AA(LL,LM1) = AA(LL,LM1) + QA(1) + AA(LL,LL) = AA(LL,LL) + QA(2) + BUD(LL) = half*RNN(LM1) - TX6 + RNB - BUD(LL) + AA(LL,LL+1) = BUD(LL) +! +!-----SOLVING THE BUDGET EQUATIONS FOR DQR +! + DO L=KD1,KBL + LM1 = L - 1 + cnvflg = ABS(AA(LM1,LM1)) < ABS(AA(L,LM1)) + DO N=LM1,KBL+1 + IF (cnvflg) THEN + TX1 = AA(LM1,N) + AA(LM1,N) = AA(L,N) + AA(L,N) = TX1 + ENDIF + ENDDO + TX1 = AA(L,LM1) / AA(LM1,LM1) + DO N=L,KBL+1 + AA(L,N) = AA(L,N) - TX1 * AA(LM1,N) + ENDDO + ENDDO +! +!-----BACK SUBSTITUTION AND CHECK IF THE SOLUTION CONVERGES +! + KK = KBL + KK1 = KK + 1 + AA(KK,KK1) = AA(KK,KK1) / AA(KK,KK) ! Qr correction ! + TX2 = ABS(AA(KK,KK1)) * QRPI(KK) ! Error Measure ! +! + KK = KBL + 1 + DO L=KB1,KD,-1 + LP1 = L + 1 + TX1 = zero + DO N=LP1,KBL + TX1 = TX1 + AA(L,N) * AA(N,KK) + ENDDO + AA(L,KK) = (AA(L,KK) - TX1) / AA(L,L) ! Qr correction ! + TX2 = MAX(TX2, ABS(AA(L,KK))*QRPI(L)) ! Error Measure ! + ENDDO +! +! tem = 0.5 + if (tx2 > one .and. abs(errq-tx2) > 0.1) then + tem = half +!! elseif (tx2 < 0.1) then +!! tem = 1.2 + else + tem = one + endif +! + DO L=KD,KBL +! QRP(L) = MAX(QRP(L)+AA(L,KBL+1), QRMIN) + QRP(L) = MAX(QRP(L)+AA(L,KBL+1)*tem, QRMIN) + ENDDO +! + IF (ITR < ITRMIN) THEN + TEM = ABS(ERRQ-TX2) + IF (TEM >= ERRMI2 .AND. TX2 >= ERRMIN) THEN + ERRQ = TX2 ! Further iteration ! + ELSE + SKPUP = .TRUE. ! Converges ! + ERRQ = zero ! Rain profile exists! + ENDIF + ELSE + TEM = ERRQ - TX2 +! IF (TEM < ZERO .AND. ERRQ > 0.1) THEN + IF (TEM < ZERO .AND. ERRQ > 0.5) THEN +! IF (TEM < ZERO .and. & +! & (ntla < numtla .or. ERRQ > 0.5)) THEN + SKPUP = .TRUE. ! No convergence ! + ERRQ = 10.0 ! No rain profile! +!!!! ELSEIF (ABS(TEM) < ERRMI2 .OR. TX2 < ERRMIN) THEN + ELSEIF (TX2 < ERRMIN) THEN + SKPUP = .TRUE. ! Converges ! + ERRQ = zero ! Rain profile exists! + elseif (tem < zero .and. errq < 0.1) then + skpup = .true. +! if (ntla == numtla .or. tem > -0.003) then + errq = zero +! else +! errq = 10.0 +! endif + ELSE + ERRQ = TX2 ! Further iteration ! +! if (itr == itrmu .and. ERRQ > ERRMIN*10 & +! & .and. ntla == 1) ERRQ = 10.0 + ENDIF + ENDIF +! + ENDIF ! SKPUP ENDIF! +! + ENDDO ! End of the ITR Loop!! +! + IF (ERRQ < 0.1) THEN + DDFT = .TRUE. + RNB = - RNB +! do l=kd1,kb1-1 +! if (wvl(l)-wcbase < 1.0E-9) ddft = .false. +! enddo + ELSE + DDFT = .FALSE. + ENDIF + + enddo ! End of ntla loop +! +! Caution !! Below is an adjustment to rain flux to maintain +! conservation of precip! +! + IF (DDFT) THEN + TX1 = zero + DO L=KD,KB1 + TX1 = TX1 + RNF(L) + ENDDO + TX1 = TRAIN / (TX1+RNT+RNB) + IF (ABS(TX1-one) < 0.2) THEN + RNT = MAX(RNT*TX1,ZERO) + RNB = RNB * TX1 + DO L=KD,KB1 + RNF(L) = RNF(L) * TX1 + ENDDO +! rain flux adjustment is over + + ELSE + DDFT = .FALSE. + ERRQ = 10.0 + ENDIF + ENDIF +! + DOF = zero + IF (.NOT. DDFT) then + wvlu(kd:kp1) = zero + RETURN ! Rain profile did not converge! + ! No down draft for this case - rerurn + ! ------------------------------------ +! + else ! rain profile converged - do downdraft calculation + ! ------------------------------------------------ + + wvlu(kd:kp1) = wvl(kd:kp1) ! save updraft vertical velocity for output + +! +! Downdraft calculation begins +! ---------------------------- +! + DO L=KD,K + WCB(L) = zero + ENDDO +! + ERRQ = 10.0 +! At this point stlt contains inverse of updraft vertical velocity 1/Wu. + + KK = MAX(KB1,KD1) + DO L=KK,K + STLT(L) = STLT(L-1) + ENDDO + TEM = stla / BB1 ! this is 2/(pi*radius*grav) +! + DO L=KD,K + IF (L <= KBL) THEN + STLT(L) = ETA(L) * STLT(L) * TEM / ROR(L) + ELSE + STLT(L) = zero + ENDIF + ENDDO + + rsum1 = zero + rsum2 = zero +! + IDN(:) = idnmax + DO L=KD,KP1 + ETD(L) = zero + WVL(L) = zero +! QRP(L) = zero + ENDDO + DO L=KD,K + EVP(L) = zero + BUY(L) = zero + QRP(L+1) = zero + ENDDO + HOD(KD) = HOL(KD) + QOD(KD) = QOL(KD) + TX1 = zero +!!! TX1 = STLT(KD)*QRB(KD)*ONE ! sigma at the top +! TX1 = MIN(STLT(KD)*QRB(KD)*ONE, ONE) ! sigma at the top +! TX1 = MIN(STLT(KD)*QRB(KD)*0.5, ONE) ! sigma at the top + RNTP = zero + TX5 = TX1 + QA(1) = zero +! +! Here we assume RPART of detrained rain RNT goes to Pd +! + IF (RNT > zero) THEN + if (TX1 > zero) THEN + QRP(KD) = (RPART*RNT / (ROR(KD)*TX1*GMS(KD))) & + & ** (one/1.1364) + else + tx1 = RPART*RNT / (ROR(KD)*GMS(KD)*QRP(KD)**1.1364) + endif + RNTP = (one - RPART) * RNT + BUY(KD) = - ROR(KD) * TX1 * QRP(KD) + ELSE + QRP(KD) = zero + ENDIF +! +! L-loop for the downdraft iteration from KD1 to KP1 (bottom surface) +! +! BUD(KD) = ROR(KD) + idnm = 1 + DO L=KD1,KP1 + + QA(1) = zero + ddlgk = idn(idnm) == idnmax + if (.not. ddlgk) cycle + IF (L <= K) THEN + ST1 = one - ALFIND(L) + WA(1) = ALFIND(L)*HOL(L-1) + ST1*HOL(L) + WA(2) = ALFIND(L)*QOL(L-1) + ST1*QOL(L) + WA(3) = ALFIND(L)*TOL(L-1) + ST1*TOL(L) + QA(2) = ALFIND(L)*HST(L-1) + ST1*HST(L) + QA(3) = ALFIND(L)*QST(L-1) + ST1*QST(L) + ELSE + WA(1) = HOL(K) + WA(2) = QOL(K) + WA(3) = TOL(K) + QA(2) = HST(K) + QA(3) = QST(K) + ENDIF +! + FAC = two + IF (L == KD1) FAC = one + + FACG = FAC * half * GMF5 ! 12/17/97 +! +! DDLGK = IDN(idnm) == 99 + + BUD(KD) = ROR(L) + + TX1 = TX5 + WVL(L) = MAX(WVL(L-1),ONE_M1) + + QRP(L) = MAX(QRP(L-1),QRP(L)) +! +! VT(1) = GMS(L-1) * QRP(L-1) ** 0.1364 + VT(1) = GMS(L-1) * QRPF(QRP(L-1)) + RNT = ROR(L-1) * (WVL(L-1)+VT(1))*QRP(L-1) + +! + +! TEM = MAX(ALM, 2.5E-4) * MAX(ETA(L), 1.0) + TEM = MAX(ALM,ONE_M6) * MAX(ETA(L), ONE) +! TEM = MAX(ALM, 1.0E-5) * MAX(ETA(L), 1.0) + TRW(1) = PICON*TEM*(QRB(L-1)+QRT(L-1)) + TRW(2) = one / TRW(1) +! + VRW(1) = half * (GAM(L-1) + GAM(L)) + VRW(2) = one / (VRW(1) + VRW(1)) +! + TX4 = (QRT(L-1)+QRB(L-1))*(ONEBG*FAC*500.00*EKNOB) +! + DOFW = one / (WA(3) * (one + NU*WA(2))) ! 1.0 / TVbar! +! + ETD(L) = ETD(L-1) + HOD(L) = HOD(L-1) + QOD(L) = QOD(L-1) +! + ERRQ = 10.0 + +! + IF (L <= KBL) THEN + TX3 = STLT(L-1) * QRT(L-1) * (half*FAC) + TX8 = STLT(L) * QRB(L-1) * (half*FAC) + TX9 = TX8 + TX3 + ELSE + TX3 = zero + TX8 = zero + TX9 = zero + ENDIF +! + TEM = WVL(L-1) + VT(1) + IF (TEM > zero) THEN + TEM1 = one / (TEM*ROR(L-1)) + TX3 = VT(1) * TEM1 * ROR(L-1) * TX3 + TX6 = TX1 * TEM1 + ELSE + TX6 = one + ENDIF +! + IF (L == KD1) THEN + IF (RNT > zero) THEN + TEM = MAX(QRP(L-1),QRP(L)) + WVL(L) = TX1 * TEM * QRB(L-1)*(FACG*5.0) + ENDIF + WVL(L) = MAX(ONE_M2, WVL(L)) + TRW(1) = TRW(1) * half + TRW(2) = TRW(2) + TRW(2) + ELSE + IF (DDLGK) EVP(L-1) = EVP(L-2) + ENDIF +! +! No downdraft above level IDH +! + + IF (L < IDH) THEN + + ETD(L) = zero + HOD(L) = WA(1) + QOD(L) = WA(2) + EVP(L-1) = zero + WVL(L) = zero + QRP(L) = zero + BUY(L) = zero + TX5 = TX9 + ERRQ = zero + RNTP = RNTP + RNT * TX1 + RNT = zero + WCB(L-1) = zero + +! ENDIF +! BUD(KD) = ROR(L) +! +! Iteration loop for a given level L begins +! + else + DO ITR=1,ITRMD +! +! cnvflg = DDLGK .AND. (ERRQ > ERRMIN) + cnvflg = ERRQ > ERRMIN + IF (cnvflg) THEN +! +! VT(1) = GMS(L) * QRP(L) ** 0.1364 + VT(1) = GMS(L) * QRPF(QRP(L)) + TEM = WVL(L) + VT(1) +! + IF (TEM > zero) THEN + ST1 = ROR(L) * TEM * QRP(L) + RNT + IF (ST1 /= zero) ST1 = two * EVP(L-1) / ST1 + TEM1 = one / (TEM*ROR(L)) + TEM2 = VT(1) * TEM1 * ROR(L) * TX8 + ELSE + TEM1 = zero + TEM2 = TX8 + ST1 = zero + ENDIF +! + st2 = tx5 + TEM = ROR(L)*WVL(L) - ROR(L-1)*WVL(L-1) + if (tem > zero) then + TX5 = (TX1 - ST1 + TEM2 + TX3)/(one+tem*tem1) + else + TX5 = TX1 - tem*tx6 - ST1 + TEM2 + TX3 + endif + TX5 = MAX(TX5,ZERO) + tx5 = half * (tx5 + st2) +! +! qqq = 1.0 + tem * tem1 * (1.0 - sialf) +! +! if (qqq > 0.0) then +! TX5 = (TX1 - sialf*tem*tx6 - ST1 + TEM2 + TX3) / qqq +! else +! TX5 = (TX1 - tem*tx6 - ST1 + TEM2 + TX3) +! endif +! + TEM1 = ETD(L) + ETD(L) = ROR(L) * TX5 * MAX(WVL(L),ZERO) +! + if (etd(l) > zero) etd(l) = half * (etd(l) + tem1) +! + + DEL_ETA = ETD(L) - ETD(L-1) + +! TEM = DEL_ETA * TRW(2) +! TEM2 = MAX(MIN(TEM, 1.0), -1.0) +! IF (ABS(TEM) > 1.0 .AND. ETD(L) > 0.0 ) THEN +! DEL_ETA = TEM2 * TRW(1) +! ETD(L) = ETD(L-1) + DEL_ETA +! ENDIF +! IF (WVL(L) > 0.0) TX5 = ETD(L) / (ROR(L)*WVL(L)) +! + ERRE = ETD(L) - TEM1 +! + tem = max(abs(del_eta), trw(1)) + tem2 = del_eta / tem + TEM1 = SQRT(MAX((tem+DEL_ETA)*(tem-DEL_ETA),ZERO)) +! TEM1 = SQRT(MAX((TRW(1)+DEL_ETA)*(TRW(1)-DEL_ETA),0.0)) + + EDZ = (half + ASIN(TEM2)*PIINV)*DEL_ETA + TEM1*PIINV + + DDZ = EDZ - DEL_ETA + WCB(L-1) = ETD(L) + DDZ +! + TEM1 = HOD(L) + IF (DEL_ETA > zero) THEN + QQQ = one / (ETD(L) + DDZ) + HOD(L) = (ETD(L-1)*HOD(L-1) + DEL_ETA*HOL(L-1) & + & + DDZ*WA(1)) * QQQ + QOD(L) = (ETD(L-1)*QOD(L-1) + DEL_ETA*QOL(L-1) & + & + DDZ*WA(2)) * QQQ + ELSEif((ETD(L-1) + EDZ) > zero) then + QQQ = one / (ETD(L-1) + EDZ) + HOD(L) = (ETD(L-1)*HOD(L-1) + EDZ*WA(1)) * QQQ + QOD(L) = (ETD(L-1)*QOD(L-1) + EDZ*WA(2)) * QQQ + ENDIF + ERRH = HOD(L) - TEM1 + ERRQ = ABS(ERRH/HOD(L)) + ABS(ERRE/MAX(ETD(L),ONE_M5)) + DOF = DDZ + VT(2) = QQQ +! + DDZ = DOF + TEM4 = QOD(L) + TEM1 = VRW(1) +! + QHS = QA(3) + half * (GAF(L-1)+GAF(L)) * (HOD(L)-QA(2)) +! +! First iteration ! +! + ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) + TEM2 = ROR(L) * QRP(L) + CALL QRABF(TEM2,QRAF,QRBF) + TEM6 = TX5 * (1.6 + 124.9 * QRAF) * QRBF * TX4 +! + CE = TEM6 * ST2 / ((5.4E5*ST2 + 2.55E6)*(ETD(L)+DDZ)) +! + TEM2 = - ((one+TEM1)*(QHS+CE) + TEM1*QOD(L)) + TEM3 = (one + TEM1) * QHS * (QOD(L)+CE) + TEM = MAX(TEM2*TEM2 - four*TEM1*TEM3,ZERO) + QOD(L) = MAX(TEM4, (- TEM2 - SQRT(TEM)) * VRW(2)) +! +! +! second iteration ! +! + ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) + CE = TEM6 * ST2 / ((5.4E5*ST2 + 2.55E6)*(ETD(L)+DDZ)) +! CEE = CE * (ETD(L)+DDZ) +! + + + TEM2 = - ((one+TEM1)*(QHS+CE) + TEM1*tem4) + TEM3 = (one + TEM1) * QHS * (tem4+CE) + TEM = MAX(TEM2*TEM2 - four*TEM1*TEM3,ZERO) + QOD(L) = MAX(TEM4, (- TEM2 - SQRT(TEM)) * VRW(2)) +! Evaporation in Layer L-1 +! + EVP(L-1) = (QOD(L)-TEM4) * (ETD(L)+DDZ) +! Calculate Pd (L+1/2) + QA(1) = TX1*RNT + RNF(L-1) - EVP(L-1) +! + if (qa(1) > zero) then + IF (ETD(L) > zero) THEN + TEM = QA(1) / (ETD(L)+ROR(L)*TX5*VT(1)) + QRP(L) = MAX(TEM,ZERO) + ELSEIF (TX5 > zero) THEN + QRP(L) = (MAX(ZERO,QA(1)/(ROR(L)*TX5*GMS(L)))) & + & ** (one/1.1364) + ELSE + QRP(L) = zero + ENDIF + else + qrp(l) = half * qrp(l) + endif +! Compute Buoyancy + TEM1 = WA(3) + (HOD(L)-WA(1)-ALHL*(QOD(L)-WA(2))) & + & * onebcp + TEM1 = TEM1 * (one + NU*QOD(L)) + ROR(L) = CMPOR * PRL(L) / TEM1 + TEM1 = TEM1 * DOFW +!!! TEM1 = TEM1 * (1.0 + NU*QOD(L)) * DOFW + + BUY(L) = (TEM1 - one - QRP(L)) * ROR(L) * TX5 +! Compute W (L+1/2) + + TEM1 = WVL(L) + WVL(L) = VT(2) * (ETD(L-1)*WVL(L-1) - FACG & + & * (BUY(L-1)*QRT(L-1)+BUY(L)*QRB(L-1))) +! + if (wvl(l) < zero) then +! WVL(L) = max(wvl(l), 0.1*tem1) +! WVL(L) = 0.5*tem1 +! WVL(L) = 0.1*tem1 +! WVL(L) = 0.0 + WVL(L) = 1.0e-10 + else + WVL(L) = half*(WVL(L)+TEM1) + endif + +! +! WVL(L) = max(0.5*(WVL(L)+TEM1), 0.0) + + ERRW = WVL(L) - TEM1 +! + ERRQ = ERRQ + ABS(ERRW/MAX(WVL(L),ONE_M5)) + +! IF (ITR >= MIN(ITRMIN,ITRMD/2)) THEN + IF (ITR >= MIN(ITRMND,ITRMD/2)) THEN + IF (ETD(L-1) == zero .AND. ERRQ > 0.2) THEN + ROR(L) = BUD(KD) + ETD(L) = zero + WVL(L) = zero + ERRQ = zero + HOD(L) = WA(1) + QOD(L) = WA(2) +! TX5 = TX1 + TX9 + if (L <= KBL) then + TX5 = TX9 + else + TX5 = (STLT(KB1) * QRT(KB1) & + & + STLT(KBL) * QRB(KB1)) * (0.5*FAC) + endif + + EVP(L-1) = zero + TEM = MAX(TX1*RNT+RNF(L-1),ZERO) + QA(1) = TEM - EVP(L-1) +! IF (QA(1) > 0.0) THEN + + QRP(L) = (QA(1) / (ROR(L)*TX5*GMS(L))) & + & ** (one/1.1364) +! endif + BUY(L) = - ROR(L) * TX5 * QRP(L) + WCB(L-1) = zero + ENDIF +! + DEL_ETA = ETD(L) - ETD(L-1) + IF(DEL_ETA < zero .AND. ERRQ > 0.1) THEN + ROR(L) = BUD(KD) + ETD(L) = zero + WVL(L) = zero +!!!!! TX5 = TX1 + TX9 + CLDFRD(L-1) = TX5 +! + DEL_ETA = - ETD(L-1) + EDZ = zero + DDZ = -DEL_ETA + WCB(L-1) = DDZ +! + HOD(L) = HOD(L-1) + QOD(L) = QOD(L-1) +! + TEM4 = QOD(L) + TEM1 = VRW(1) +! + QHS = QA(3) + half * (GAF(L-1)+GAF(L)) & + & * (HOD(L)-QA(2)) + +! +! First iteration ! +! + ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) + TEM2 = ROR(L) * QRP(L-1) + CALL QRABF(TEM2,QRAF,QRBF) + TEM6 = TX5 * (1.6 + 124.9 * QRAF) * QRBF * TX4 +! + CE = TEM6*ST2/((5.4E5*ST2 + 2.55E6)*(ETD(L)+DDZ)) +! + + TEM2 = - ((one+TEM1)*(QHS+CE) + TEM1*QOD(L)) + TEM3 = (one + TEM1) * QHS * (QOD(L)+CE) + TEM = MAX(TEM2*TEM2 -FOUR*TEM1*TEM3,ZERO) + QOD(L) = MAX(TEM4, (- TEM2 - SQRT(TEM)) * VRW(2)) +! +! second iteration ! +! + ST2 = PRL(L) * (QHS + TEM1 * (QHS-QOD(L))) + CE = TEM6*ST2/((5.4E5*ST2 + 2.55E6)*(ETD(L)+DDZ)) +! CEE = CE * (ETD(L)+DDZ) +! + + + TEM2 = - ((one+TEM1)*(QHS+CE) + TEM1*tem4) + TEM3 = (one + TEM1) * QHS * (tem4+CE) + TEM = MAX(TEM2*TEM2 -FOUR*TEM1*TEM3,ZERO) + QOD(L) = MAX(TEM4, (- TEM2 - SQRT(TEM)) * VRW(2)) + +! Evaporation in Layer L-1 +! + EVP(L-1) = (QOD(L)-TEM4) * (ETD(L)+DDZ) + +! Calculate Pd (L+1/2) +! RNN(L-1) = TX1*RNT + RNF(L-1) - EVP(L-1) + + QA(1) = TX1*RNT + RNF(L-1) + EVP(L-1) = min(EVP(L-1), QA(1)) + QA(1) = QA(1) - EVP(L-1) + qrp(l) = zero + +! +! IF (QA(1) > 0.0) THEN +!! RNS(L-1) = QA(1) +!!! tx5 = tx9 +! QRP(L) = (QA(1) / (ROR(L)*TX5*GMS(L))) & +! & ** (1.0/1.1364) +! endif +! ERRQ = 0.0 +! Compute Buoyancy +! TEM1 = WA(3)+(HOD(L)-WA(1)-ALHL*(QOD(L)-WA(2))) & +! & * (1.0/CP) +! TEM1 = TEM1 * (1.0 + NU*QOD(L)) * DOFW +! BUY(L) = (TEM1 - 1.0 - QRP(L)) * ROR(L) * TX5 +! +! IF (QA(1) > 0.0) RNS(L) = QA(1) + + IF (L .LE. K) THEN + RNS(L) = QA(1) + QA(1) = zero + ENDIF + tx5 = tx9 + ERRQ = zero + QRP(L) = zero + BUY(L) = zero +! + ENDIF + ENDIF + ENDIF +! + ENDDO ! End of the iteration loop for a given L! + IF (L <= K) THEN + IF (ETD(L-1) == zero .AND. ERRQ > 0.1 .and. l <= kbl) THEN +!!! & .AND. ERRQ > ERRMIN*10.0 .and. l <= kbl) THEN +! & .AND. ERRQ > ERRMIN*10.0) THEN + ROR(L) = BUD(KD) + HOD(L) = WA(1) + QOD(L) = WA(2) + TX5 = TX9 ! Does not make too much difference! +! TX5 = TX1 + TX9 + EVP(L-1) = zero +! EVP(L-1) = CEE * (1.0 - qod(l)/qa(3)) + QA(1) = TX1*RNT + RNF(L-1) + EVP(L-1) = min(EVP(L-1), QA(1)) + QA(1) = QA(1) - EVP(L-1) + +! QRP(L) = 0.0 +! if (tx5 == 0.0 .or. gms(l) == 0.0) then +! write(0,*)' Ctx5=',tx5,' gms=',gms(l),' ror=',ror(l) & +! &, ' L=',L,' QA=',QA(1),' tx1=',tx1,' tx9=',tx9 & +! &, ' kbl=',kbl,' etd1=',etd(l-1),' DEL_ETA=',DEL_ETA +! endif +! IF (QA(1) > 0.0) THEN + + QRP(L) = (QA(1) / (ROR(L)*TX5*GMS(L))) & + & ** (one/1.1364) +! ENDIF + ETD(L) = zero + WVL(L) = zero + ST1 = one - ALFIND(L) + + ERRQ = zero + BUY(L) = - ROR(L) * TX5 * QRP(L) + WCB(L-1) = zero + ENDIF + ENDIF +! + LL = MIN(IDN(idnm), KP1) + IF (ERRQ < one .AND. L <= LL) THEN + IF (ETD(L-1) > zero .AND. ETD(L) == zero) THEN + IDN(idnm) = L + wvl(l) = zero + if (L < KBL .or. tx5 > zero) idnm = idnm + 1 + errq = zero + ENDIF + if (etd(l) == zero .and. l > kbl) then + idn(idnm) = l + if (tx5 > zero) idnm = idnm + 1 + endif + ENDIF + +! +! If downdraft properties are not obtainable, (i.e.solution does +! not converge) , no downdraft is assumed +! +! IF (ERRQ > ERRMIN*100.0 .AND. IDN(idnm) == 99) & + IF (ERRQ > 0.1 .AND. IDN(idnm) == idnmax) DDFT = .FALSE. +! + DOF = zero + IF (.NOT. DDFT) RETURN +! +! if (ddlgk .or. l .le. idn(idnm)) then +! rsum2 = rsum2 + evp(l-1) +! write(0,*)' rsum1=',rsum1,' rsum2=',rsum2,' L=',L,' qa=',qa(1)& +! &, ' evp=',evp(l-1) +! else +! rsum1 = rsum1 + rnf(l-1) +! write(0,*)' rsum1=',rsum1,' rsum2=',rsum2,' L=',L,' rnf=', & +! & rnf(l-1) +! endif + + endif ! if (l < idh) + ENDDO ! End of the L Loop of downdraft ! + + TX1 = zero + + DOF = QA(1) +! +! write(0,*)' dof=',dof,' rntp=',rntp,' rnb=',rnb +! write(0,*)' total=',(rsum1+dof+rntp+rnb) +! + dof = max(dof, zero) + RNN(KD) = RNTP + TX1 = EVP(KD) + TX2 = RNTP + RNB + DOF + + II = IDH + IF (II >= KD1+1) THEN + RNN(KD) = RNN(KD) + RNF(KD) + TX2 = TX2 + RNF(KD) + RNN(II-1) = zero + TX1 = EVP(II-1) + ENDIF + DO L=KD,K + II = IDH + + IF (L > KD1 .AND. L < II) THEN + RNN(L-1) = RNF(L-1) + TX2 = TX2 + RNN(L-1) + ELSEIF (L >= II .AND. L < IDN(idnm)) THEN + rnn(l) = rns(l) + tx2 = tx2 + rnn(l) + TX1 = TX1 + EVP(L) + ELSEIF (L >= IDN(idnm)) THEN + ETD(L+1) = zero + HOD(L+1) = zero + QOD(L+1) = zero + EVP(L) = zero + RNN(L) = RNF(L) + RNS(L) + TX2 = TX2 + RNN(L) + ENDIF + ENDDO +! +! For Downdraft case the rain is that falls thru the bottom + + L = KBL + + RNN(L) = RNN(L) + RNB + CLDFRD(L) = TX5 + +! +! Caution !! Below is an adjustment to rain flux to maintain +! conservation of precip! + +! + IF (TX1 > zero) THEN + TX1 = (TRAIN - TX2) / TX1 + ELSE + TX1 = zero + ENDIF + + DO L=KD,K + EVP(L) = EVP(L) * TX1 + ENDDO + + ENDIF ! if (.not. DDFT) loop endif +! +!*********************************************************************** +!*********************************************************************** + + RETURN + end subroutine ddrft + + SUBROUTINE QSATCN(TT,P,Q,DQDT) +! + USE FUNCPHYS , ONLY : fpvs + + implicit none +! + real(kind=kind_phys) TT, P, Q, DQDT +! +! real(kind=kind_phys), parameter :: ZERO=0.0, ONE=1.0 & +! &, rvi=one/rv, facw=CVAP-CLIQ & +! &, faci=CVAP-CSOL, hsub=alhl+alhf & +! &, tmix=TTP-20.0 & +! &, DEN=one/(TTP-TMIX) +! + real(kind=kind_phys) es, d, hlorv, W +! +! es = 10.0 * fpvs(tt) ! fpvs is in centibars! + es = min(p, 0.01 * fpvs(tt)) ! fpvs is in Pascals! +! D = one / max(p+epsm1*es,ONE_M10) + D = one / (p+epsm1*es) +! + q = MIN(eps*es*D, ONE) +! + W = max(ZERO, min(ONE, (TT - TMIX)*DEN)) + hlorv = ( W * (alhl + FACW * (tt-ttp)) & + & + (one-W) * (hsub + FACI * (tt-ttp)) ) * RVI + dqdt = p * q * hlorv * D / (tt*tt) +! + return + end subroutine qsatcn + + SUBROUTINE ANGRAD(PRES, ALM, AL2, TLA) + implicit none + + real(kind=kind_phys) PRES, ALM, AL2, TLA, TEM +! + integer i +! + IF (TLA < 0.0) THEN + IF (PRES <= PLAC(1)) THEN + TLA = TLAC(1) + ELSEIF (PRES <= PLAC(2)) THEN + TLA = TLAC(2) + (PRES-PLAC(2))*tlbpl(1) + ELSEIF (PRES <= PLAC(3)) THEN + TLA = TLAC(3) + (PRES-PLAC(3))*tlbpl(2) + ELSEIF (PRES <= PLAC(4)) THEN + TLA = TLAC(4) + (PRES-PLAC(4))*tlbpl(3) + ELSEIF (PRES <= PLAC(5)) THEN + TLA = TLAC(5) + (PRES-PLAC(5))*tlbpl(4) + ELSEIF (PRES <= PLAC(6)) THEN + TLA = TLAC(6) + (PRES-PLAC(6))*tlbpl(5) + ELSEIF (PRES <= PLAC(7)) THEN + TLA = TLAC(7) + (PRES-PLAC(7))*tlbpl(6) + ELSEIF (PRES <= PLAC(8)) THEN + TLA = TLAC(8) + (PRES-PLAC(8))*tlbpl(7) + ELSE + TLA = TLAC(8) + ENDIF + ENDIF + IF (PRES >= REFP(1)) THEN + TEM = REFR(1) + ELSEIF (PRES >= REFP(2)) THEN + TEM = REFR(1) + (PRES-REFP(1)) * drdp(1) + ELSEIF (PRES >= REFP(3)) THEN + TEM = REFR(2) + (PRES-REFP(2)) * drdp(2) + ELSEIF (PRES >= REFP(4)) THEN + TEM = REFR(3) + (PRES-REFP(3)) * drdp(3) + ELSEIF (PRES >= REFP(5)) THEN + TEM = REFR(4) + (PRES-REFP(4)) * drdp(4) + ELSEIF (PRES >= REFP(6)) THEN + TEM = REFR(5) + (PRES-REFP(5)) * drdp(5) + ELSE + TEM = REFR(6) + ENDIF +! + tem = 2.0E-4 / tem + al2 = min(4.0*tem, max(alm, tem)) +! + RETURN + end subroutine angrad + + SUBROUTINE SETQRP + implicit none + + real(kind=kind_phys) tem2,tem1,x,xinc,xmax,xmin + integer jx +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +! XMIN = 1.0E-6 + XMIN = 0.0 + XMAX = 5.0 + XINC = (XMAX-XMIN)/(NQRP-1) + C2XQRP = one / XINC + C1XQRP = one - XMIN*C2XQRP + TEM1 = 0.001 ** 0.2046 + TEM2 = 0.001 ** 0.525 + DO JX=1,NQRP + X = XMIN + (JX-1)*XINC + TBQRP(JX) = X ** 0.1364 + TBQRA(JX) = TEM1 * X ** 0.2046 + TBQRB(JX) = TEM2 * X ** 0.525 + ENDDO +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + RETURN + end subroutine setqrp + + SUBROUTINE QRABF(QRP,QRAF,QRBF) + implicit none +! + real(kind=kind_phys) QRP, QRAF, QRBF, XJ, REAL_NQRP + INTEGER JX +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + REAL_NQRP = REAL(NQRP) + XJ = MIN(MAX(C1XQRP+C2XQRP*QRP,ONE),REAL_NQRP) + JX = MIN(XJ,NQRP-ONE) + XJ = XJ - JX + QRAF = TBQRA(JX) + XJ * (TBQRA(JX+1)-TBQRA(JX)) + QRBF = TBQRB(JX) + XJ * (TBQRB(JX+1)-TBQRB(JX)) +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + RETURN + end subroutine qrabf + + SUBROUTINE SETVTP + implicit none + + real(kind=kind_phys), parameter :: vtpexp=-0.3636, one=1.0 + real(kind=kind_phys) xinc,x,xmax,xmin + integer jx +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + XMIN = 0.05 + XMAX = 1.5 + XINC = (XMAX-XMIN)/(NVTP-1) + C2XVTP = one / XINC + C1XVTP = one - XMIN*C2XVTP + DO JX=1,NVTP + X = XMIN + (JX-1)*XINC + TBVTP(JX) = X ** VTPEXP + ENDDO +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + RETURN + end subroutine setvtp +! + real(kind=kind_phys) FUNCTION QRPF(QRP) +! + implicit none + + real(kind=kind_phys) QRP, XJ, REAL_NQRP + INTEGER JX +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + REAL_NQRP = REAL(NQRP) + XJ = MIN(MAX(C1XQRP+C2XQRP*QRP,ONE),REAL_NQRP) +! XJ = MIN(MAX(C1XQRP+C2XQRP*QRP,ONE),FLOAT(NQRP)) + JX = MIN(XJ,NQRP-ONE) + QRPF = TBQRP(JX) + (XJ-JX) * (TBQRP(JX+1)-TBQRP(JX)) +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + RETURN + end function qrpf + + real(kind=kind_phys) FUNCTION VTPF(ROR) +! + implicit none + real(kind=kind_phys) ROR, XJ, REAL_NVTP + INTEGER JX +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + REAL_NVTP = REAL(NVTP) + XJ = MIN(MAX(C1XVTP+C2XVTP*ROR,ONE),REAL_NVTP) + JX = MIN(XJ,NVTP-ONE) + VTPF = TBVTP(JX) + (XJ-JX) * (TBVTP(JX+1)-TBVTP(JX)) +! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + RETURN + end function vtpf + + real(kind=kind_phys) FUNCTION CLF(PRATE) +! + implicit none + real(kind=kind_phys) PRATE +! + real (kind=kind_phys), parameter :: ccf1=0.30, ccf2=0.09 & + &, ccf3=0.04, ccf4=0.01 & + &, pr1=1.0, pr2=5.0 & + &, pr3=20.0 +! + if (prate < pr1) then + clf = ccf1 + elseif (prate < pr2) then + clf = ccf2 + elseif (prate < pr3) then + clf = ccf3 + else + clf = ccf4 + endif +! + RETURN + end function clf + end module rascnv diff --git a/physics/rascnv.meta b/physics/rascnv.meta new file mode 100644 index 000000000..0a201e74d --- /dev/null +++ b/physics/rascnv.meta @@ -0,0 +1,687 @@ +[ccpp-arg-table] + name = rascnv_init + type = scheme +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[dt] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_g] + standard_name = gravitational_acceleration + long_name = gravitational acceleration + units = m s-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_cp] + standard_name = specific_heat_of_dry_air_at_constant_pressure + long_name = specific heat of dry air at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rd] + standard_name = gas_constant_dry_air + long_name = ideal gas constant for dry air + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_rv] + standard_name = gas_constant_water_vapor + long_name = ideal gas constant for water vapor + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_hvap] + standard_name = latent_heat_of_vaporization_of_water_at_0C + long_name = latent heat of evaporation/sublimation + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_hfus] + standard_name = latent_heat_of_fusion_of_water_at_0C + long_name = latent heat of fusion + units = J kg-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_fvirt] + standard_name = ratio_of_vapor_to_dry_air_gas_constants_minus_one + long_name = (rv/rd) - 1 (rv = ideal gas constant for water vapor) + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_t0c] + standard_name = temperature_at_zero_celsius + long_name = temperature at 0 degrees Celsius + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_ttp] + standard_name = triple_point_temperature_of_water + long_name = triple point temperature of water + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_cvap] + standard_name = specific_heat_of_water_vapor_at_constant_pressure + long_name = specific heat of water vapor at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_cliq] + standard_name = specific_heat_of_liquid_water_at_constant_pressure + long_name = specific heat of liquid water at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_csol] + standard_name = specific_heat_of_ice_at_constant_pressure + long_name = specific heat of ice at constant pressure + units = J kg-1 K-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_eps] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants + long_name = rd/rv + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[con_epsm1] + standard_name = ratio_of_dry_air_to_water_vapor_gas_constants_minus_one + long_name = (rd/rv) - 1 + units = none + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = rascnv_finalize + type = scheme +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = rascnv_run + type = scheme +[im] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[ix] + standard_name = horizontal_dimension + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[k] + standard_name = vertical_dimension + long_name = vertical layer dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[ntr] + standard_name = number_of_tracers_for_samf + long_name = number of tracers for scale-aware mass flux schemes + units = count + dimensions = () + type = integer + intent = in + optional = F +[dt] + standard_name = time_step_for_physics + long_name = physics time step + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dtf] + standard_name = time_step_for_dynamics + long_name = dynamics timestep + units = s + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[ccwf] + standard_name = multiplication_factor_for_critical_cloud_workfunction + long_name = multiplication factor for tical_cloud_workfunction + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[area] + standard_name = cell_area + long_name = area of the grid cell + units = m2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[dxmin] + standard_name = minimum_scaling_factor_for_critical_relative_humidity + long_name = minimum scaling factor for critical relative humidity + units = m2 rad-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[dxinv] + standard_name = inverse_scaling_factor_for_critical_relative_humidity + long_name = inverse scaling factor for critical relative humidity + units = rad2 m-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[psauras] + standard_name = coefficient_from_cloud_ice_to_snow_ras + long_name = conversion coefficient from cloud ice to snow in ras + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[prauras] + standard_name = coefficient_from_cloud_water_to_rain_ras + long_name = conversion coefficient from cloud water to rain in ras + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[wminras] + standard_name = cloud_condensed_water_ice_conversion_threshold_ras + long_name = conversion coefficient from cloud liquid and ice to precipitation in ras + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[dlqf] + standard_name = condensate_fraction_detrained_in_updraft_layers + long_name = condensate fraction detrained with in a updraft layers + units = none + dimensions = (2) + type = real + kind = kind_phys + intent = in + optional = F +[flipv] + standard_name = flag_flip + long_name = vertical flip logical + units = flag + dimensions = () + type = logical + intent = in + optional = F +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[rannum] + standard_name = random_number_array + long_name = random number array (0-1) + units = none + dimensions = (horizontal_dimension,array_dimension_of_random_number) + type = real + kind = kind_phys + intent = in + optional = F +[nrcm] + standard_name = array_dimension_of_random_number + long_name = second dimension of random number stream for RAS + units = count + dimensions = () + type = integer + intent = in + optional = F +[mp_phys] + standard_name = flag_for_microphysics_scheme + long_name = choice of microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[mp_phys_mg] + standard_name = flag_for_morrison_gettelman_microphysics_scheme + long_name = choice of Morrison-Gettelman microphysics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[ntk] + standard_name = index_for_turbulent_kinetic_energy_convective_transport_tracer + long_name = index for turbulent kinetic energy in the convectively transported tracer array + units = index + dimensions = () + type = integer + intent = in + optional = F +[kdt] + standard_name = index_of_time_step + long_name = current forecast iteration + units = index + dimensions = () + type = integer + intent = in + optional = F +[rhc] + standard_name = critical_relative_humidity + long_name = critical relative humidity + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tin] + standard_name = air_temperature_updated_by_physics + long_name = updated temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qin] + standard_name = water_vapor_specific_humidity_updated_by_physics + long_name = updated vapor specific humidity + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[uin] + standard_name = x_wind_updated_by_physics + long_name = updated x-direction wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[vin] + standard_name = y_wind_updated_by_physics + long_name = updated y-direction wind + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[ccin] + standard_name = convective_transportable_tracers + long_name = array to contain cloud water and other convective trans. tracers + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension,tracer_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fscav] + standard_name = coefficients_for_aerosol_scavenging + long_name = array of aerosol scavenging coefficients + units = none + dimensions = (number_of_chemical_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[prsi] + standard_name = air_pressure_at_interface + long_name = air pressure at model layer interfaces + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsl] + standard_name = air_pressure + long_name = mean layer pressure + units = Pa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prsik] + standard_name = dimensionless_exner_function_at_model_interfaces + long_name = dimensionless Exner function at model layer interfaces + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[prslk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = dimensionless Exner function at model layer centers + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phil] + standard_name = geopotential + long_name = geopotential at model layer centers + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[phii] + standard_name = geopotential_at_interface + long_name = geopotential at model layer interfaces + units = m2 s-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[kpbl] + standard_name = vertical_index_at_top_of_atmosphere_boundary_layer + long_name = vertical index at top atmospheric boundary layer + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[cdrag] + standard_name = surface_drag_coefficient_for_momentum_in_air + long_name = surface exchange coeff for momentum + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[rainc] + standard_name = lwe_thickness_of_deep_convective_precipitation_amount + long_name = deep convective rainfall amount on physics timestep + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[kbot] + standard_name = vertical_index_at_cloud_base + long_name = index for cloud base + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[ktop] + standard_name = vertical_index_at_cloud_top + long_name = index for cloud top + units = index + dimensions = (horizontal_dimension) + type = integer + intent = out + optional = F +[kcnv] + standard_name = flag_deep_convection + long_name = deep convection: 0=no, 1=yes + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = inout + optional = F +[ddvel] + standard_name = surface_wind_enhancement_due_to_convection + long_name = surface wind enhancement due to convection + units = m s-1 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[ud_mf] + standard_name = instantaneous_atmosphere_updraft_convective_mass_flux + long_name = (updraft mass flux) * dt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dd_mf] + standard_name = instantaneous_atmosphere_downdraft_convective_mass_flux + long_name = (downdraft mass flux) * dt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[dt_mf] + standard_name = instantaneous_atmosphere_detrainment_convective_mass_flux + long_name = (detrainment mass flux) * dt + units = kg m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[qlcn] + standard_name = mass_fraction_of_convective_cloud_liquid_water + long_name = mass fraction of convective cloud liquid water + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[qicn] + standard_name = mass_fraction_of_convective_cloud_ice + long_name = mass fraction of convective cloud ice water + units = kg kg-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[w_upi] + standard_name = vertical_velocity_for_updraft + long_name = vertical velocity for updraft + units = m s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cf_upi] + standard_name = convective_cloud_fraction_for_microphysics + long_name = convective cloud fraction for microphysics + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_mfd] + standard_name = detrained_mass_flux + long_name = detrained mass flux + units = kg m-2 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_dqldt] + standard_name = tendency_of_cloud_water_due_to_convective_microphysics + long_name = tendency of cloud water due to convective microphysics + units = kg m-2 s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[clcn] + standard_name = convective_cloud_volume_fraction + long_name = convective cloud volume fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_fice] + standard_name = ice_fraction_in_convective_tower + long_name = ice fraction in convective tower + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_ndrop] + standard_name = number_concentration_of_cloud_liquid_water_particles_for_detrainment + long_name = droplet number concentration in convective detrainment + units = m-3 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[cnv_nice] + standard_name = number_concentration_of_ice_crystals_for_detrainment + long_name = crystal number concentration in convective detrainment + units = m-3 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/rrtmg_lw_cloud_optics.F90 b/physics/rrtmg_lw_cloud_optics.F90 new file mode 100644 index 000000000..31551d797 --- /dev/null +++ b/physics/rrtmg_lw_cloud_optics.F90 @@ -0,0 +1,821 @@ +module mo_rrtmg_lw_cloud_optics + use machine, only: kind_phys + use physparam, only: ilwcliq, ilwcice, iovrlw + use mersenne_twister, only: random_setseed, random_number, random_stat + + implicit none + + ! Parameter used for RRTMG cloud-optics + integer,parameter :: & + nBandsLW_RRTMG = 16 + ! ipat is bands index for ebert & curry ice cloud (for iflagice=1) + integer,dimension(nBandsLW_RRTMG),parameter :: & + ipat = (/ 1, 2, 3, 3, 3, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5 /) + real(kind_phys), parameter :: & + absrain = 0.33e-3, & ! Rain drop absorption coefficient \f$(m^{2}/g)\f$ . + abssnow0 = 1.5, & ! Snow flake absorption coefficient (micron), fu coeff + abssnow1 = 2.34e-3 ! Snow flake absorption coefficient \f$(m^{2}/g)\f$, ncar coef + + ! Reset diffusivity angle for Bands 2-3 and 5-9 to vary (between 1.50 + ! and 1.80) as a function of total column water vapor. the function + ! has been defined to minimize flux and cooling rate errors in these bands + ! over a wide range of precipitable water values. + ! *NOTE* This is done in GFS_rrtmgp_lw_pre.F90:_run() + real (kind_phys), dimension(nbandsLW_RRTMG) :: & + a0 = (/ 1.66, 1.55, 1.58, 1.66, 1.54, 1.454, 1.89, 1.33, & + 1.668, 1.66, 1.66, 1.66, 1.66, 1.66, 1.66, 1.66 /), & + a1 = (/ 0.00, 0.25, 0.22, 0.00, 0.13, 0.446, -0.10, 0.40, & + -0.006, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 /), & + a2 = (/ 0.00, -12.0, -11.7, 0.00, -0.72, -0.243, 0.19, -0.062, & + 0.414, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 /) + real(kind_phys),parameter :: & + diffusivityLow = 1.50, & ! Minimum diffusivity angle for bands 2-3 and 5-9 + diffusivityHigh = 1.80, & ! Maximum diffusivity angle for bands 2-3 and 5-9 + diffusivityB1410 = 1.66 ! Diffusivity for bands 1, 4, and 10 + + ! RRTMG LW cloud property coefficients + real(kind_phys) , dimension(58,nBandsLW_RRTMG),parameter :: & + absliq1 = reshape(source=(/ & + 1.64047e-03, 6.90533e-02, 7.72017e-02, 7.78054e-02, 7.69523e-02, & !1 + 7.58058e-02, 7.46400e-02, 7.35123e-02, 7.24162e-02, 7.13225e-02, & !1 + 6.99145e-02, 6.66409e-02, 6.36582e-02, 6.09425e-02, 5.84593e-02, & !1 + 5.61743e-02, 5.40571e-02, 5.20812e-02, 5.02245e-02, 4.84680e-02, & !1 + 4.67959e-02, 4.51944e-02, 4.36516e-02, 4.21570e-02, 4.07015e-02, & !1 + 3.92766e-02, 3.78747e-02, 3.64886e-02, 3.53632e-02, 3.41992e-02, & !1 + 3.31016e-02, 3.20643e-02, 3.10817e-02, 3.01490e-02, 2.92620e-02, & !1 + 2.84171e-02, 2.76108e-02, 2.68404e-02, 2.61031e-02, 2.53966e-02, & !1 + 2.47189e-02, 2.40678e-02, 2.34418e-02, 2.28392e-02, 2.22586e-02, & !1 + 2.16986e-02, 2.11580e-02, 2.06356e-02, 2.01305e-02, 1.96417e-02, & !1 + 1.91682e-02, 1.87094e-02, 1.82643e-02, 1.78324e-02, 1.74129e-02, & !1 + 1.70052e-02, 1.66088e-02, 1.62231e-02, & !1 + 2.19486e-01, 1.80687e-01, 1.59150e-01, 1.44731e-01, 1.33703e-01, & !2 + 1.24355e-01, 1.15756e-01, 1.07318e-01, 9.86119e-02, 8.92739e-02, & !2 + 8.34911e-02, 7.70773e-02, 7.15240e-02, 6.66615e-02, 6.23641e-02, & !2 + 5.85359e-02, 5.51020e-02, 5.20032e-02, 4.91916e-02, 4.66283e-02, & !2 + 4.42813e-02, 4.21236e-02, 4.01330e-02, 3.82905e-02, 3.65797e-02, & !2 + 3.49869e-02, 3.35002e-02, 3.21090e-02, 3.08957e-02, 2.97601e-02, & !2 + 2.86966e-02, 2.76984e-02, 2.67599e-02, 2.58758e-02, 2.50416e-02, & !2 + 2.42532e-02, 2.35070e-02, 2.27997e-02, 2.21284e-02, 2.14904e-02, & !2 + 2.08834e-02, 2.03051e-02, 1.97536e-02, 1.92271e-02, 1.87239e-02, & !2 + 1.82425e-02, 1.77816e-02, 1.73399e-02, 1.69162e-02, 1.65094e-02, & !2 + 1.61187e-02, 1.57430e-02, 1.53815e-02, 1.50334e-02, 1.46981e-02, & !2 + 1.43748e-02, 1.40628e-02, 1.37617e-02, & !2 + 2.95174e-01, 2.34765e-01, 1.98038e-01, 1.72114e-01, 1.52083e-01, & !3 + 1.35654e-01, 1.21613e-01, 1.09252e-01, 9.81263e-02, 8.79448e-02, & !3 + 8.12566e-02, 7.44563e-02, 6.86374e-02, 6.36042e-02, 5.92094e-02, & !3 + 5.53402e-02, 5.19087e-02, 4.88455e-02, 4.60951e-02, 4.36124e-02, & !3 + 4.13607e-02, 3.93096e-02, 3.74338e-02, 3.57119e-02, 3.41261e-02, & !3 + 3.26610e-02, 3.13036e-02, 3.00425e-02, 2.88497e-02, 2.78077e-02, & !3 + 2.68317e-02, 2.59158e-02, 2.50545e-02, 2.42430e-02, 2.34772e-02, & !3 + 2.27533e-02, 2.20679e-02, 2.14181e-02, 2.08011e-02, 2.02145e-02, & !3 + 1.96561e-02, 1.91239e-02, 1.86161e-02, 1.81311e-02, 1.76673e-02, & !3 + 1.72234e-02, 1.67981e-02, 1.63903e-02, 1.59989e-02, 1.56230e-02, & !3 + 1.52615e-02, 1.49138e-02, 1.45791e-02, 1.42565e-02, 1.39455e-02, & !3 + 1.36455e-02, 1.33559e-02, 1.30761e-02, & !3 + 3.00925e-01, 2.36949e-01, 1.96947e-01, 1.68692e-01, 1.47190e-01, & !4 + 1.29986e-01, 1.15719e-01, 1.03568e-01, 9.30028e-02, 8.36658e-02, & !4 + 7.71075e-02, 7.07002e-02, 6.52284e-02, 6.05024e-02, 5.63801e-02, & !4 + 5.27534e-02, 4.95384e-02, 4.66690e-02, 4.40925e-02, 4.17664e-02, & !4 + 3.96559e-02, 3.77326e-02, 3.59727e-02, 3.43561e-02, 3.28662e-02, & !4 + 3.14885e-02, 3.02110e-02, 2.90231e-02, 2.78948e-02, 2.69109e-02, & !4 + 2.59884e-02, 2.51217e-02, 2.43058e-02, 2.35364e-02, 2.28096e-02, & !4 + 2.21218e-02, 2.14700e-02, 2.08515e-02, 2.02636e-02, 1.97041e-02, & !4 + 1.91711e-02, 1.86625e-02, 1.81769e-02, 1.77126e-02, 1.72683e-02, & !4 + 1.68426e-02, 1.64344e-02, 1.60427e-02, 1.56664e-02, 1.53046e-02, & !4 + 1.49565e-02, 1.46214e-02, 1.42985e-02, 1.39871e-02, 1.36866e-02, & !4 + 1.33965e-02, 1.31162e-02, 1.28453e-02, & !4 + 2.64691e-01, 2.12018e-01, 1.78009e-01, 1.53539e-01, 1.34721e-01, & !5 + 1.19580e-01, 1.06996e-01, 9.62772e-02, 8.69710e-02, 7.87670e-02, & !5 + 7.29272e-02, 6.70920e-02, 6.20977e-02, 5.77732e-02, 5.39910e-02, & !5 + 5.06538e-02, 4.76866e-02, 4.50301e-02, 4.26374e-02, 4.04704e-02, & !5 + 3.84981e-02, 3.66948e-02, 3.50394e-02, 3.35141e-02, 3.21038e-02, & !5 + 3.07957e-02, 2.95788e-02, 2.84438e-02, 2.73790e-02, 2.64390e-02, & !5 + 2.55565e-02, 2.47263e-02, 2.39437e-02, 2.32047e-02, 2.25056e-02, & !5 + 2.18433e-02, 2.12149e-02, 2.06177e-02, 2.00495e-02, 1.95081e-02, & !5 + 1.89917e-02, 1.84984e-02, 1.80269e-02, 1.75755e-02, 1.71431e-02, & !5 + 1.67283e-02, 1.63303e-02, 1.59478e-02, 1.55801e-02, 1.52262e-02, & !5 + 1.48853e-02, 1.45568e-02, 1.42400e-02, 1.39342e-02, 1.36388e-02, & !5 + 1.33533e-02, 1.30773e-02, 1.28102e-02, & !5 + 8.81182e-02, 1.06745e-01, 9.79753e-02, 8.99625e-02, 8.35200e-02, & !6 + 7.81899e-02, 7.35939e-02, 6.94696e-02, 6.56266e-02, 6.19148e-02, & !6 + 5.83355e-02, 5.49306e-02, 5.19642e-02, 4.93325e-02, 4.69659e-02, & !6 + 4.48148e-02, 4.28431e-02, 4.10231e-02, 3.93332e-02, 3.77563e-02, & !6 + 3.62785e-02, 3.48882e-02, 3.35758e-02, 3.23333e-02, 3.11536e-02, & !6 + 3.00310e-02, 2.89601e-02, 2.79365e-02, 2.70502e-02, 2.62618e-02, & !6 + 2.55025e-02, 2.47728e-02, 2.40726e-02, 2.34013e-02, 2.27583e-02, & !6 + 2.21422e-02, 2.15522e-02, 2.09869e-02, 2.04453e-02, 1.99260e-02, & !6 + 1.94280e-02, 1.89501e-02, 1.84913e-02, 1.80506e-02, 1.76270e-02, & !6 + 1.72196e-02, 1.68276e-02, 1.64500e-02, 1.60863e-02, 1.57357e-02, & !6 + 1.53975e-02, 1.50710e-02, 1.47558e-02, 1.44511e-02, 1.41566e-02, & !6 + 1.38717e-02, 1.35960e-02, 1.33290e-02, & !6 + 4.32174e-02, 7.36078e-02, 6.98340e-02, 6.65231e-02, 6.41948e-02, & !7 + 6.23551e-02, 6.06638e-02, 5.88680e-02, 5.67124e-02, 5.38629e-02, & !7 + 4.99579e-02, 4.86289e-02, 4.70120e-02, 4.52854e-02, 4.35466e-02, & !7 + 4.18480e-02, 4.02169e-02, 3.86658e-02, 3.71992e-02, 3.58168e-02, & !7 + 3.45155e-02, 3.32912e-02, 3.21390e-02, 3.10538e-02, 3.00307e-02, & !7 + 2.90651e-02, 2.81524e-02, 2.72885e-02, 2.62821e-02, 2.55744e-02, & !7 + 2.48799e-02, 2.42029e-02, 2.35460e-02, 2.29108e-02, 2.22981e-02, & !7 + 2.17079e-02, 2.11402e-02, 2.05945e-02, 2.00701e-02, 1.95663e-02, & !7 + 1.90824e-02, 1.86174e-02, 1.81706e-02, 1.77411e-02, 1.73281e-02, & !7 + 1.69307e-02, 1.65483e-02, 1.61801e-02, 1.58254e-02, 1.54835e-02, & !7 + 1.51538e-02, 1.48358e-02, 1.45288e-02, 1.42322e-02, 1.39457e-02, & !7 + 1.36687e-02, 1.34008e-02, 1.31416e-02, & !7 + 1.41881e-01, 7.15419e-02, 6.30335e-02, 6.11132e-02, 6.01931e-02, & !8 + 5.92420e-02, 5.78968e-02, 5.58876e-02, 5.28923e-02, 4.84462e-02, & !8 + 4.60839e-02, 4.56013e-02, 4.45410e-02, 4.31866e-02, 4.17026e-02, & !8 + 4.01850e-02, 3.86892e-02, 3.72461e-02, 3.58722e-02, 3.45749e-02, & !8 + 3.33564e-02, 3.22155e-02, 3.11494e-02, 3.01541e-02, 2.92253e-02, & !8 + 2.83584e-02, 2.75488e-02, 2.67925e-02, 2.57692e-02, 2.50704e-02, & !8 + 2.43918e-02, 2.37350e-02, 2.31005e-02, 2.24888e-02, 2.18996e-02, & !8 + 2.13325e-02, 2.07870e-02, 2.02623e-02, 1.97577e-02, 1.92724e-02, & !8 + 1.88056e-02, 1.83564e-02, 1.79241e-02, 1.75079e-02, 1.71070e-02, & !8 + 1.67207e-02, 1.63482e-02, 1.59890e-02, 1.56424e-02, 1.53077e-02, & !8 + 1.49845e-02, 1.46722e-02, 1.43702e-02, 1.40782e-02, 1.37955e-02, & !8 + 1.35219e-02, 1.32569e-02, 1.30000e-02, & !8 + 6.72726e-02, 6.61013e-02, 6.47866e-02, 6.33780e-02, 6.18985e-02, & !9 + 6.03335e-02, 5.86136e-02, 5.65876e-02, 5.39839e-02, 5.03536e-02, & !9 + 4.71608e-02, 4.63630e-02, 4.50313e-02, 4.34526e-02, 4.17876e-02, & !9 + 4.01261e-02, 3.85171e-02, 3.69860e-02, 3.55442e-02, 3.41954e-02, & !9 + 3.29384e-02, 3.17693e-02, 3.06832e-02, 2.96745e-02, 2.87374e-02, & !9 + 2.78662e-02, 2.70557e-02, 2.63008e-02, 2.52450e-02, 2.45424e-02, & !9 + 2.38656e-02, 2.32144e-02, 2.25885e-02, 2.19873e-02, 2.14099e-02, & !9 + 2.08554e-02, 2.03230e-02, 1.98116e-02, 1.93203e-02, 1.88482e-02, & !9 + 1.83944e-02, 1.79578e-02, 1.75378e-02, 1.71335e-02, 1.67440e-02, & !9 + 1.63687e-02, 1.60069e-02, 1.56579e-02, 1.53210e-02, 1.49958e-02, & !9 + 1.46815e-02, 1.43778e-02, 1.40841e-02, 1.37999e-02, 1.35249e-02, & !9 + 1.32585e-02, 1.30004e-02, 1.27502e-02, & !9 + 7.97040e-02, 7.63844e-02, 7.36499e-02, 7.13525e-02, 6.93043e-02, & !10 + 6.72807e-02, 6.50227e-02, 6.22395e-02, 5.86093e-02, 5.37815e-02, & !10 + 5.14682e-02, 4.97214e-02, 4.77392e-02, 4.56961e-02, 4.36858e-02, & !10 + 4.17569e-02, 3.99328e-02, 3.82224e-02, 3.66265e-02, 3.51416e-02, & !10 + 3.37617e-02, 3.24798e-02, 3.12887e-02, 3.01812e-02, 2.91505e-02, & !10 + 2.81900e-02, 2.72939e-02, 2.64568e-02, 2.54165e-02, 2.46832e-02, & !10 + 2.39783e-02, 2.33017e-02, 2.26531e-02, 2.20314e-02, 2.14359e-02, & !10 + 2.08653e-02, 2.03187e-02, 1.97947e-02, 1.92924e-02, 1.88106e-02, & !10 + 1.83483e-02, 1.79043e-02, 1.74778e-02, 1.70678e-02, 1.66735e-02, & !10 + 1.62941e-02, 1.59286e-02, 1.55766e-02, 1.52371e-02, 1.49097e-02, & !10 + 1.45937e-02, 1.42885e-02, 1.39936e-02, 1.37085e-02, 1.34327e-02, & !10 + 1.31659e-02, 1.29075e-02, 1.26571e-02, & !10 + 1.49438e-01, 1.33535e-01, 1.21542e-01, 1.11743e-01, 1.03263e-01, & !11 + 9.55774e-02, 8.83382e-02, 8.12943e-02, 7.42533e-02, 6.70609e-02, & !11 + 6.38761e-02, 5.97788e-02, 5.59841e-02, 5.25318e-02, 4.94132e-02, & !11 + 4.66014e-02, 4.40644e-02, 4.17706e-02, 3.96910e-02, 3.77998e-02, & !11 + 3.60742e-02, 3.44947e-02, 3.30442e-02, 3.17079e-02, 3.04730e-02, & !11 + 2.93283e-02, 2.82642e-02, 2.72720e-02, 2.61789e-02, 2.53277e-02, & !11 + 2.45237e-02, 2.37635e-02, 2.30438e-02, 2.23615e-02, 2.17140e-02, & !11 + 2.10987e-02, 2.05133e-02, 1.99557e-02, 1.94241e-02, 1.89166e-02, & !11 + 1.84317e-02, 1.79679e-02, 1.75238e-02, 1.70983e-02, 1.66901e-02, & !11 + 1.62983e-02, 1.59219e-02, 1.55599e-02, 1.52115e-02, 1.48761e-02, & !11 + 1.45528e-02, 1.42411e-02, 1.39402e-02, 1.36497e-02, 1.33690e-02, & !11 + 1.30976e-02, 1.28351e-02, 1.25810e-02, & !11 + 3.71985e-02, 3.88586e-02, 3.99070e-02, 4.04351e-02, 4.04610e-02, & !12 + 3.99834e-02, 3.89953e-02, 3.74886e-02, 3.54551e-02, 3.28870e-02, & !12 + 3.32576e-02, 3.22444e-02, 3.12384e-02, 3.02584e-02, 2.93146e-02, & !12 + 2.84120e-02, 2.75525e-02, 2.67361e-02, 2.59618e-02, 2.52280e-02, & !12 + 2.45327e-02, 2.38736e-02, 2.32487e-02, 2.26558e-02, 2.20929e-02, & !12 + 2.15579e-02, 2.10491e-02, 2.05648e-02, 1.99749e-02, 1.95704e-02, & !12 + 1.91731e-02, 1.87839e-02, 1.84032e-02, 1.80315e-02, 1.76689e-02, & !12 + 1.73155e-02, 1.69712e-02, 1.66362e-02, 1.63101e-02, 1.59928e-02, & !12 + 1.56842e-02, 1.53840e-02, 1.50920e-02, 1.48080e-02, 1.45318e-02, & !12 + 1.42631e-02, 1.40016e-02, 1.37472e-02, 1.34996e-02, 1.32586e-02, & !12 + 1.30239e-02, 1.27954e-02, 1.25728e-02, 1.23559e-02, 1.21445e-02, & !12 + 1.19385e-02, 1.17376e-02, 1.15417e-02, & !12 + 3.11868e-02, 4.48357e-02, 4.90224e-02, 4.96406e-02, 4.86806e-02, & !13 + 4.69610e-02, 4.48630e-02, 4.25795e-02, 4.02138e-02, 3.78236e-02, & !13 + 3.74266e-02, 3.60384e-02, 3.47074e-02, 3.34434e-02, 3.22499e-02, & !13 + 3.11264e-02, 3.00704e-02, 2.90784e-02, 2.81463e-02, 2.72702e-02, & !13 + 2.64460e-02, 2.56698e-02, 2.49381e-02, 2.42475e-02, 2.35948e-02, & !13 + 2.29774e-02, 2.23925e-02, 2.18379e-02, 2.11793e-02, 2.07076e-02, & !13 + 2.02470e-02, 1.97981e-02, 1.93613e-02, 1.89367e-02, 1.85243e-02, & !13 + 1.81240e-02, 1.77356e-02, 1.73588e-02, 1.69935e-02, 1.66392e-02, & !13 + 1.62956e-02, 1.59624e-02, 1.56393e-02, 1.53259e-02, 1.50219e-02, & !13 + 1.47268e-02, 1.44404e-02, 1.41624e-02, 1.38925e-02, 1.36302e-02, & !13 + 1.33755e-02, 1.31278e-02, 1.28871e-02, 1.26530e-02, 1.24253e-02, & !13 + 1.22038e-02, 1.19881e-02, 1.17782e-02, & !13 + 1.58988e-02, 3.50652e-02, 4.00851e-02, 4.07270e-02, 3.98101e-02, & !14 + 3.83306e-02, 3.66829e-02, 3.50327e-02, 3.34497e-02, 3.19609e-02, & !14 + 3.13712e-02, 3.03348e-02, 2.93415e-02, 2.83973e-02, 2.75037e-02, & !14 + 2.66604e-02, 2.58654e-02, 2.51161e-02, 2.44100e-02, 2.37440e-02, & !14 + 2.31154e-02, 2.25215e-02, 2.19599e-02, 2.14282e-02, 2.09242e-02, & !14 + 2.04459e-02, 1.99915e-02, 1.95594e-02, 1.90254e-02, 1.86598e-02, & !14 + 1.82996e-02, 1.79455e-02, 1.75983e-02, 1.72584e-02, 1.69260e-02, & !14 + 1.66013e-02, 1.62843e-02, 1.59752e-02, 1.56737e-02, 1.53799e-02, & !14 + 1.50936e-02, 1.48146e-02, 1.45429e-02, 1.42782e-02, 1.40203e-02, & !14 + 1.37691e-02, 1.35243e-02, 1.32858e-02, 1.30534e-02, 1.28270e-02, & !14 + 1.26062e-02, 1.23909e-02, 1.21810e-02, 1.19763e-02, 1.17766e-02, & !14 + 1.15817e-02, 1.13915e-02, 1.12058e-02, & !14 + 5.02079e-03, 2.17615e-02, 2.55449e-02, 2.59484e-02, 2.53650e-02, & !15 + 2.45281e-02, 2.36843e-02, 2.29159e-02, 2.22451e-02, 2.16716e-02, & !15 + 2.11451e-02, 2.05817e-02, 2.00454e-02, 1.95372e-02, 1.90567e-02, & !15 + 1.86028e-02, 1.81742e-02, 1.77693e-02, 1.73866e-02, 1.70244e-02, & !15 + 1.66815e-02, 1.63563e-02, 1.60477e-02, 1.57544e-02, 1.54755e-02, & !15 + 1.52097e-02, 1.49564e-02, 1.47146e-02, 1.43684e-02, 1.41728e-02, & !15 + 1.39762e-02, 1.37797e-02, 1.35838e-02, 1.33891e-02, 1.31961e-02, & !15 + 1.30051e-02, 1.28164e-02, 1.26302e-02, 1.24466e-02, 1.22659e-02, & !15 + 1.20881e-02, 1.19131e-02, 1.17412e-02, 1.15723e-02, 1.14063e-02, & !15 + 1.12434e-02, 1.10834e-02, 1.09264e-02, 1.07722e-02, 1.06210e-02, & !15 + 1.04725e-02, 1.03269e-02, 1.01839e-02, 1.00436e-02, 9.90593e-03, & !15 + 9.77080e-03, 9.63818e-03, 9.50800e-03, & !15 + 5.64971e-02, 9.04736e-02, 8.11726e-02, 7.05450e-02, 6.20052e-02, & !16 + 5.54286e-02, 5.03503e-02, 4.63791e-02, 4.32290e-02, 4.06959e-02, & !16 + 3.74690e-02, 3.52964e-02, 3.33799e-02, 3.16774e-02, 3.01550e-02, & !16 + 2.87856e-02, 2.75474e-02, 2.64223e-02, 2.53953e-02, 2.44542e-02, & !16 + 2.35885e-02, 2.27894e-02, 2.20494e-02, 2.13622e-02, 2.07222e-02, & !16 + 2.01246e-02, 1.95654e-02, 1.90408e-02, 1.84398e-02, 1.80021e-02, & !16 + 1.75816e-02, 1.71775e-02, 1.67889e-02, 1.64152e-02, 1.60554e-02, & !16 + 1.57089e-02, 1.53751e-02, 1.50531e-02, 1.47426e-02, 1.44428e-02, & !16 + 1.41532e-02, 1.38734e-02, 1.36028e-02, 1.33410e-02, 1.30875e-02, & !16 + 1.28420e-02, 1.26041e-02, 1.23735e-02, 1.21497e-02, 1.19325e-02, & !16 + 1.17216e-02, 1.15168e-02, 1.13177e-02, 1.11241e-02, 1.09358e-02, & !16 + 1.07525e-02, 1.05741e-02, 1.04003e-02/), & !16 + shape=(/58,nBandsLW_RRTMG/)) + + real(kind_phys), dimension(2),parameter :: & + absice0 = (/0.005,1.0/) + + real(kind_phys), dimension(2,5),parameter :: & + absice1 = reshape(source=(/ & + 0.0036, 1.136, 0.0068, 0.600, 0.0003, 1.338, 0.0016, 1.166, 0.0020, 1.118 /),& + shape=(/2,5/)) + + real(kind_phys), dimension(43, nBandsLW_RRTMG),parameter :: & + absice2 = reshape(source=(/ & + 7.798999e-02, 6.340479e-02, 5.417973e-02, 4.766245e-02, 4.272663e-02, & !1 + 3.880939e-02, 3.559544e-02, 3.289241e-02, 3.057511e-02, 2.855800e-02, & !1 + 2.678022e-02, 2.519712e-02, 2.377505e-02, 2.248806e-02, 2.131578e-02, & !1 + 2.024194e-02, 1.925337e-02, 1.833926e-02, 1.749067e-02, 1.670007e-02, & !1 + 1.596113e-02, 1.526845e-02, 1.461739e-02, 1.400394e-02, 1.342462e-02, & !1 + 1.287639e-02, 1.235656e-02, 1.186279e-02, 1.139297e-02, 1.094524e-02, & !1 + 1.051794e-02, 1.010956e-02, 9.718755e-03, 9.344316e-03, 8.985139e-03, & !1 + 8.640223e-03, 8.308656e-03, 7.989606e-03, 7.682312e-03, 7.386076e-03, & !1 + 7.100255e-03, 6.824258e-03, 6.557540e-03, & !1 + 2.784879e-02, 2.709863e-02, 2.619165e-02, 2.529230e-02, 2.443225e-02, & !2 + 2.361575e-02, 2.284021e-02, 2.210150e-02, 2.139548e-02, 2.071840e-02, & !2 + 2.006702e-02, 1.943856e-02, 1.883064e-02, 1.824120e-02, 1.766849e-02, & !2 + 1.711099e-02, 1.656737e-02, 1.603647e-02, 1.551727e-02, 1.500886e-02, & !2 + 1.451045e-02, 1.402132e-02, 1.354084e-02, 1.306842e-02, 1.260355e-02, & !2 + 1.214575e-02, 1.169460e-02, 1.124971e-02, 1.081072e-02, 1.037731e-02, & !2 + 9.949167e-03, 9.526021e-03, 9.107615e-03, 8.693714e-03, 8.284096e-03, & !2 + 7.878558e-03, 7.476910e-03, 7.078974e-03, 6.684586e-03, 6.293589e-03, & !2 + 5.905839e-03, 5.521200e-03, 5.139543e-03, & !2 + 1.065397e-01, 8.005726e-02, 6.546428e-02, 5.589131e-02, 4.898681e-02, & !3 + 4.369932e-02, 3.947901e-02, 3.600676e-02, 3.308299e-02, 3.057561e-02, & !3 + 2.839325e-02, 2.647040e-02, 2.475872e-02, 2.322164e-02, 2.183091e-02, & !3 + 2.056430e-02, 1.940407e-02, 1.833586e-02, 1.734787e-02, 1.643034e-02, & !3 + 1.557512e-02, 1.477530e-02, 1.402501e-02, 1.331924e-02, 1.265364e-02, & !3 + 1.202445e-02, 1.142838e-02, 1.086257e-02, 1.032445e-02, 9.811791e-03, & !3 + 9.322587e-03, 8.855053e-03, 8.407591e-03, 7.978763e-03, 7.567273e-03, & !3 + 7.171949e-03, 6.791728e-03, 6.425642e-03, 6.072809e-03, 5.732424e-03, & !3 + 5.403748e-03, 5.086103e-03, 4.778865e-03, & !3 + 1.804566e-01, 1.168987e-01, 8.680442e-02, 6.910060e-02, 5.738174e-02, & !4 + 4.902332e-02, 4.274585e-02, 3.784923e-02, 3.391734e-02, 3.068690e-02, & !4 + 2.798301e-02, 2.568480e-02, 2.370600e-02, 2.198337e-02, 2.046940e-02, & !4 + 1.912777e-02, 1.793016e-02, 1.685420e-02, 1.588193e-02, 1.499882e-02, & !4 + 1.419293e-02, 1.345440e-02, 1.277496e-02, 1.214769e-02, 1.156669e-02, & !4 + 1.102694e-02, 1.052412e-02, 1.005451e-02, 9.614854e-03, 9.202335e-03, & !4 + 8.814470e-03, 8.449077e-03, 8.104223e-03, 7.778195e-03, 7.469466e-03, & !4 + 7.176671e-03, 6.898588e-03, 6.634117e-03, 6.382264e-03, 6.142134e-03, & !4 + 5.912913e-03, 5.693862e-03, 5.484308e-03, & !4 + 2.131806e-01, 1.311372e-01, 9.407171e-02, 7.299442e-02, 5.941273e-02, & !5 + 4.994043e-02, 4.296242e-02, 3.761113e-02, 3.337910e-02, 2.994978e-02, & !5 + 2.711556e-02, 2.473461e-02, 2.270681e-02, 2.095943e-02, 1.943839e-02, & !5 + 1.810267e-02, 1.692057e-02, 1.586719e-02, 1.492275e-02, 1.407132e-02, & !5 + 1.329989e-02, 1.259780e-02, 1.195618e-02, 1.136761e-02, 1.082583e-02, & !5 + 1.032552e-02, 9.862158e-03, 9.431827e-03, 9.031157e-03, 8.657217e-03, & !5 + 8.307449e-03, 7.979609e-03, 7.671724e-03, 7.382048e-03, 7.109032e-03, & !5 + 6.851298e-03, 6.607615e-03, 6.376881e-03, 6.158105e-03, 5.950394e-03, & !5 + 5.752942e-03, 5.565019e-03, 5.385963e-03, & !5 + 1.546177e-01, 1.039251e-01, 7.910347e-02, 6.412429e-02, 5.399997e-02, & !6 + 4.664937e-02, 4.104237e-02, 3.660781e-02, 3.300218e-02, 3.000586e-02, & !6 + 2.747148e-02, 2.529633e-02, 2.340647e-02, 2.174723e-02, 2.027731e-02, & !6 + 1.896487e-02, 1.778492e-02, 1.671761e-02, 1.574692e-02, 1.485978e-02, & !6 + 1.404543e-02, 1.329489e-02, 1.260066e-02, 1.195636e-02, 1.135657e-02, & !6 + 1.079664e-02, 1.027257e-02, 9.780871e-03, 9.318505e-03, 8.882815e-03, & !6 + 8.471458e-03, 8.082364e-03, 7.713696e-03, 7.363817e-03, 7.031264e-03, & !6 + 6.714725e-03, 6.413021e-03, 6.125086e-03, 5.849958e-03, 5.586764e-03, & !6 + 5.334707e-03, 5.093066e-03, 4.861179e-03, & !6 + 7.583404e-02, 6.181558e-02, 5.312027e-02, 4.696039e-02, 4.225986e-02, & !7 + 3.849735e-02, 3.538340e-02, 3.274182e-02, 3.045798e-02, 2.845343e-02, & !7 + 2.667231e-02, 2.507353e-02, 2.362606e-02, 2.230595e-02, 2.109435e-02, & !7 + 1.997617e-02, 1.893916e-02, 1.797328e-02, 1.707016e-02, 1.622279e-02, & !7 + 1.542523e-02, 1.467241e-02, 1.395997e-02, 1.328414e-02, 1.264164e-02, & !7 + 1.202958e-02, 1.144544e-02, 1.088697e-02, 1.035218e-02, 9.839297e-03, & !7 + 9.346733e-03, 8.873057e-03, 8.416980e-03, 7.977335e-03, 7.553066e-03, & !7 + 7.143210e-03, 6.746888e-03, 6.363297e-03, 5.991700e-03, 5.631422e-03, & !7 + 5.281840e-03, 4.942378e-03, 4.612505e-03, & !7 + 9.022185e-02, 6.922700e-02, 5.710674e-02, 4.898377e-02, 4.305946e-02, & !8 + 3.849553e-02, 3.484183e-02, 3.183220e-02, 2.929794e-02, 2.712627e-02, & !8 + 2.523856e-02, 2.357810e-02, 2.210286e-02, 2.078089e-02, 1.958747e-02, & !8 + 1.850310e-02, 1.751218e-02, 1.660205e-02, 1.576232e-02, 1.498440e-02, & !8 + 1.426107e-02, 1.358624e-02, 1.295474e-02, 1.236212e-02, 1.180456e-02, & !8 + 1.127874e-02, 1.078175e-02, 1.031106e-02, 9.864433e-03, 9.439878e-03, & !8 + 9.035637e-03, 8.650140e-03, 8.281981e-03, 7.929895e-03, 7.592746e-03, & !8 + 7.269505e-03, 6.959238e-03, 6.661100e-03, 6.374317e-03, 6.098185e-03, & !8 + 5.832059e-03, 5.575347e-03, 5.327504e-03, & !8 + 1.294087e-01, 8.788217e-02, 6.728288e-02, 5.479720e-02, 4.635049e-02, & !9 + 4.022253e-02, 3.555576e-02, 3.187259e-02, 2.888498e-02, 2.640843e-02, & !9 + 2.431904e-02, 2.253038e-02, 2.098024e-02, 1.962267e-02, 1.842293e-02, & !9 + 1.735426e-02, 1.639571e-02, 1.553060e-02, 1.474552e-02, 1.402953e-02, & !9 + 1.337363e-02, 1.277033e-02, 1.221336e-02, 1.169741e-02, 1.121797e-02, & !9 + 1.077117e-02, 1.035369e-02, 9.962643e-03, 9.595509e-03, 9.250088e-03, & !9 + 8.924447e-03, 8.616876e-03, 8.325862e-03, 8.050057e-03, 7.788258e-03, & !9 + 7.539388e-03, 7.302478e-03, 7.076656e-03, 6.861134e-03, 6.655197e-03, & !9 + 6.458197e-03, 6.269543e-03, 6.088697e-03, & !9 + 1.593628e-01, 1.014552e-01, 7.458955e-02, 5.903571e-02, 4.887582e-02, & !10 + 4.171159e-02, 3.638480e-02, 3.226692e-02, 2.898717e-02, 2.631256e-02, & !10 + 2.408925e-02, 2.221156e-02, 2.060448e-02, 1.921325e-02, 1.799699e-02, & !10 + 1.692456e-02, 1.597177e-02, 1.511961e-02, 1.435289e-02, 1.365933e-02, & !10 + 1.302890e-02, 1.245334e-02, 1.192576e-02, 1.144037e-02, 1.099230e-02, & !10 + 1.057739e-02, 1.019208e-02, 9.833302e-03, 9.498395e-03, 9.185047e-03, & !10 + 8.891237e-03, 8.615185e-03, 8.355325e-03, 8.110267e-03, 7.878778e-03, & !10 + 7.659759e-03, 7.452224e-03, 7.255291e-03, 7.068166e-03, 6.890130e-03, & !10 + 6.720536e-03, 6.558794e-03, 6.404371e-03, & !10 + 1.656227e-01, 1.032129e-01, 7.487359e-02, 5.871431e-02, 4.828355e-02, & !11 + 4.099989e-02, 3.562924e-02, 3.150755e-02, 2.824593e-02, 2.560156e-02, & !11 + 2.341503e-02, 2.157740e-02, 2.001169e-02, 1.866199e-02, 1.748669e-02, & !11 + 1.645421e-02, 1.554015e-02, 1.472535e-02, 1.399457e-02, 1.333553e-02, & !11 + 1.273821e-02, 1.219440e-02, 1.169725e-02, 1.124104e-02, 1.082096e-02, & !11 + 1.043290e-02, 1.007336e-02, 9.739338e-03, 9.428223e-03, 9.137756e-03, & !11 + 8.865964e-03, 8.611115e-03, 8.371686e-03, 8.146330e-03, 7.933852e-03, & !11 + 7.733187e-03, 7.543386e-03, 7.363597e-03, 7.193056e-03, 7.031072e-03, & !11 + 6.877024e-03, 6.730348e-03, 6.590531e-03, & !11 + 9.194591e-02, 6.446867e-02, 4.962034e-02, 4.042061e-02, 3.418456e-02, & !12 + 2.968856e-02, 2.629900e-02, 2.365572e-02, 2.153915e-02, 1.980791e-02, & !12 + 1.836689e-02, 1.714979e-02, 1.610900e-02, 1.520946e-02, 1.442476e-02, & !12 + 1.373468e-02, 1.312345e-02, 1.257858e-02, 1.209010e-02, 1.164990e-02, & !12 + 1.125136e-02, 1.088901e-02, 1.055827e-02, 1.025531e-02, 9.976896e-03, & !12 + 9.720255e-03, 9.483022e-03, 9.263160e-03, 9.058902e-03, 8.868710e-03, & !12 + 8.691240e-03, 8.525312e-03, 8.369886e-03, 8.224042e-03, 8.086961e-03, & !12 + 7.957917e-03, 7.836258e-03, 7.721400e-03, 7.612821e-03, 7.510045e-03, & !12 + 7.412648e-03, 7.320242e-03, 7.232476e-03, & !12 + 1.437021e-01, 8.872535e-02, 6.392420e-02, 4.991833e-02, 4.096790e-02, & !13 + 3.477881e-02, 3.025782e-02, 2.681909e-02, 2.412102e-02, 2.195132e-02, & !13 + 2.017124e-02, 1.868641e-02, 1.743044e-02, 1.635529e-02, 1.542540e-02, & !13 + 1.461388e-02, 1.390003e-02, 1.326766e-02, 1.270395e-02, 1.219860e-02, & !13 + 1.174326e-02, 1.133107e-02, 1.095637e-02, 1.061442e-02, 1.030126e-02, & !13 + 1.001352e-02, 9.748340e-03, 9.503256e-03, 9.276155e-03, 9.065205e-03, & !13 + 8.868808e-03, 8.685571e-03, 8.514268e-03, 8.353820e-03, 8.203272e-03, & !13 + 8.061776e-03, 7.928578e-03, 7.803001e-03, 7.684443e-03, 7.572358e-03, & !13 + 7.466258e-03, 7.365701e-03, 7.270286e-03, & !13 + 1.288870e-01, 8.160295e-02, 5.964745e-02, 4.703790e-02, 3.888637e-02, & !14 + 3.320115e-02, 2.902017e-02, 2.582259e-02, 2.330224e-02, 2.126754e-02, & !14 + 1.959258e-02, 1.819130e-02, 1.700289e-02, 1.598320e-02, 1.509942e-02, & !14 + 1.432666e-02, 1.364572e-02, 1.304156e-02, 1.250220e-02, 1.201803e-02, & !14 + 1.158123e-02, 1.118537e-02, 1.082513e-02, 1.049605e-02, 1.019440e-02, & !14 + 9.916989e-03, 9.661116e-03, 9.424457e-03, 9.205005e-03, 9.001022e-03, & !14 + 8.810992e-03, 8.633588e-03, 8.467646e-03, 8.312137e-03, 8.166151e-03, & !14 + 8.028878e-03, 7.899597e-03, 7.777663e-03, 7.662498e-03, 7.553581e-03, & !14 + 7.450444e-03, 7.352662e-03, 7.259851e-03, & !14 + 8.254229e-02, 5.808787e-02, 4.492166e-02, 3.675028e-02, 3.119623e-02, & !15 + 2.718045e-02, 2.414450e-02, 2.177073e-02, 1.986526e-02, 1.830306e-02, & !15 + 1.699991e-02, 1.589698e-02, 1.495199e-02, 1.413374e-02, 1.341870e-02, & !15 + 1.278883e-02, 1.223002e-02, 1.173114e-02, 1.128322e-02, 1.087900e-02, & !15 + 1.051254e-02, 1.017890e-02, 9.873991e-03, 9.594347e-03, 9.337044e-03, & !15 + 9.099589e-03, 8.879842e-03, 8.675960e-03, 8.486341e-03, 8.309594e-03, & !15 + 8.144500e-03, 7.989986e-03, 7.845109e-03, 7.709031e-03, 7.581007e-03, & !15 + 7.460376e-03, 7.346544e-03, 7.238978e-03, 7.137201e-03, 7.040780e-03, & !15 + 6.949325e-03, 6.862483e-03, 6.779931e-03, & !15 + 1.382062e-01, 8.643227e-02, 6.282935e-02, 4.934783e-02, 4.063891e-02, & !16 + 3.455591e-02, 3.007059e-02, 2.662897e-02, 2.390631e-02, 2.169972e-02, & !16 + 1.987596e-02, 1.834393e-02, 1.703924e-02, 1.591513e-02, 1.493679e-02, & !16 + 1.407780e-02, 1.331775e-02, 1.264061e-02, 1.203364e-02, 1.148655e-02, & !16 + 1.099099e-02, 1.054006e-02, 1.012807e-02, 9.750215e-03, 9.402477e-03, & !16 + 9.081428e-03, 8.784143e-03, 8.508107e-03, 8.251146e-03, 8.011373e-03, & !16 + 7.787140e-03, 7.577002e-03, 7.379687e-03, 7.194071e-03, 7.019158e-03, & !16 + 6.854061e-03, 6.697986e-03, 6.550224e-03, 6.410138e-03, 6.277153e-03, & !16 + 6.150751e-03, 6.030462e-03, 5.915860e-03/), & !16 + shape=(/43,nBandsLW_RRTMG/)) + + real(kind_phys) , dimension(46,nBandsLW_RRTMG),parameter :: & + absice3 = reshape(source=(/ & + 3.110649e-03, 4.666352e-02, 6.606447e-02, 6.531678e-02, 6.012598e-02, & !1 + 5.437494e-02, 4.906411e-02, 4.441146e-02, 4.040585e-02, 3.697334e-02, & !1 + 3.403027e-02, 3.149979e-02, 2.931596e-02, 2.742365e-02, 2.577721e-02, & !1 + 2.433888e-02, 2.307732e-02, 2.196644e-02, 2.098437e-02, 2.011264e-02, & !1 + 1.933561e-02, 1.863992e-02, 1.801407e-02, 1.744812e-02, 1.693346e-02, & !1 + 1.646252e-02, 1.602866e-02, 1.562600e-02, 1.524933e-02, 1.489399e-02, & !1 + 1.455580e-02, 1.423098e-02, 1.391612e-02, 1.360812e-02, 1.330413e-02, & !1 + 1.300156e-02, 1.269801e-02, 1.239127e-02, 1.207928e-02, 1.176014e-02, & !1 + 1.143204e-02, 1.109334e-02, 1.074243e-02, 1.037786e-02, 9.998198e-03, & !1 + 9.602126e-03, & !1 + 3.984966e-04, 1.681097e-02, 2.627680e-02, 2.767465e-02, 2.700722e-02, & !2 + 2.579180e-02, 2.448677e-02, 2.323890e-02, 2.209096e-02, 2.104882e-02, & !2 + 2.010547e-02, 1.925003e-02, 1.847128e-02, 1.775883e-02, 1.710358e-02, & !2 + 1.649769e-02, 1.593449e-02, 1.540829e-02, 1.491429e-02, 1.444837e-02, & !2 + 1.400704e-02, 1.358729e-02, 1.318654e-02, 1.280258e-02, 1.243346e-02, & !2 + 1.207750e-02, 1.173325e-02, 1.139941e-02, 1.107487e-02, 1.075861e-02, & !2 + 1.044975e-02, 1.014753e-02, 9.851229e-03, 9.560240e-03, 9.274003e-03, & !2 + 8.992020e-03, 8.713845e-03, 8.439074e-03, 8.167346e-03, 7.898331e-03, & !2 + 7.631734e-03, 7.367286e-03, 7.104742e-03, 6.843882e-03, 6.584504e-03, & !2 + 6.326424e-03, & !2 + 6.933163e-02, 8.540475e-02, 7.701816e-02, 6.771158e-02, 5.986953e-02, & !3 + 5.348120e-02, 4.824962e-02, 4.390563e-02, 4.024411e-02, 3.711404e-02, & !3 + 3.440426e-02, 3.203200e-02, 2.993478e-02, 2.806474e-02, 2.638464e-02, & !3 + 2.486516e-02, 2.348288e-02, 2.221890e-02, 2.105780e-02, 1.998687e-02, & !3 + 1.899552e-02, 1.807490e-02, 1.721750e-02, 1.641693e-02, 1.566773e-02, & !3 + 1.496515e-02, 1.430509e-02, 1.368398e-02, 1.309865e-02, 1.254634e-02, & !3 + 1.202456e-02, 1.153114e-02, 1.106409e-02, 1.062166e-02, 1.020224e-02, & !3 + 9.804381e-03, 9.426771e-03, 9.068205e-03, 8.727578e-03, 8.403876e-03, & !3 + 8.096160e-03, 7.803564e-03, 7.525281e-03, 7.260560e-03, 7.008697e-03, & !3 + 6.769036e-03, & !3 + 1.765735e-01, 1.382700e-01, 1.095129e-01, 8.987475e-02, 7.591185e-02, & !4 + 6.554169e-02, 5.755500e-02, 5.122083e-02, 4.607610e-02, 4.181475e-02, & !4 + 3.822697e-02, 3.516432e-02, 3.251897e-02, 3.021073e-02, 2.817876e-02, & !4 + 2.637607e-02, 2.476582e-02, 2.331871e-02, 2.201113e-02, 2.082388e-02, & !4 + 1.974115e-02, 1.874983e-02, 1.783894e-02, 1.699922e-02, 1.622280e-02, & !4 + 1.550296e-02, 1.483390e-02, 1.421064e-02, 1.362880e-02, 1.308460e-02, & !4 + 1.257468e-02, 1.209611e-02, 1.164628e-02, 1.122287e-02, 1.082381e-02, & !4 + 1.044725e-02, 1.009154e-02, 9.755166e-03, 9.436783e-03, 9.135163e-03, & !4 + 8.849193e-03, 8.577856e-03, 8.320225e-03, 8.075451e-03, 7.842755e-03, & !4 + 7.621418e-03, & !4 + 2.339673e-01, 1.692124e-01, 1.291656e-01, 1.033837e-01, 8.562949e-02, & !5 + 7.273526e-02, 6.298262e-02, 5.537015e-02, 4.927787e-02, 4.430246e-02, & !5 + 4.017061e-02, 3.669072e-02, 3.372455e-02, 3.116995e-02, 2.894977e-02, & !5 + 2.700471e-02, 2.528842e-02, 2.376420e-02, 2.240256e-02, 2.117959e-02, & !5 + 2.007567e-02, 1.907456e-02, 1.816271e-02, 1.732874e-02, 1.656300e-02, & !5 + 1.585725e-02, 1.520445e-02, 1.459852e-02, 1.403419e-02, 1.350689e-02, & !5 + 1.301260e-02, 1.254781e-02, 1.210941e-02, 1.169468e-02, 1.130118e-02, & !5 + 1.092675e-02, 1.056945e-02, 1.022757e-02, 9.899560e-03, 9.584021e-03, & !5 + 9.279705e-03, 8.985479e-03, 8.700322e-03, 8.423306e-03, 8.153590e-03, & !5 + 7.890412e-03, & !5 + 1.145369e-01, 1.174566e-01, 9.917866e-02, 8.332990e-02, 7.104263e-02, & !6 + 6.153370e-02, 5.405472e-02, 4.806281e-02, 4.317918e-02, 3.913795e-02, & !6 + 3.574916e-02, 3.287437e-02, 3.041067e-02, 2.828017e-02, 2.642292e-02, & !6 + 2.479206e-02, 2.335051e-02, 2.206851e-02, 2.092195e-02, 1.989108e-02, & !6 + 1.895958e-02, 1.811385e-02, 1.734245e-02, 1.663573e-02, 1.598545e-02, & !6 + 1.538456e-02, 1.482700e-02, 1.430750e-02, 1.382150e-02, 1.336499e-02, & !6 + 1.293447e-02, 1.252685e-02, 1.213939e-02, 1.176968e-02, 1.141555e-02, & !6 + 1.107508e-02, 1.074655e-02, 1.042839e-02, 1.011923e-02, 9.817799e-03, & !6 + 9.522962e-03, 9.233688e-03, 8.949041e-03, 8.668171e-03, 8.390301e-03, & !6 + 8.114723e-03, & !6 + 1.222345e-02, 5.344230e-02, 5.523465e-02, 5.128759e-02, 4.676925e-02, & !7 + 4.266150e-02, 3.910561e-02, 3.605479e-02, 3.342843e-02, 3.115052e-02, & !7 + 2.915776e-02, 2.739935e-02, 2.583499e-02, 2.443266e-02, 2.316681e-02, & !7 + 2.201687e-02, 2.096619e-02, 2.000112e-02, 1.911044e-02, 1.828481e-02, & !7 + 1.751641e-02, 1.679866e-02, 1.612598e-02, 1.549360e-02, 1.489742e-02, & !7 + 1.433392e-02, 1.380002e-02, 1.329305e-02, 1.281068e-02, 1.235084e-02, & !7 + 1.191172e-02, 1.149171e-02, 1.108936e-02, 1.070341e-02, 1.033271e-02, & !7 + 9.976220e-03, 9.633021e-03, 9.302273e-03, 8.983216e-03, 8.675161e-03, & !7 + 8.377478e-03, 8.089595e-03, 7.810986e-03, 7.541170e-03, 7.279706e-03, & !7 + 7.026186e-03, & !7 + 6.711058e-02, 6.918198e-02, 6.127484e-02, 5.411944e-02, 4.836902e-02, & !8 + 4.375293e-02, 3.998077e-02, 3.683587e-02, 3.416508e-02, 3.186003e-02, & !8 + 2.984290e-02, 2.805671e-02, 2.645895e-02, 2.501733e-02, 2.370689e-02, & !8 + 2.250808e-02, 2.140532e-02, 2.038609e-02, 1.944018e-02, 1.855918e-02, & !8 + 1.773609e-02, 1.696504e-02, 1.624106e-02, 1.555990e-02, 1.491793e-02, & !8 + 1.431197e-02, 1.373928e-02, 1.319743e-02, 1.268430e-02, 1.219799e-02, & !8 + 1.173682e-02, 1.129925e-02, 1.088393e-02, 1.048961e-02, 1.011516e-02, & !8 + 9.759543e-03, 9.421813e-03, 9.101089e-03, 8.796559e-03, 8.507464e-03, & !8 + 8.233098e-03, 7.972798e-03, 7.725942e-03, 7.491940e-03, 7.270238e-03, & !8 + 7.060305e-03, & !8 + 1.236780e-01, 9.222386e-02, 7.383997e-02, 6.204072e-02, 5.381029e-02, & !9 + 4.770678e-02, 4.296928e-02, 3.916131e-02, 3.601540e-02, 3.335878e-02, & !9 + 3.107493e-02, 2.908247e-02, 2.732282e-02, 2.575276e-02, 2.433968e-02, & !9 + 2.305852e-02, 2.188966e-02, 2.081757e-02, 1.982974e-02, 1.891599e-02, & !9 + 1.806794e-02, 1.727865e-02, 1.654227e-02, 1.585387e-02, 1.520924e-02, & !9 + 1.460476e-02, 1.403730e-02, 1.350416e-02, 1.300293e-02, 1.253153e-02, & !9 + 1.208808e-02, 1.167094e-02, 1.127862e-02, 1.090979e-02, 1.056323e-02, & !9 + 1.023786e-02, 9.932665e-03, 9.646744e-03, 9.379250e-03, 9.129409e-03, & !9 + 8.896500e-03, 8.679856e-03, 8.478852e-03, 8.292904e-03, 8.121463e-03, & !9 + 7.964013e-03, & !9 + 1.655966e-01, 1.134205e-01, 8.714344e-02, 7.129241e-02, 6.063739e-02, & !10 + 5.294203e-02, 4.709309e-02, 4.247476e-02, 3.871892e-02, 3.559206e-02, & !10 + 3.293893e-02, 3.065226e-02, 2.865558e-02, 2.689288e-02, 2.532221e-02, & !10 + 2.391150e-02, 2.263582e-02, 2.147549e-02, 2.041476e-02, 1.944089e-02, & !10 + 1.854342e-02, 1.771371e-02, 1.694456e-02, 1.622989e-02, 1.556456e-02, & !10 + 1.494415e-02, 1.436491e-02, 1.382354e-02, 1.331719e-02, 1.284339e-02, & !10 + 1.239992e-02, 1.198486e-02, 1.159647e-02, 1.123323e-02, 1.089375e-02, & !10 + 1.057679e-02, 1.028124e-02, 1.000607e-02, 9.750376e-03, 9.513303e-03, & !10 + 9.294082e-03, 9.092003e-03, 8.906412e-03, 8.736702e-03, 8.582314e-03, & !10 + 8.442725e-03, & !10 + 1.775615e-01, 1.180046e-01, 8.929607e-02, 7.233500e-02, 6.108333e-02, & !11 + 5.303642e-02, 4.696927e-02, 4.221206e-02, 3.836768e-02, 3.518576e-02, & !11 + 3.250063e-02, 3.019825e-02, 2.819758e-02, 2.643943e-02, 2.487953e-02, & !11 + 2.348414e-02, 2.222705e-02, 2.108762e-02, 2.004936e-02, 1.909892e-02, & !11 + 1.822539e-02, 1.741975e-02, 1.667449e-02, 1.598330e-02, 1.534084e-02, & !11 + 1.474253e-02, 1.418446e-02, 1.366325e-02, 1.317597e-02, 1.272004e-02, & !11 + 1.229321e-02, 1.189350e-02, 1.151915e-02, 1.116859e-02, 1.084042e-02, & !11 + 1.053338e-02, 1.024636e-02, 9.978326e-03, 9.728357e-03, 9.495613e-03, & !11 + 9.279327e-03, 9.078798e-03, 8.893383e-03, 8.722488e-03, 8.565568e-03, & !11 + 8.422115e-03, & !11 + 9.465447e-02, 6.432047e-02, 5.060973e-02, 4.267283e-02, 3.741843e-02, & !12 + 3.363096e-02, 3.073531e-02, 2.842405e-02, 2.651789e-02, 2.490518e-02, & !12 + 2.351273e-02, 2.229056e-02, 2.120335e-02, 2.022541e-02, 1.933763e-02, & !12 + 1.852546e-02, 1.777763e-02, 1.708528e-02, 1.644134e-02, 1.584009e-02, & !12 + 1.527684e-02, 1.474774e-02, 1.424955e-02, 1.377957e-02, 1.333549e-02, & !12 + 1.291534e-02, 1.251743e-02, 1.214029e-02, 1.178265e-02, 1.144337e-02, & !12 + 1.112148e-02, 1.081609e-02, 1.052642e-02, 1.025178e-02, 9.991540e-03, & !12 + 9.745130e-03, 9.512038e-03, 9.291797e-03, 9.083980e-03, 8.888195e-03, & !12 + 8.704081e-03, 8.531306e-03, 8.369560e-03, 8.218558e-03, 8.078032e-03, & !12 + 7.947730e-03, & !12 + 1.560311e-01, 9.961097e-02, 7.502949e-02, 6.115022e-02, 5.214952e-02, & !13 + 4.578149e-02, 4.099731e-02, 3.724174e-02, 3.419343e-02, 3.165356e-02, & !13 + 2.949251e-02, 2.762222e-02, 2.598073e-02, 2.452322e-02, 2.321642e-02, & !13 + 2.203516e-02, 2.096002e-02, 1.997579e-02, 1.907036e-02, 1.823401e-02, & !13 + 1.745879e-02, 1.673819e-02, 1.606678e-02, 1.544003e-02, 1.485411e-02, & !13 + 1.430574e-02, 1.379215e-02, 1.331092e-02, 1.285996e-02, 1.243746e-02, & !13 + 1.204183e-02, 1.167164e-02, 1.132567e-02, 1.100281e-02, 1.070207e-02, & !13 + 1.042258e-02, 1.016352e-02, 9.924197e-03, 9.703953e-03, 9.502199e-03, & !13 + 9.318400e-03, 9.152066e-03, 9.002749e-03, 8.870038e-03, 8.753555e-03, & !13 + 8.652951e-03, & !13 + 1.559547e-01, 9.896700e-02, 7.441231e-02, 6.061469e-02, 5.168730e-02, & !14 + 4.537821e-02, 4.064106e-02, 3.692367e-02, 3.390714e-02, 3.139438e-02, & !14 + 2.925702e-02, 2.740783e-02, 2.578547e-02, 2.434552e-02, 2.305506e-02, & !14 + 2.188910e-02, 2.082842e-02, 1.985789e-02, 1.896553e-02, 1.814165e-02, & !14 + 1.737839e-02, 1.666927e-02, 1.600891e-02, 1.539279e-02, 1.481712e-02, & !14 + 1.427865e-02, 1.377463e-02, 1.330266e-02, 1.286068e-02, 1.244689e-02, & !14 + 1.205973e-02, 1.169780e-02, 1.135989e-02, 1.104492e-02, 1.075192e-02, & !14 + 1.048004e-02, 1.022850e-02, 9.996611e-03, 9.783753e-03, 9.589361e-03, & !14 + 9.412924e-03, 9.253977e-03, 9.112098e-03, 8.986903e-03, 8.878039e-03, & !14 + 8.785184e-03, & !14 + 1.102926e-01, 7.176622e-02, 5.530316e-02, 4.606056e-02, 4.006116e-02, & !15 + 3.579628e-02, 3.256909e-02, 3.001360e-02, 2.791920e-02, 2.615617e-02, & !15 + 2.464023e-02, 2.331426e-02, 2.213817e-02, 2.108301e-02, 2.012733e-02, & !15 + 1.925493e-02, 1.845331e-02, 1.771269e-02, 1.702531e-02, 1.638493e-02, & !15 + 1.578648e-02, 1.522579e-02, 1.469940e-02, 1.420442e-02, 1.373841e-02, & !15 + 1.329931e-02, 1.288535e-02, 1.249502e-02, 1.212700e-02, 1.178015e-02, & !15 + 1.145348e-02, 1.114612e-02, 1.085730e-02, 1.058633e-02, 1.033263e-02, & !15 + 1.009564e-02, 9.874895e-03, 9.669960e-03, 9.480449e-03, 9.306014e-03, & !15 + 9.146339e-03, 9.001138e-03, 8.870154e-03, 8.753148e-03, 8.649907e-03, & !15 + 8.560232e-03, & !15 + 1.688344e-01, 1.077072e-01, 7.994467e-02, 6.403862e-02, 5.369850e-02, & !16 + 4.641582e-02, 4.099331e-02, 3.678724e-02, 3.342069e-02, 3.065831e-02, & !16 + 2.834557e-02, 2.637680e-02, 2.467733e-02, 2.319286e-02, 2.188299e-02, & !16 + 2.071701e-02, 1.967121e-02, 1.872692e-02, 1.786931e-02, 1.708641e-02, & !16 + 1.636846e-02, 1.570743e-02, 1.509665e-02, 1.453052e-02, 1.400433e-02, & !16 + 1.351407e-02, 1.305631e-02, 1.262810e-02, 1.222688e-02, 1.185044e-02, & !16 + 1.149683e-02, 1.116436e-02, 1.085153e-02, 1.055701e-02, 1.027961e-02, & !16 + 1.001831e-02, 9.772141e-03, 9.540280e-03, 9.321966e-03, 9.116517e-03, & !16 + 8.923315e-03, 8.741803e-03, 8.571472e-03, 8.411860e-03, 8.262543e-03, & !16 + 8.123136e-03/), & !16 + shape=(/46,nBandsLW_RRTMG/)) +contains + ! ####################################################################################### + ! subroutine rrtmg_lw_cloud_optics + ! ####################################################################################### + subroutine rrtmg_lw_cloud_optics(ncol, nlay, nBandsLW, cld_lwp, cld_ref_liq, cld_iwp, & + cld_ref_ice, cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, cld_frac, tau_cld) + ! Inputs + integer,intent(in) :: & + nBandsLW, & ! Number of spectral bands + ncol, & ! Number of horizontal gridpoints + nlay ! Number of vertical layers + real(kind_phys), dimension(ncol,nlay), intent(in) :: & + cld_frac, & ! Cloud-fraction (1) + cld_lwp, & ! Cloud liquid water path (g/m2) + cld_ref_liq, & ! Effective radius (liquid) (micron) + cld_iwp, & ! Cloud ice water path (g/m2) + cld_ref_ice, & ! Effective radius (ice) (micron) + cld_rwp, & ! Cloud rain water path (g/m2) + cld_ref_rain, & ! Effective radius (rain-drop) (micron) + cld_swp, & ! Cloud snow-water path (g/m2) + cld_ref_snow ! Effective radius (snow-flake) (micron) + + ! Outputs + real(kind_phys),dimension(ncol,nlay,nBandsLW),intent(out) :: & + tau_cld + + ! Local variables + integer :: ij,ik,ib,index,ia + real(kind_phys) :: factor,fint,cld_ref_iceTemp,tau_snow, tau_rain + real(kind_phys),dimension(nBandsLW) :: tau_liq, tau_ice + + tau_cld(:,:,:) = 0._kind_phys + + if (ilwcliq .gt. 0) then + do ij=1,ncol + do ik=1,nlay + if (cld_frac(ij,ik) .gt. 0.) then + ! Rain optical-depth (No band dependence) + tau_rain = absrain*cld_rwp(ij,ik) + + ! Snow optical-depth (No band dependence) + if (cld_swp(ij,ik) .gt. 0. .and. cld_ref_snow(ij,ik) .gt. 10._kind_phys) then + tau_snow = abssnow0*1.05756*cld_swp(ij,ik)/cld_ref_snow(ij,ik) + else + tau_snow = 0. + endif + + ! Liquid water opitcal-depth + if (cld_lwp(ij,ik) .le. 0.) then + tau_liq(:) = 0. + else + if (ilwcliq .eq. 1) then + factor = cld_ref_liq(ij,ik) - 1.5 + index = max( 1, min( 57, int( factor ) )) + fint = factor - float(index) + do ib=1,nBandsLW + tau_liq(ib) = max(0., cld_lwp(ij,ik)*(absliq1(index,ib) + & + fint*(absliq1(index+1,ib)-absliq1(index,ib)) )) + enddo + endif + endif + + ! Ice water optical-depth + if (cld_iwp(ij,ik) .le. 0.) then + tau_ice(:) = 0. + else + ! 1) Ebert and curry approach for all particle sizes. (bound between 13-130microns) + if (ilwcice .eq. 1) then + cld_ref_iceTemp = min(130., max(13.,real(cld_ref_ice(ij,ik)))) + do ib=1,nBandsLW + ia = ipat(ib) ! eb_&_c band index for ice cloud coeff + tau_ice(ib) = max(0., cld_iwp(ij,ik)*(absice1(1,ia) + absice1(2,ia)/cld_ref_iceTemp) ) + enddo + + ! 2) Streamer approach for ice effective radius between 5.0 and 131.0 microns + ! and ebert and curry approach for ice eff radius greater than 131.0 microns. + ! no smoothing between the transition of the two methods + elseif (ilwcice .eq. 2) then + factor = (cld_ref_ice(ij,ik) - 2.) / 3. + index = max( 1, min( 42, int( factor ) )) + fint = factor - float(index) + do ib = 1, nBandsLW + tau_ice(ib) = max(0., cld_iwp(ij,ik)*(absice2(index,ib) + & + fint*(absice2(index+1,ib) - absice2(index,ib)) )) + enddo + ! 3) Fu's approach for ice effective radius between 4.8 and 135 microns + ! (generalized effective size from 5 to 140 microns) + elseif (ilwcice .eq. 3) then + cld_ref_iceTemp = max(5., 1.0315*cld_ref_ice(ij,ik)) ! v4.71 value + factor = (cld_ref_iceTemp - 2.) / 3. + index = max( 1, min( 45, int( factor ) )) + fint = factor - float(index) + do ib = 1, nBandsLW + tau_ice(ib) = max(0., cld_iwp(ij,ik)*(absice3(index,ib) + & + fint*(absice3(index+1,ib) - absice3(index,ib)) )) + enddo + endif + endif + else + tau_rain = 0. + tau_snow = 0. + tau_liq(:) = 0. + tau_ice(:) = 0. + endif + ! Cloud optical depth + do ib = 1, nBandsLW + tau_cld(ij,ik,ib) = tau_ice(ib) + tau_liq(ib) + tau_rain + tau_snow + enddo + end do + end do + endif + end subroutine rrtmg_lw_cloud_optics + ! ####################################################################################### + ! SUBROUTINE mcica_subcol_lw + ! ####################################################################################### + subroutine mcica_subcol_lw(ncol, nlay, ngpts, cld_frac, icseed, dzlyr, de_lgth, cld_frac_mcica) + ! Inputs + integer,intent(in) :: & + ncol, & ! Number of horizontal gridpoints + nlay, & ! Number of vertical layers + ngpts ! Number of spectral g-points + integer,dimension(ncol),intent(in) :: & + icseed ! Permutation seed for each column. + real(kind_phys), dimension(ncol), intent(in) :: & + de_lgth ! Cloud decorrelation length (km) + real(kind_phys), dimension(ncol,nlay), intent(in) :: & + cld_frac, & ! Cloud-fraction + dzlyr ! Layer thinkness (km) + ! Outputs + !real(kind_phys),dimension(ncol,nlay,ngpts),intent(out) :: & + logical,dimension(ncol,nlay,ngpts),intent(out) :: & + cld_frac_mcica + ! Local variables + type(random_stat) :: stat + integer :: icol,n,k,k1 + real(kind_phys) :: tem1 + real(kind_phys),dimension(ngpts) :: rand1D + real(kind_phys),dimension(nlay*ngpts) :: rand2D + real(kind_phys),dimension(ngpts,nlay) :: cdfunc,cdfun2 + real(kind_phys),dimension(nlay) :: fac_lcf + logical,dimension(ngpts,nlay) :: lcloudy + + ! Loop over all columns + do icol=1,ncol + ! Call random_setseed() to advance random number generator by "icseed" values. + call random_setseed(icseed(icol),stat) + + ! ################################################################################### + ! Sub-column set up according to overlapping assumption: + ! - For random overlap, pick a random value at every level + ! - For max-random overlap, pick a random value at every level + ! - For maximum overlap, pick same random numebr at every level + ! ################################################################################### + select case ( iovrlw ) + ! ################################################################################### + ! 0) Random overlap + ! ################################################################################### + case( 0 ) + call random_number(rand2D,stat) + k1 = 0 + do n = 1, ngpts + do k = 1, nlay + k1 = k1 + 1 + cdfunc(n,k) = rand2d(k1) + enddo + enddo + + ! ################################################################################### + ! 1) Maximum-random overlap + ! ################################################################################### + case(1) + call random_number(rand2D,stat) + k1 = 0 + do n = 1, ngpts + do k = 1, nlay + k1 = k1 + 1 + cdfunc(n,k) = rand2d(k1) + enddo + enddo + + ! First pick a random number for bottom (or top) layer. + ! then walk up the column: (aer's code) + ! if layer below is cloudy, use the same rand num in the layer below + ! if layer below is clear, use a new random number + do k = 2, nlay + k1 = k - 1 + tem1 = 1._kind_phys - cld_frac(icol,k1) + do n = 1, ngpts + if ( cdfunc(n,k1) > tem1 ) then + cdfunc(n,k) = cdfunc(n,k1) + else + cdfunc(n,k) = cdfunc(n,k) * tem1 + endif + enddo + enddo + + ! ################################################################################### + ! 2) Maximum overlap + ! ################################################################################### + case(2) + call random_number(rand1d,stat) + do n = 1, ngpts + tem1 = rand1d(n) + do k = 1, nlay + cdfunc(n,k) = tem1 + enddo + enddo + + ! ################################################################################### + ! 3) Decorrelation length + ! ################################################################################### + case(3) + ! Compute overlapping factors based on layer midpoint distances and decorrelation + ! depths + do k = nlay, 2, -1 + fac_lcf(k) = exp( -0.5 * (dzlyr(iCol,k)+dzlyr(iCol,k-1)) / de_lgth(iCol) ) + enddo + + ! Setup 2 sets of random numbers + call random_number ( rand2d, stat ) + k1 = 0 + do k = 1, nlay + do n = 1, ngpts + k1 = k1 + 1 + cdfunc(n,k) = rand2d(k1) + enddo + enddo + ! + call random_number ( rand2d, stat ) + k1 = 0 + do k = 1, nlay + do n = 1, ngpts + k1 = k1 + 1 + cdfun2(n,k) = rand2d(k1) + enddo + enddo + + ! Then working from the top down: + ! if a random number (from an independent set -cdfun2) is smaller then the + ! scale factor: use the upper layer's number, otherwise use a new random + ! number (keep the original assigned one). + do k = nlay-1, 1, -1 + k1 = k + 1 + do n = 1, ngpts + if ( cdfun2(n,k) <= fac_lcf(k1) ) then + cdfunc(n,k) = cdfunc(n,k1) + endif + enddo + enddo + + end select + + ! ################################################################################### + ! Generate subcolumn cloud mask (.false./.true. for clear/cloudy) + ! ################################################################################### + do k = 1, nlay + tem1 = 1._kind_phys - cld_frac(icol,k) + do n = 1, ngpts + lcloudy(n,k) = cdfunc(n,k) >= tem1 + if (lcloudy(n,k)) then + cld_frac_mcica(icol,k,n) = .true. + else + cld_frac_mcica(icol,k,n) = .false. + endif + enddo + enddo + enddo ! END LOOP OVER COLUMNS + end subroutine mcica_subcol_lw + +end module mo_rrtmg_lw_cloud_optics diff --git a/physics/rrtmg_lw_post.meta b/physics/rrtmg_lw_post.meta index 92b4003d7..8bca0597e 100644 --- a/physics/rrtmg_lw_post.meta +++ b/physics/rrtmg_lw_post.meta @@ -80,7 +80,7 @@ intent = in optional = F [htlwc] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step_and_radiation_levels long_name = total sky heating rate due to longwave radiation units = K s-1 dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) @@ -89,7 +89,7 @@ intent = in optional = F [htlw0] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step + standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels long_name = clear sky heating rate due to longwave radiation units = K s-1 dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) diff --git a/physics/rrtmg_sw_cloud_optics.F90 b/physics/rrtmg_sw_cloud_optics.F90 new file mode 100644 index 000000000..7ff57039e --- /dev/null +++ b/physics/rrtmg_sw_cloud_optics.F90 @@ -0,0 +1,2412 @@ +module mo_rrtmg_sw_cloud_optics + use machine, only: kind_phys + use physparam, only: iswcliq, iswcice, iovrsw + use mersenne_twister, only: random_setseed, random_number, random_stat + implicit none + + ! Parameters used for RRTMG cloud-optics + integer,parameter :: & + nBandsSW_RRTMG = 14 + real(kind_phys),parameter :: & + a0r = 3.07e-3 + real(kind_phys),dimension(nBandsSW_RRTMG),parameter :: & + b0r = (/0.466, 0.437, 0.416, 0.391, 0.374, 0.352, 0.183, & + 0.048, 0.012, 0.000, 0.000, 0.000, 0.000, 0.496/) + real(kind_phys),dimension(nBandsSW_RRTMG),parameter :: & + b0s = (/0.460, 0.460, 0.460, 0.460, 0.460, 0.460, 0.460, & + 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.460/) + real(kind_phys),dimension(nBandsSW_RRTMG),parameter :: & + b1s = (/0.000, 0.000, 0.000, 0.000, 0.000, 0.000, 0.000, & + 1.62e-5, 1.62e-5, 0.000, 0.000, 0.000, 0.000, 0.000/) + real(kind_phys),dimension(nBandsSW_RRTMG),parameter :: & + c0r = (/0.975, 0.965, 0.960, 0.955, 0.952, 0.950, 0.944, & + 0.894, 0.884, 0.883, 0.883, 0.883, 0.883, 0.980/) + real(kind_phys),dimension(nBandsSW_RRTMG),parameter :: & + c0s = (/0.970, 0.970, 0.970, 0.970, 0.970, 0.970, 0.970, & + 0.970, 0.970, 0.700, 0.700, 0.700, 0.700, 0.970/) + + ! RRTMG SW cloud property coefficients + ! Liquid + real(kind_phys),dimension(58,nBandsSW_RRTMG),parameter :: & ! + extliq1 = reshape(source= (/ & ! + 8.981463e-01, 6.317895e-01, 4.557508e-01, 3.481624e-01, 2.797950e-01, & ! 1 + 2.342753e-01, 2.026934e-01, 1.800102e-01, 1.632408e-01, 1.505384e-01, & ! + 1.354524e-01, 1.246520e-01, 1.154342e-01, 1.074756e-01, 1.005353e-01, & ! + 9.442987e-02, 8.901760e-02, 8.418693e-02, 7.984904e-02, 7.593229e-02, & ! + 7.237827e-02, 6.913887e-02, 6.617415e-02, 6.345061e-02, 6.094001e-02, & ! + 5.861834e-02, 5.646506e-02, 5.446250e-02, 5.249596e-02, 5.081114e-02, & ! + 4.922243e-02, 4.772189e-02, 4.630243e-02, 4.495766e-02, 4.368189e-02, & ! + 4.246995e-02, 4.131720e-02, 4.021941e-02, 3.917276e-02, 3.817376e-02, & ! + 3.721926e-02, 3.630635e-02, 3.543237e-02, 3.459491e-02, 3.379171e-02, & ! + 3.302073e-02, 3.228007e-02, 3.156798e-02, 3.088284e-02, 3.022315e-02, & ! + 2.958753e-02, 2.897468e-02, 2.838340e-02, 2.781258e-02, 2.726117e-02, & ! + 2.672821e-02, 2.621278e-02, 2.5714e-02, & ! + 8.293797e-01, 6.048371e-01, 4.465706e-01, 3.460387e-01, 2.800064e-01, & ! 2 + 2.346584e-01, 2.022399e-01, 1.782626e-01, 1.600153e-01, 1.457903e-01, & ! + 1.334061e-01, 1.228548e-01, 1.138396e-01, 1.060486e-01, 9.924856e-02, & ! + 9.326208e-02, 8.795158e-02, 8.320883e-02, 7.894750e-02, 7.509792e-02, & ! + 7.160323e-02, 6.841653e-02, 6.549889e-02, 6.281763e-02, 6.034516e-02, & ! + 5.805802e-02, 5.593615e-02, 5.396226e-02, 5.202302e-02, 5.036246e-02, & ! + 4.879606e-02, 4.731610e-02, 4.591565e-02, 4.458852e-02, 4.332912e-02, & ! + 4.213243e-02, 4.099390e-02, 3.990941e-02, 3.887522e-02, 3.788792e-02, & ! + 3.694440e-02, 3.604183e-02, 3.517760e-02, 3.434934e-02, 3.355485e-02, & ! + 3.279211e-02, 3.205925e-02, 3.135458e-02, 3.067648e-02, 3.002349e-02, & ! + 2.939425e-02, 2.878748e-02, 2.820200e-02, 2.763673e-02, 2.709062e-02, & ! + 2.656272e-02, 2.605214e-02, 2.5558e-02, & ! + 9.193685e-01, 6.128292e-01, 4.344150e-01, 3.303048e-01, 2.659500e-01, & ! 3 + 2.239727e-01, 1.953457e-01, 1.751012e-01, 1.603515e-01, 1.493360e-01, & ! + 1.323791e-01, 1.219335e-01, 1.130076e-01, 1.052926e-01, 9.855839e-02, & ! + 9.262925e-02, 8.736918e-02, 8.267112e-02, 7.844965e-02, 7.463585e-02, & ! + 7.117343e-02, 6.801601e-02, 6.512503e-02, 6.246815e-02, 6.001806e-02, & ! + 5.775154e-02, 5.564872e-02, 5.369250e-02, 5.176284e-02, 5.011536e-02, & ! + 4.856099e-02, 4.709211e-02, 4.570193e-02, 4.438430e-02, 4.313375e-02, & ! + 4.194529e-02, 4.081443e-02, 3.973712e-02, 3.870966e-02, 3.772866e-02, & ! + 3.679108e-02, 3.589409e-02, 3.503514e-02, 3.421185e-02, 3.342206e-02, & ! + 3.266377e-02, 3.193513e-02, 3.123447e-02, 3.056018e-02, 2.991081e-02, & ! + 2.928502e-02, 2.868154e-02, 2.809920e-02, 2.753692e-02, 2.699367e-02, & ! + 2.646852e-02, 2.596057e-02, 2.5469e-02, & ! + 9.136931e-01, 5.743244e-01, 4.080708e-01, 3.150572e-01, 2.577261e-01, & ! 4 + 2.197900e-01, 1.933037e-01, 1.740212e-01, 1.595056e-01, 1.482756e-01, & ! + 1.312164e-01, 1.209246e-01, 1.121227e-01, 1.045095e-01, 9.785967e-02, & ! + 9.200149e-02, 8.680170e-02, 8.215531e-02, 7.797850e-02, 7.420361e-02, & ! + 7.077530e-02, 6.764798e-02, 6.478369e-02, 6.215063e-02, 5.972189e-02, & ! + 5.747458e-02, 5.538913e-02, 5.344866e-02, 5.153216e-02, 4.989745e-02, & ! + 4.835476e-02, 4.689661e-02, 4.551629e-02, 4.420777e-02, 4.296563e-02, & ! + 4.178497e-02, 4.066137e-02, 3.959081e-02, 3.856963e-02, 3.759452e-02, & ! + 3.666244e-02, 3.577061e-02, 3.491650e-02, 3.409777e-02, 3.331227e-02, & ! + 3.255803e-02, 3.183322e-02, 3.113617e-02, 3.046530e-02, 2.981918e-02, & ! + 2.919646e-02, 2.859591e-02, 2.801635e-02, 2.745671e-02, 2.691599e-02, & ! + 2.639324e-02, 2.588759e-02, 2.5398e-02, & ! + 8.447548e-01, 5.326840e-01, 3.921523e-01, 3.119082e-01, 2.597055e-01, & ! 5 + 2.228737e-01, 1.954157e-01, 1.741155e-01, 1.570881e-01, 1.431520e-01, & ! + 1.302034e-01, 1.200491e-01, 1.113571e-01, 1.038330e-01, 9.725657e-02, & ! + 9.145949e-02, 8.631112e-02, 8.170840e-02, 7.756901e-02, 7.382641e-02, & ! + 7.042616e-02, 6.732338e-02, 6.448069e-02, 6.186672e-02, 5.945494e-02, & ! + 5.722277e-02, 5.515089e-02, 5.322262e-02, 5.132153e-02, 4.969799e-02, & ! + 4.816556e-02, 4.671686e-02, 4.534525e-02, 4.404480e-02, 4.281014e-02, & ! + 4.163643e-02, 4.051930e-02, 3.945479e-02, 3.843927e-02, 3.746945e-02, & ! + 3.654234e-02, 3.565518e-02, 3.480547e-02, 3.399088e-02, 3.320930e-02, & ! + 3.245876e-02, 3.173745e-02, 3.104371e-02, 3.037600e-02, 2.973287e-02, & ! + 2.911300e-02, 2.851516e-02, 2.793818e-02, 2.738101e-02, 2.684264e-02, & ! + 2.632214e-02, 2.581863e-02, 2.5331e-02, & ! + 7.727642e-01, 5.034865e-01, 3.808673e-01, 3.080333e-01, 2.586453e-01, & ! 6 + 2.224989e-01, 1.947060e-01, 1.725821e-01, 1.545096e-01, 1.394456e-01, & ! + 1.288683e-01, 1.188852e-01, 1.103317e-01, 1.029214e-01, 9.643967e-02, & ! + 9.072239e-02, 8.564194e-02, 8.109758e-02, 7.700875e-02, 7.331026e-02, & ! + 6.994879e-02, 6.688028e-02, 6.406807e-02, 6.148133e-02, 5.909400e-02, & ! + 5.688388e-02, 5.483197e-02, 5.292185e-02, 5.103763e-02, 4.942905e-02, & ! + 4.791039e-02, 4.647438e-02, 4.511453e-02, 4.382497e-02, 4.260043e-02, & ! + 4.143616e-02, 4.032784e-02, 3.927155e-02, 3.826375e-02, 3.730117e-02, & ! + 3.638087e-02, 3.550013e-02, 3.465646e-02, 3.384759e-02, 3.307141e-02, & ! + 3.232598e-02, 3.160953e-02, 3.092040e-02, 3.025706e-02, 2.961810e-02, & ! + 2.900220e-02, 2.840814e-02, 2.783478e-02, 2.728106e-02, 2.674599e-02, & ! + 2.622864e-02, 2.572816e-02, 2.5244e-02, & ! + 7.416833e-01, 4.959591e-01, 3.775057e-01, 3.056353e-01, 2.565943e-01, & ! 7 + 2.206935e-01, 1.931479e-01, 1.712860e-01, 1.534837e-01, 1.386906e-01, & ! + 1.281198e-01, 1.182344e-01, 1.097595e-01, 1.024137e-01, 9.598552e-02, & ! + 9.031320e-02, 8.527093e-02, 8.075927e-02, 7.669869e-02, 7.302481e-02, & ! + 6.968491e-02, 6.663542e-02, 6.384008e-02, 6.126838e-02, 5.889452e-02, & ! + 5.669654e-02, 5.465558e-02, 5.275540e-02, 5.087937e-02, 4.927904e-02, & ! + 4.776796e-02, 4.633895e-02, 4.498557e-02, 4.370202e-02, 4.248306e-02, & ! + 4.132399e-02, 4.022052e-02, 3.916878e-02, 3.816523e-02, 3.720665e-02, & ! + 3.629011e-02, 3.541290e-02, 3.457257e-02, 3.376685e-02, 3.299365e-02, & ! + 3.225105e-02, 3.153728e-02, 3.085069e-02, 3.018977e-02, 2.955310e-02, & ! + 2.893940e-02, 2.834742e-02, 2.777606e-02, 2.722424e-02, 2.669099e-02, & ! + 2.617539e-02, 2.567658e-02, 2.5194e-02, & ! + 7.058580e-01, 4.866573e-01, 3.712238e-01, 2.998638e-01, 2.513441e-01, & ! 8 + 2.161972e-01, 1.895576e-01, 1.686669e-01, 1.518437e-01, 1.380046e-01, & ! + 1.267564e-01, 1.170399e-01, 1.087026e-01, 1.014704e-01, 9.513729e-02, & ! + 8.954555e-02, 8.457221e-02, 8.012009e-02, 7.611136e-02, 7.248294e-02, & ! + 6.918317e-02, 6.616934e-02, 6.340584e-02, 6.086273e-02, 5.851465e-02, & ! + 5.634001e-02, 5.432027e-02, 5.243946e-02, 5.058070e-02, 4.899628e-02, & ! + 4.749975e-02, 4.608411e-02, 4.474303e-02, 4.347082e-02, 4.226237e-02, & ! + 4.111303e-02, 4.001861e-02, 3.897528e-02, 3.797959e-02, 3.702835e-02, & ! + 3.611867e-02, 3.524791e-02, 3.441364e-02, 3.361360e-02, 3.284577e-02, & ! + 3.210823e-02, 3.139923e-02, 3.071716e-02, 3.006052e-02, 2.942791e-02, & ! + 2.881806e-02, 2.822974e-02, 2.766185e-02, 2.711335e-02, 2.658326e-02, & ! + 2.607066e-02, 2.557473e-02, 2.5095e-02, & ! + 6.822779e-01, 4.750373e-01, 3.634834e-01, 2.940726e-01, 2.468060e-01, & ! 9 + 2.125768e-01, 1.866586e-01, 1.663588e-01, 1.500326e-01, 1.366192e-01, & ! + 1.253472e-01, 1.158052e-01, 1.076101e-01, 1.004954e-01, 9.426089e-02, & ! + 8.875268e-02, 8.385090e-02, 7.946063e-02, 7.550578e-02, 7.192466e-02, & ! + 6.866669e-02, 6.569001e-02, 6.295971e-02, 6.044642e-02, 5.812526e-02, & ! + 5.597500e-02, 5.397746e-02, 5.211690e-02, 5.027505e-02, 4.870703e-02, & ! + 4.722555e-02, 4.582373e-02, 4.449540e-02, 4.323497e-02, 4.203742e-02, & ! + 4.089821e-02, 3.981321e-02, 3.877867e-02, 3.779118e-02, 3.684762e-02, & ! + 3.594514e-02, 3.508114e-02, 3.425322e-02, 3.345917e-02, 3.269698e-02, & ! + 3.196477e-02, 3.126082e-02, 3.058352e-02, 2.993141e-02, 2.930310e-02, & ! + 2.869732e-02, 2.811289e-02, 2.754869e-02, 2.700371e-02, 2.647698e-02, & ! + 2.596760e-02, 2.547473e-02, 2.4998e-02, & ! + 6.666233e-01, 4.662044e-01, 3.579517e-01, 2.902984e-01, 2.440475e-01, & ! 10 + 2.104431e-01, 1.849277e-01, 1.648970e-01, 1.487555e-01, 1.354714e-01, & ! + 1.244173e-01, 1.149913e-01, 1.068903e-01, 9.985323e-02, 9.368351e-02, & ! + 8.823009e-02, 8.337507e-02, 7.902511e-02, 7.510529e-02, 7.155482e-02, & ! + 6.832386e-02, 6.537113e-02, 6.266218e-02, 6.016802e-02, 5.786408e-02, & ! + 5.572939e-02, 5.374598e-02, 5.189830e-02, 5.006825e-02, 4.851081e-02, & ! + 4.703906e-02, 4.564623e-02, 4.432621e-02, 4.307349e-02, 4.188312e-02, & ! + 4.075060e-02, 3.967183e-02, 3.864313e-02, 3.766111e-02, 3.672269e-02, & ! + 3.582505e-02, 3.496559e-02, 3.414196e-02, 3.335198e-02, 3.259362e-02, & ! + 3.186505e-02, 3.116454e-02, 3.049052e-02, 2.984152e-02, 2.921617e-02, & ! + 2.861322e-02, 2.803148e-02, 2.746986e-02, 2.692733e-02, 2.640295e-02, & ! + 2.589582e-02, 2.540510e-02, 2.4930e-02, & ! + 6.535669e-01, 4.585865e-01, 3.529226e-01, 2.867245e-01, 2.413848e-01, & ! 11 + 2.083956e-01, 1.833191e-01, 1.636150e-01, 1.477247e-01, 1.346392e-01, & ! + 1.236449e-01, 1.143095e-01, 1.062828e-01, 9.930773e-02, 9.319029e-02, & ! + 8.778150e-02, 8.296497e-02, 7.864847e-02, 7.475799e-02, 7.123343e-02, & ! + 6.802549e-02, 6.509332e-02, 6.240285e-02, 5.992538e-02, 5.763657e-02, & ! + 5.551566e-02, 5.354483e-02, 5.170870e-02, 4.988866e-02, 4.834061e-02, & ! + 4.687751e-02, 4.549264e-02, 4.417999e-02, 4.293410e-02, 4.175006e-02, & ! + 4.062344e-02, 3.955019e-02, 3.852663e-02, 3.754943e-02, 3.661553e-02, & ! + 3.572214e-02, 3.486669e-02, 3.404683e-02, 3.326040e-02, 3.250542e-02, & ! + 3.178003e-02, 3.108254e-02, 3.041139e-02, 2.976511e-02, 2.914235e-02, & ! + 2.854187e-02, 2.796247e-02, 2.740309e-02, 2.686271e-02, 2.634038e-02, & ! + 2.583520e-02, 2.534636e-02, 2.4873e-02, & ! + 6.448790e-01, 4.541425e-01, 3.503348e-01, 2.850494e-01, 2.401966e-01, & ! 12 + 2.074811e-01, 1.825631e-01, 1.629515e-01, 1.471142e-01, 1.340574e-01, & ! + 1.231462e-01, 1.138628e-01, 1.058802e-01, 9.894286e-02, 9.285818e-02, & ! + 8.747802e-02, 8.268676e-02, 7.839271e-02, 7.452230e-02, 7.101580e-02, & ! + 6.782418e-02, 6.490685e-02, 6.222991e-02, 5.976484e-02, 5.748742e-02, & ! + 5.537703e-02, 5.341593e-02, 5.158883e-02, 4.977355e-02, 4.823172e-02, & ! + 4.677430e-02, 4.539465e-02, 4.408680e-02, 4.284533e-02, 4.166539e-02, & ! + 4.054257e-02, 3.947283e-02, 3.845256e-02, 3.747842e-02, 3.654737e-02, & ! + 3.565665e-02, 3.480370e-02, 3.398620e-02, 3.320198e-02, 3.244908e-02, & ! + 3.172566e-02, 3.103002e-02, 3.036062e-02, 2.971600e-02, 2.909482e-02, & ! + 2.849582e-02, 2.791785e-02, 2.735982e-02, 2.682072e-02, 2.629960e-02, & ! + 2.579559e-02, 2.530786e-02, 2.4836e-02, & ! + 6.422688e-01, 4.528453e-01, 3.497232e-01, 2.847724e-01, 2.400815e-01, & ! 13 + 2.074403e-01, 1.825502e-01, 1.629415e-01, 1.470934e-01, 1.340183e-01, & ! + 1.230935e-01, 1.138049e-01, 1.058201e-01, 9.888245e-02, 9.279878e-02, & ! + 8.742053e-02, 8.263175e-02, 7.834058e-02, 7.447327e-02, 7.097000e-02, & ! + 6.778167e-02, 6.486765e-02, 6.219400e-02, 5.973215e-02, 5.745790e-02, & ! + 5.535059e-02, 5.339250e-02, 5.156831e-02, 4.975308e-02, 4.821235e-02, & ! + 4.675596e-02, 4.537727e-02, 4.407030e-02, 4.282968e-02, 4.165053e-02, & ! + 4.052845e-02, 3.945941e-02, 3.843980e-02, 3.746628e-02, 3.653583e-02, & ! + 3.564567e-02, 3.479326e-02, 3.397626e-02, 3.319253e-02, 3.244008e-02, & ! + 3.171711e-02, 3.102189e-02, 3.035289e-02, 2.970866e-02, 2.908784e-02, & ! + 2.848920e-02, 2.791156e-02, 2.735385e-02, 2.681507e-02, 2.629425e-02, & ! + 2.579053e-02, 2.530308e-02, 2.4831e-02, & ! + 4.614710e-01, 4.556116e-01, 4.056568e-01, 3.529833e-01, 3.060334e-01, & ! 14 + 2.658127e-01, 2.316095e-01, 2.024325e-01, 1.773749e-01, 1.556867e-01, & ! + 1.455558e-01, 1.332882e-01, 1.229052e-01, 1.140067e-01, 1.062981e-01, & ! + 9.955703e-02, 9.361333e-02, 8.833420e-02, 8.361467e-02, 7.937071e-02, & ! + 7.553420e-02, 7.204942e-02, 6.887031e-02, 6.595851e-02, 6.328178e-02, & ! + 6.081286e-02, 5.852854e-02, 5.640892e-02, 5.431269e-02, 5.252561e-02, & ! + 5.084345e-02, 4.925727e-02, 4.775910e-02, 4.634182e-02, 4.499907e-02, & ! + 4.372512e-02, 4.251484e-02, 4.136357e-02, 4.026710e-02, 3.922162e-02, & ! + 3.822365e-02, 3.727004e-02, 3.635790e-02, 3.548457e-02, 3.464764e-02, & ! + 3.384488e-02, 3.307424e-02, 3.233384e-02, 3.162192e-02, 3.093688e-02, & ! + 3.027723e-02, 2.964158e-02, 2.902864e-02, 2.843722e-02, 2.786621e-02, & ! + 2.731457e-02, 2.678133e-02, 2.6266e-02/), & ! + shape = (/58,nBandsSW_RRTMG/)) + + real(kind_phys),dimension(58,nBandsSW_RRTMG),parameter :: & ! + extliq2 = reshape(source= (/ & ! + 9.004493E-01, 6.366723E-01, 4.542354E-01, 3.468253E-01, 2.816431E-01, & ! 1 + 2.383415E-01, 2.070854E-01, 1.831854E-01, 1.642115E-01, 1.487539E-01, & ! + 1.359169E-01, 1.250900E-01, 1.158354E-01, 1.078400E-01, 1.008646E-01, & ! + 9.472307E-02, 8.928000E-02, 8.442308E-02, 8.005924E-02, 7.612231E-02, & ! + 7.255153E-02, 6.929539E-02, 6.631769E-02, 6.358153E-02, 6.106231E-02, & ! + 5.873077E-02, 5.656924E-02, 5.455769E-02, 5.267846E-02, 5.091923E-02, & ! + 4.926692E-02, 4.771154E-02, 4.623923E-02, 4.484385E-02, 4.351539E-02, & ! + 4.224615E-02, 4.103385E-02, 3.986538E-02, 3.874077E-02, 3.765462E-02, & ! + 3.660077E-02, 3.557384E-02, 3.457615E-02, 3.360308E-02, 3.265000E-02, & ! + 3.171770E-02, 3.080538E-02, 2.990846E-02, 2.903000E-02, 2.816461E-02, & ! + 2.731539E-02, 2.648231E-02, 2.566308E-02, 2.485923E-02, 2.407000E-02, & ! + 2.329615E-02, 2.253769E-02, 2.179615E-02, & ! + 6.741200e-01, 5.390739e-01, 4.198767e-01, 3.332553e-01, 2.735633e-01, & ! 2 + 2.317727e-01, 2.012760e-01, 1.780400e-01, 1.596927e-01, 1.447980e-01, & ! + 1.324480e-01, 1.220347e-01, 1.131327e-01, 1.054313e-01, 9.870534e-02, & ! + 9.278200e-02, 8.752599e-02, 8.282933e-02, 7.860600e-02, 7.479133e-02, & ! + 7.132800e-02, 6.816733e-02, 6.527401e-02, 6.261266e-02, 6.015934e-02, & ! + 5.788867e-02, 5.578134e-02, 5.381667e-02, 5.198133e-02, 5.026067e-02, & ! + 4.864466e-02, 4.712267e-02, 4.568066e-02, 4.431200e-02, 4.300867e-02, & ! + 4.176600e-02, 4.057400e-02, 3.942534e-02, 3.832066e-02, 3.725068e-02, & ! + 3.621400e-02, 3.520533e-02, 3.422333e-02, 3.326400e-02, 3.232467e-02, & ! + 3.140535e-02, 3.050400e-02, 2.962000e-02, 2.875267e-02, 2.789800e-02, & ! + 2.705934e-02, 2.623667e-02, 2.542667e-02, 2.463200e-02, 2.385267e-02, & ! + 2.308667e-02, 2.233667e-02, 2.160067e-02, & ! + 9.250861e-01, 6.245692e-01, 4.347038e-01, 3.320208e-01, 2.714869e-01, & ! 3 + 2.309516e-01, 2.012592e-01, 1.783315e-01, 1.600369e-01, 1.451000e-01, & ! + 1.326838e-01, 1.222069e-01, 1.132554e-01, 1.055146e-01, 9.876000e-02, & ! + 9.281386e-02, 8.754000e-02, 8.283078e-02, 7.860077e-02, 7.477769e-02, & ! + 7.130847e-02, 6.814461e-02, 6.524615e-02, 6.258462e-02, 6.012847e-02, & ! + 5.785462e-02, 5.574231e-02, 5.378000e-02, 5.194461e-02, 5.022462e-02, & ! + 4.860846e-02, 4.708462e-02, 4.564154e-02, 4.427462e-02, 4.297231e-02, & ! + 4.172769e-02, 4.053693e-02, 3.939000e-02, 3.828462e-02, 3.721692e-02, & ! + 3.618000e-02, 3.517077e-02, 3.418923e-02, 3.323077e-02, 3.229154e-02, & ! + 3.137154e-02, 3.047154e-02, 2.959077e-02, 2.872308e-02, 2.786846e-02, & ! + 2.703077e-02, 2.620923e-02, 2.540077e-02, 2.460615e-02, 2.382693e-02, & ! + 2.306231e-02, 2.231231e-02, 2.157923e-02, & ! + 9.298960e-01, 5.776460e-01, 4.083450e-01, 3.211160e-01, 2.666390e-01, & ! 4 + 2.281990e-01, 1.993250e-01, 1.768080e-01, 1.587810e-01, 1.440390e-01, & ! + 1.317720e-01, 1.214150e-01, 1.125540e-01, 1.048890e-01, 9.819600e-02, & ! + 9.230201e-02, 8.706900e-02, 8.239698e-02, 7.819500e-02, 7.439899e-02, & ! + 7.095300e-02, 6.780700e-02, 6.492900e-02, 6.228600e-02, 5.984600e-02, & ! + 5.758599e-02, 5.549099e-02, 5.353801e-02, 5.171400e-02, 5.000500e-02, & ! + 4.840000e-02, 4.688500e-02, 4.545100e-02, 4.409300e-02, 4.279700e-02, & ! + 4.156100e-02, 4.037700e-02, 3.923800e-02, 3.813800e-02, 3.707600e-02, & ! + 3.604500e-02, 3.504300e-02, 3.406500e-02, 3.310800e-02, 3.217700e-02, & ! + 3.126600e-02, 3.036800e-02, 2.948900e-02, 2.862400e-02, 2.777500e-02, & ! + 2.694200e-02, 2.612300e-02, 2.531700e-02, 2.452800e-02, 2.375100e-02, & ! + 2.299100e-02, 2.224300e-02, 2.151201e-02, & ! + 8.780964e-01, 5.407031e-01, 3.961100e-01, 3.166645e-01, 2.640455e-01, & ! 5 + 2.261070e-01, 1.974820e-01, 1.751775e-01, 1.573415e-01, 1.427725e-01, & ! + 1.306535e-01, 1.204195e-01, 1.116650e-01, 1.040915e-01, 9.747550e-02, & ! + 9.164800e-02, 8.647649e-02, 8.185501e-02, 7.770200e-02, 7.394749e-02, & ! + 7.053800e-02, 6.742700e-02, 6.457999e-02, 6.196149e-02, 5.954450e-02, & ! + 5.730650e-02, 5.522949e-02, 5.329450e-02, 5.148500e-02, 4.979000e-02, & ! + 4.819600e-02, 4.669301e-02, 4.527050e-02, 4.391899e-02, 4.263500e-02, & ! + 4.140500e-02, 4.022850e-02, 3.909500e-02, 3.800199e-02, 3.694600e-02, & ! + 3.592000e-02, 3.492250e-02, 3.395050e-02, 3.300150e-02, 3.207250e-02, & ! + 3.116250e-02, 3.027100e-02, 2.939500e-02, 2.853500e-02, 2.768900e-02, & ! + 2.686000e-02, 2.604350e-02, 2.524150e-02, 2.445350e-02, 2.368049e-02, & ! + 2.292150e-02, 2.217800e-02, 2.144800e-02, & ! + 7.937480e-01, 5.123036e-01, 3.858181e-01, 3.099622e-01, 2.586829e-01, & ! 6 + 2.217587e-01, 1.939755e-01, 1.723397e-01, 1.550258e-01, 1.408600e-01, & ! + 1.290545e-01, 1.190661e-01, 1.105039e-01, 1.030848e-01, 9.659387e-02, & ! + 9.086775e-02, 8.577807e-02, 8.122452e-02, 7.712711e-02, 7.342193e-02, & ! + 7.005387e-02, 6.697840e-02, 6.416000e-02, 6.156903e-02, 5.917484e-02, & ! + 5.695807e-02, 5.489968e-02, 5.298097e-02, 5.118806e-02, 4.950645e-02, & ! + 4.792710e-02, 4.643581e-02, 4.502484e-02, 4.368547e-02, 4.241001e-02, & ! + 4.118936e-02, 4.002193e-02, 3.889711e-02, 3.781322e-02, 3.676387e-02, & ! + 3.574549e-02, 3.475548e-02, 3.379033e-02, 3.284678e-02, 3.192420e-02, & ! + 3.102032e-02, 3.013484e-02, 2.926258e-02, 2.840839e-02, 2.756742e-02, & ! + 2.674258e-02, 2.593064e-02, 2.513258e-02, 2.435000e-02, 2.358064e-02, & ! + 2.282581e-02, 2.208548e-02, 2.135936e-02, & ! + 7.533129e-01, 5.033129e-01, 3.811271e-01, 3.062757e-01, 2.558729e-01, & ! 7 + 2.196828e-01, 1.924372e-01, 1.711714e-01, 1.541086e-01, 1.401114e-01, & ! + 1.284257e-01, 1.185200e-01, 1.100243e-01, 1.026529e-01, 9.620142e-02, & ! + 9.050714e-02, 8.544428e-02, 8.091714e-02, 7.684000e-02, 7.315429e-02, & ! + 6.980143e-02, 6.673999e-02, 6.394000e-02, 6.136000e-02, 5.897715e-02, & ! + 5.677000e-02, 5.472285e-02, 5.281286e-02, 5.102858e-02, 4.935429e-02, & ! + 4.778000e-02, 4.629714e-02, 4.489142e-02, 4.355857e-02, 4.228715e-02, & ! + 4.107285e-02, 3.990857e-02, 3.879000e-02, 3.770999e-02, 3.666429e-02, & ! + 3.565000e-02, 3.466286e-02, 3.370143e-02, 3.276143e-02, 3.184143e-02, & ! + 3.094000e-02, 3.005714e-02, 2.919000e-02, 2.833714e-02, 2.750000e-02, & ! + 2.667714e-02, 2.586714e-02, 2.507143e-02, 2.429143e-02, 2.352428e-02, & ! + 2.277143e-02, 2.203429e-02, 2.130857e-02, & ! + 7.079894e-01, 4.878198e-01, 3.719852e-01, 3.001873e-01, 2.514795e-01, & ! 8 + 2.163013e-01, 1.897100e-01, 1.689033e-01, 1.521793e-01, 1.384449e-01, & ! + 1.269666e-01, 1.172326e-01, 1.088745e-01, 1.016224e-01, 9.527085e-02, & ! + 8.966240e-02, 8.467543e-02, 8.021144e-02, 7.619344e-02, 7.255676e-02, & ! + 6.924996e-02, 6.623030e-02, 6.346261e-02, 6.091499e-02, 5.856325e-02, & ! + 5.638385e-02, 5.435930e-02, 5.247156e-02, 5.070699e-02, 4.905230e-02, & ! + 4.749499e-02, 4.602611e-02, 4.463581e-02, 4.331543e-02, 4.205647e-02, & ! + 4.085241e-02, 3.969978e-02, 3.859033e-02, 3.751877e-02, 3.648168e-02, & ! + 3.547468e-02, 3.449553e-02, 3.354072e-02, 3.260732e-02, 3.169438e-02, & ! + 3.079969e-02, 2.992146e-02, 2.905875e-02, 2.821201e-02, 2.737873e-02, & ! + 2.656052e-02, 2.575586e-02, 2.496511e-02, 2.418783e-02, 2.342500e-02, & ! + 2.267646e-02, 2.194177e-02, 2.122146e-02, & ! + 6.850164e-01, 4.762468e-01, 3.642001e-01, 2.946012e-01, 2.472001e-01, & ! 9 + 2.128588e-01, 1.868537e-01, 1.664893e-01, 1.501142e-01, 1.366620e-01, & ! + 1.254147e-01, 1.158721e-01, 1.076732e-01, 1.005530e-01, 9.431306e-02, & ! + 8.879891e-02, 8.389232e-02, 7.949714e-02, 7.553857e-02, 7.195474e-02, & ! + 6.869413e-02, 6.571444e-02, 6.298286e-02, 6.046779e-02, 5.814474e-02, & ! + 5.599141e-02, 5.399114e-02, 5.212443e-02, 5.037870e-02, 4.874321e-02, & ! + 4.720219e-02, 4.574813e-02, 4.437160e-02, 4.306460e-02, 4.181810e-02, & ! + 4.062603e-02, 3.948252e-02, 3.838256e-02, 3.732049e-02, 3.629192e-02, & ! + 3.529301e-02, 3.432190e-02, 3.337412e-02, 3.244842e-02, 3.154175e-02, & ! + 3.065253e-02, 2.978063e-02, 2.892367e-02, 2.808221e-02, 2.725478e-02, & ! + 2.644174e-02, 2.564175e-02, 2.485508e-02, 2.408303e-02, 2.332365e-02, & ! + 2.257890e-02, 2.184824e-02, 2.113224e-02, & ! + 6.673017e-01, 4.664520e-01, 3.579398e-01, 2.902234e-01, 2.439904e-01, & ! 10 + 2.104149e-01, 1.849277e-01, 1.649234e-01, 1.488087e-01, 1.355515e-01, & ! + 1.244562e-01, 1.150329e-01, 1.069321e-01, 9.989310e-02, 9.372070e-02, & ! + 8.826450e-02, 8.340622e-02, 7.905378e-02, 7.513109e-02, 7.157859e-02, & ! + 6.834588e-02, 6.539114e-02, 6.268150e-02, 6.018621e-02, 5.788098e-02, & ! + 5.574351e-02, 5.375699e-02, 5.190412e-02, 5.017099e-02, 4.854497e-02, & ! + 4.701490e-02, 4.557030e-02, 4.420249e-02, 4.290304e-02, 4.166427e-02, & ! + 4.047820e-02, 3.934232e-02, 3.824778e-02, 3.719236e-02, 3.616931e-02, & ! + 3.517597e-02, 3.420856e-02, 3.326566e-02, 3.234346e-02, 3.144122e-02, & ! + 3.055684e-02, 2.968798e-02, 2.883519e-02, 2.799635e-02, 2.717228e-02, & ! + 2.636182e-02, 2.556424e-02, 2.478114e-02, 2.401086e-02, 2.325657e-02, & ! + 2.251506e-02, 2.178594e-02, 2.107301e-02, & ! + 6.552414e-01, 4.599454e-01, 3.538626e-01, 2.873547e-01, 2.418033e-01, & ! 11 + 2.086660e-01, 1.834885e-01, 1.637142e-01, 1.477767e-01, 1.346583e-01, & ! + 1.236734e-01, 1.143412e-01, 1.063148e-01, 9.933905e-02, 9.322026e-02, & ! + 8.780979e-02, 8.299230e-02, 7.867554e-02, 7.478450e-02, 7.126053e-02, & ! + 6.805276e-02, 6.512143e-02, 6.243211e-02, 5.995541e-02, 5.766712e-02, & ! + 5.554484e-02, 5.357246e-02, 5.173222e-02, 5.001069e-02, 4.839505e-02, & ! + 4.687471e-02, 4.543861e-02, 4.407857e-02, 4.278577e-02, 4.155331e-02, & ! + 4.037322e-02, 3.924302e-02, 3.815376e-02, 3.710172e-02, 3.608296e-02, & ! + 3.509330e-02, 3.412980e-02, 3.319009e-02, 3.227106e-02, 3.137157e-02, & ! + 3.048950e-02, 2.962365e-02, 2.877297e-02, 2.793726e-02, 2.711500e-02, & ! + 2.630666e-02, 2.551206e-02, 2.473052e-02, 2.396287e-02, 2.320861e-02, & ! + 2.246810e-02, 2.174162e-02, 2.102927e-02, & ! + 6.430901e-01, 4.532134e-01, 3.496132e-01, 2.844655e-01, 2.397347e-01, & ! 12 + 2.071236e-01, 1.822976e-01, 1.627640e-01, 1.469961e-01, 1.340006e-01, & ! + 1.231069e-01, 1.138441e-01, 1.058706e-01, 9.893678e-02, 9.285166e-02, & ! + 8.746871e-02, 8.267411e-02, 7.837656e-02, 7.450257e-02, 7.099318e-02, & ! + 6.779929e-02, 6.487987e-02, 6.220168e-02, 5.973530e-02, 5.745636e-02, & ! + 5.534344e-02, 5.337986e-02, 5.154797e-02, 4.983404e-02, 4.822582e-02, & ! + 4.671228e-02, 4.528321e-02, 4.392997e-02, 4.264325e-02, 4.141647e-02, & ! + 4.024259e-02, 3.911767e-02, 3.803309e-02, 3.698782e-02, 3.597140e-02, & ! + 3.498774e-02, 3.402852e-02, 3.309340e-02, 3.217818e-02, 3.128292e-02, & ! + 3.040486e-02, 2.954230e-02, 2.869545e-02, 2.786261e-02, 2.704372e-02, & ! + 2.623813e-02, 2.544668e-02, 2.466788e-02, 2.390313e-02, 2.315136e-02, & ! + 2.241391e-02, 2.168921e-02, 2.097903e-02, & ! + 6.367074e-01, 4.495768e-01, 3.471263e-01, 2.826149e-01, 2.382868e-01, & ! 13 + 2.059640e-01, 1.813562e-01, 1.619881e-01, 1.463436e-01, 1.334402e-01, & ! + 1.226166e-01, 1.134096e-01, 1.054829e-01, 9.858838e-02, 9.253790e-02, & ! + 8.718582e-02, 8.241830e-02, 7.814482e-02, 7.429212e-02, 7.080165e-02, & ! + 6.762385e-02, 6.471838e-02, 6.205388e-02, 5.959726e-02, 5.732871e-02, & ! + 5.522402e-02, 5.326793e-02, 5.144230e-02, 4.973440e-02, 4.813188e-02, & ! + 4.662283e-02, 4.519798e-02, 4.384833e-02, 4.256541e-02, 4.134253e-02, & ! + 4.017136e-02, 3.904911e-02, 3.796779e-02, 3.692364e-02, 3.591182e-02, & ! + 3.492930e-02, 3.397230e-02, 3.303920e-02, 3.212572e-02, 3.123278e-02, & ! + 3.035519e-02, 2.949493e-02, 2.864985e-02, 2.781840e-02, 2.700197e-02, & ! + 2.619682e-02, 2.540674e-02, 2.462966e-02, 2.386613e-02, 2.311602e-02, & ! + 2.237846e-02, 2.165660e-02, 2.094756e-02, & ! + 4.298416e-01, 4.391639e-01, 3.975030e-01, 3.443028e-01, 2.957345e-01, & ! 14 + 2.556461e-01, 2.234755e-01, 1.976636e-01, 1.767428e-01, 1.595611e-01, & ! + 1.452636e-01, 1.332156e-01, 1.229481e-01, 1.141059e-01, 1.064208e-01, & ! + 9.968527e-02, 9.373833e-02, 8.845221e-02, 8.372112e-02, 7.946667e-02, & ! + 7.561807e-02, 7.212029e-02, 6.893166e-02, 6.600944e-02, 6.332277e-02, & ! + 6.084277e-02, 5.854721e-02, 5.641361e-02, 5.442639e-02, 5.256750e-02, & ! + 5.082499e-02, 4.918556e-02, 4.763694e-02, 4.617222e-02, 4.477861e-02, & ! + 4.344861e-02, 4.217999e-02, 4.096111e-02, 3.978638e-02, 3.865361e-02, & ! + 3.755473e-02, 3.649028e-02, 3.545361e-02, 3.444361e-02, 3.345666e-02, & ! + 3.249167e-02, 3.154722e-02, 3.062083e-02, 2.971250e-02, 2.882083e-02, & ! + 2.794611e-02, 2.708778e-02, 2.624500e-02, 2.541750e-02, 2.460528e-02, & ! + 2.381194e-02, 2.303250e-02, 2.226833e-02/), & ! + shape = (/58,nBandsSW_RRTMG/)) + + real(kind_phys),dimension(58,nBandsSW_RRTMG),parameter :: & ! + ssaliq1 = reshape(source= (/ & ! + 8.143821e-01, 7.836739e-01, 7.550722e-01, 7.306269e-01, 7.105612e-01, & ! 1 + 6.946649e-01, 6.825556e-01, 6.737762e-01, 6.678448e-01, 6.642830e-01, & ! + 6.679741e-01, 6.584607e-01, 6.505598e-01, 6.440951e-01, 6.388901e-01, & ! + 6.347689e-01, 6.315549e-01, 6.290718e-01, 6.271432e-01, 6.255928e-01, & ! + 6.242441e-01, 6.229207e-01, 6.214464e-01, 6.196445e-01, 6.173388e-01, & ! + 6.143527e-01, 6.105099e-01, 6.056339e-01, 6.108290e-01, 6.073939e-01, & ! + 6.043073e-01, 6.015473e-01, 5.990913e-01, 5.969173e-01, 5.950028e-01, & ! + 5.933257e-01, 5.918636e-01, 5.905944e-01, 5.894957e-01, 5.885453e-01, & ! + 5.877209e-01, 5.870003e-01, 5.863611e-01, 5.857811e-01, 5.852381e-01, & ! + 5.847098e-01, 5.841738e-01, 5.836081e-01, 5.829901e-01, 5.822979e-01, & ! + 5.815089e-01, 5.806011e-01, 5.795521e-01, 5.783396e-01, 5.769413e-01, & ! + 5.753351e-01, 5.734986e-01, 5.7141e-01, & ! + 8.165821e-01, 8.002015e-01, 7.816921e-01, 7.634131e-01, 7.463721e-01, & ! 2 + 7.312469e-01, 7.185883e-01, 7.088975e-01, 7.026671e-01, 7.004020e-01, & ! + 7.042138e-01, 6.960930e-01, 6.894243e-01, 6.840459e-01, 6.797957e-01, & ! + 6.765119e-01, 6.740325e-01, 6.721955e-01, 6.708391e-01, 6.698013e-01, & ! + 6.689201e-01, 6.680339e-01, 6.669805e-01, 6.655982e-01, 6.637250e-01, & ! + 6.611992e-01, 6.578588e-01, 6.535420e-01, 6.584449e-01, 6.553992e-01, & ! + 6.526547e-01, 6.501917e-01, 6.479905e-01, 6.460313e-01, 6.442945e-01, & ! + 6.427605e-01, 6.414094e-01, 6.402217e-01, 6.391775e-01, 6.382573e-01, & ! + 6.374413e-01, 6.367099e-01, 6.360433e-01, 6.354218e-01, 6.348257e-01, & ! + 6.342355e-01, 6.336313e-01, 6.329935e-01, 6.323023e-01, 6.315383e-01, & ! + 6.306814e-01, 6.297122e-01, 6.286110e-01, 6.273579e-01, 6.259333e-01, & ! + 6.243176e-01, 6.224910e-01, 6.2043e-01, & ! + 9.900163e-01, 9.854307e-01, 9.797730e-01, 9.733113e-01, 9.664245e-01, & ! 3 + 9.594976e-01, 9.529055e-01, 9.470112e-01, 9.421695e-01, 9.387304e-01, & ! + 9.344918e-01, 9.305302e-01, 9.267048e-01, 9.230072e-01, 9.194289e-01, & ! + 9.159616e-01, 9.125968e-01, 9.093260e-01, 9.061409e-01, 9.030330e-01, & ! + 8.999940e-01, 8.970154e-01, 8.940888e-01, 8.912058e-01, 8.883579e-01, & ! + 8.855368e-01, 8.827341e-01, 8.799413e-01, 8.777423e-01, 8.749566e-01, & ! + 8.722298e-01, 8.695605e-01, 8.669469e-01, 8.643875e-01, 8.618806e-01, & ! + 8.594246e-01, 8.570179e-01, 8.546589e-01, 8.523459e-01, 8.500773e-01, & ! + 8.478516e-01, 8.456670e-01, 8.435219e-01, 8.414148e-01, 8.393439e-01, & ! + 8.373078e-01, 8.353047e-01, 8.333330e-01, 8.313911e-01, 8.294774e-01, & ! + 8.275904e-01, 8.257282e-01, 8.238893e-01, 8.220721e-01, 8.202751e-01, & ! + 8.184965e-01, 8.167346e-01, 8.1499e-01, & ! + 9.999916e-01, 9.987396e-01, 9.966900e-01, 9.950738e-01, 9.937531e-01, & ! 4 + 9.925912e-01, 9.914525e-01, 9.902018e-01, 9.887046e-01, 9.868263e-01, & ! + 9.849039e-01, 9.832372e-01, 9.815265e-01, 9.797770e-01, 9.779940e-01, & ! + 9.761827e-01, 9.743481e-01, 9.724955e-01, 9.706303e-01, 9.687575e-01, & ! + 9.668823e-01, 9.650100e-01, 9.631457e-01, 9.612947e-01, 9.594622e-01, & ! + 9.576534e-01, 9.558734e-01, 9.541275e-01, 9.522059e-01, 9.504258e-01, & ! + 9.486459e-01, 9.468676e-01, 9.450921e-01, 9.433208e-01, 9.415548e-01, & ! + 9.397955e-01, 9.380441e-01, 9.363022e-01, 9.345706e-01, 9.328510e-01, & ! + 9.311445e-01, 9.294524e-01, 9.277761e-01, 9.261167e-01, 9.244755e-01, & ! + 9.228540e-01, 9.212534e-01, 9.196748e-01, 9.181197e-01, 9.165894e-01, & ! + 9.150851e-01, 9.136080e-01, 9.121596e-01, 9.107410e-01, 9.093536e-01, & ! + 9.079987e-01, 9.066775e-01, 9.0539e-01, & ! + 9.979493e-01, 9.964113e-01, 9.950014e-01, 9.937045e-01, 9.924964e-01, & ! 5 + 9.913546e-01, 9.902575e-01, 9.891843e-01, 9.881136e-01, 9.870238e-01, & ! + 9.859934e-01, 9.849372e-01, 9.838873e-01, 9.828434e-01, 9.818052e-01, & ! + 9.807725e-01, 9.797450e-01, 9.787225e-01, 9.777047e-01, 9.766914e-01, & ! + 9.756823e-01, 9.746771e-01, 9.736756e-01, 9.726775e-01, 9.716827e-01, & ! + 9.706907e-01, 9.697014e-01, 9.687145e-01, 9.678060e-01, 9.668108e-01, & ! + 9.658218e-01, 9.648391e-01, 9.638629e-01, 9.628936e-01, 9.619313e-01, & ! + 9.609763e-01, 9.600287e-01, 9.590888e-01, 9.581569e-01, 9.572330e-01, & ! + 9.563176e-01, 9.554108e-01, 9.545128e-01, 9.536239e-01, 9.527443e-01, & ! + 9.518741e-01, 9.510137e-01, 9.501633e-01, 9.493230e-01, 9.484931e-01, & ! + 9.476740e-01, 9.468656e-01, 9.460683e-01, 9.452824e-01, 9.445080e-01, & ! + 9.437454e-01, 9.429948e-01, 9.4226e-01, & ! + 9.988742e-01, 9.982668e-01, 9.976935e-01, 9.971497e-01, 9.966314e-01, & ! 6 + 9.961344e-01, 9.956545e-01, 9.951873e-01, 9.947286e-01, 9.942741e-01, & ! + 9.938457e-01, 9.933947e-01, 9.929473e-01, 9.925032e-01, 9.920621e-01, & ! + 9.916237e-01, 9.911875e-01, 9.907534e-01, 9.903209e-01, 9.898898e-01, & ! + 9.894597e-01, 9.890304e-01, 9.886015e-01, 9.881726e-01, 9.877435e-01, & ! + 9.873138e-01, 9.868833e-01, 9.864516e-01, 9.860698e-01, 9.856317e-01, & ! + 9.851957e-01, 9.847618e-01, 9.843302e-01, 9.839008e-01, 9.834739e-01, & ! + 9.830494e-01, 9.826275e-01, 9.822083e-01, 9.817918e-01, 9.813782e-01, & ! + 9.809675e-01, 9.805598e-01, 9.801552e-01, 9.797538e-01, 9.793556e-01, & ! + 9.789608e-01, 9.785695e-01, 9.781817e-01, 9.777975e-01, 9.774171e-01, & ! + 9.770404e-01, 9.766676e-01, 9.762988e-01, 9.759340e-01, 9.755733e-01, & ! + 9.752169e-01, 9.748649e-01, 9.7452e-01, & ! + 9.994441e-01, 9.991608e-01, 9.988949e-01, 9.986439e-01, 9.984054e-01, & ! 7 + 9.981768e-01, 9.979557e-01, 9.977396e-01, 9.975258e-01, 9.973120e-01, & ! + 9.971011e-01, 9.968852e-01, 9.966708e-01, 9.964578e-01, 9.962462e-01, & ! + 9.960357e-01, 9.958264e-01, 9.956181e-01, 9.954108e-01, 9.952043e-01, & ! + 9.949987e-01, 9.947937e-01, 9.945892e-01, 9.943853e-01, 9.941818e-01, & ! + 9.939786e-01, 9.937757e-01, 9.935728e-01, 9.933922e-01, 9.931825e-01, & ! + 9.929739e-01, 9.927661e-01, 9.925592e-01, 9.923534e-01, 9.921485e-01, & ! + 9.919447e-01, 9.917421e-01, 9.915406e-01, 9.913403e-01, 9.911412e-01, & ! + 9.909435e-01, 9.907470e-01, 9.905519e-01, 9.903581e-01, 9.901659e-01, & ! + 9.899751e-01, 9.897858e-01, 9.895981e-01, 9.894120e-01, 9.892276e-01, & ! + 9.890447e-01, 9.888637e-01, 9.886845e-01, 9.885070e-01, 9.883314e-01, & ! + 9.881576e-01, 9.879859e-01, 9.8782e-01, & ! + 9.999138e-01, 9.998730e-01, 9.998338e-01, 9.997965e-01, 9.997609e-01, & ! 8 + 9.997270e-01, 9.996944e-01, 9.996629e-01, 9.996321e-01, 9.996016e-01, & ! + 9.995690e-01, 9.995372e-01, 9.995057e-01, 9.994744e-01, 9.994433e-01, & ! + 9.994124e-01, 9.993817e-01, 9.993510e-01, 9.993206e-01, 9.992903e-01, & ! + 9.992600e-01, 9.992299e-01, 9.991998e-01, 9.991698e-01, 9.991398e-01, & ! + 9.991098e-01, 9.990799e-01, 9.990499e-01, 9.990231e-01, 9.989920e-01, & ! + 9.989611e-01, 9.989302e-01, 9.988996e-01, 9.988690e-01, 9.988386e-01, & ! + 9.988084e-01, 9.987783e-01, 9.987485e-01, 9.987187e-01, 9.986891e-01, & ! + 9.986598e-01, 9.986306e-01, 9.986017e-01, 9.985729e-01, 9.985443e-01, & ! + 9.985160e-01, 9.984879e-01, 9.984600e-01, 9.984324e-01, 9.984050e-01, & ! + 9.983778e-01, 9.983509e-01, 9.983243e-01, 9.982980e-01, 9.982719e-01, & ! + 9.982461e-01, 9.982206e-01, 9.9820e-01, & ! + 9.999985e-01, 9.999979e-01, 9.999972e-01, 9.999966e-01, 9.999961e-01, & ! 9 + 9.999955e-01, 9.999950e-01, 9.999944e-01, 9.999938e-01, 9.999933e-01, & ! + 9.999927e-01, 9.999921e-01, 9.999915e-01, 9.999910e-01, 9.999904e-01, & ! + 9.999899e-01, 9.999893e-01, 9.999888e-01, 9.999882e-01, 9.999877e-01, & ! + 9.999871e-01, 9.999866e-01, 9.999861e-01, 9.999855e-01, 9.999850e-01, & ! + 9.999844e-01, 9.999839e-01, 9.999833e-01, 9.999828e-01, 9.999823e-01, & ! + 9.999817e-01, 9.999812e-01, 9.999807e-01, 9.999801e-01, 9.999796e-01, & ! + 9.999791e-01, 9.999786e-01, 9.999781e-01, 9.999776e-01, 9.999770e-01, & ! + 9.999765e-01, 9.999761e-01, 9.999756e-01, 9.999751e-01, 9.999746e-01, & ! + 9.999741e-01, 9.999736e-01, 9.999732e-01, 9.999727e-01, 9.999722e-01, & ! + 9.999718e-01, 9.999713e-01, 9.999709e-01, 9.999705e-01, 9.999701e-01, & ! + 9.999697e-01, 9.999692e-01, 9.9997e-01, & ! + 9.999999e-01, 9.999998e-01, 9.999997e-01, 9.999997e-01, 9.999997e-01, & ! 10 + 9.999996e-01, 9.999996e-01, 9.999995e-01, 9.999995e-01, 9.999994e-01, & ! + 9.999994e-01, 9.999993e-01, 9.999993e-01, 9.999992e-01, 9.999992e-01, & ! + 9.999991e-01, 9.999991e-01, 9.999991e-01, 9.999990e-01, 9.999989e-01, & ! + 9.999989e-01, 9.999989e-01, 9.999988e-01, 9.999988e-01, 9.999987e-01, & ! + 9.999987e-01, 9.999986e-01, 9.999986e-01, 9.999985e-01, 9.999985e-01, & ! + 9.999984e-01, 9.999984e-01, 9.999984e-01, 9.999983e-01, 9.999983e-01, & ! + 9.999982e-01, 9.999982e-01, 9.999982e-01, 9.999981e-01, 9.999980e-01, & ! + 9.999980e-01, 9.999980e-01, 9.999979e-01, 9.999979e-01, 9.999978e-01, & ! + 9.999978e-01, 9.999977e-01, 9.999977e-01, 9.999977e-01, 9.999976e-01, & ! + 9.999976e-01, 9.999975e-01, 9.999975e-01, 9.999974e-01, 9.999974e-01, & ! + 9.999974e-01, 9.999973e-01, 1.0000e+00, & ! + 9.999997e-01, 9.999995e-01, 9.999993e-01, 9.999992e-01, 9.999990e-01, & ! 11 + 9.999989e-01, 9.999988e-01, 9.999987e-01, 9.999986e-01, 9.999985e-01, & ! + 9.999984e-01, 9.999983e-01, 9.999982e-01, 9.999981e-01, 9.999980e-01, & ! + 9.999978e-01, 9.999977e-01, 9.999976e-01, 9.999975e-01, 9.999974e-01, & ! + 9.999973e-01, 9.999972e-01, 9.999970e-01, 9.999969e-01, 9.999968e-01, & ! + 9.999967e-01, 9.999966e-01, 9.999965e-01, 9.999964e-01, 9.999963e-01, & ! + 9.999962e-01, 9.999961e-01, 9.999959e-01, 9.999958e-01, 9.999957e-01, & ! + 9.999956e-01, 9.999955e-01, 9.999954e-01, 9.999953e-01, 9.999952e-01, & ! + 9.999951e-01, 9.999949e-01, 9.999949e-01, 9.999947e-01, 9.999946e-01, & ! + 9.999945e-01, 9.999944e-01, 9.999943e-01, 9.999942e-01, 9.999941e-01, & ! + 9.999940e-01, 9.999939e-01, 9.999938e-01, 9.999937e-01, 9.999936e-01, & ! + 9.999935e-01, 9.999934e-01, 9.9999e-01, & ! + 9.999984e-01, 9.999976e-01, 9.999969e-01, 9.999962e-01, 9.999956e-01, & ! 12 + 9.999950e-01, 9.999945e-01, 9.999940e-01, 9.999935e-01, 9.999931e-01, & ! + 9.999926e-01, 9.999920e-01, 9.999914e-01, 9.999908e-01, 9.999903e-01, & ! + 9.999897e-01, 9.999891e-01, 9.999886e-01, 9.999880e-01, 9.999874e-01, & ! + 9.999868e-01, 9.999863e-01, 9.999857e-01, 9.999851e-01, 9.999846e-01, & ! + 9.999840e-01, 9.999835e-01, 9.999829e-01, 9.999824e-01, 9.999818e-01, & ! + 9.999812e-01, 9.999806e-01, 9.999800e-01, 9.999795e-01, 9.999789e-01, & ! + 9.999783e-01, 9.999778e-01, 9.999773e-01, 9.999767e-01, 9.999761e-01, & ! + 9.999756e-01, 9.999750e-01, 9.999745e-01, 9.999739e-01, 9.999734e-01, & ! + 9.999729e-01, 9.999723e-01, 9.999718e-01, 9.999713e-01, 9.999708e-01, & ! + 9.999703e-01, 9.999697e-01, 9.999692e-01, 9.999687e-01, 9.999683e-01, & ! + 9.999678e-01, 9.999673e-01, 9.9997e-01, & ! + 9.999981e-01, 9.999973e-01, 9.999965e-01, 9.999958e-01, 9.999951e-01, & ! 13 + 9.999943e-01, 9.999937e-01, 9.999930e-01, 9.999924e-01, 9.999918e-01, & ! + 9.999912e-01, 9.999905e-01, 9.999897e-01, 9.999890e-01, 9.999883e-01, & ! + 9.999876e-01, 9.999869e-01, 9.999862e-01, 9.999855e-01, 9.999847e-01, & ! + 9.999840e-01, 9.999834e-01, 9.999827e-01, 9.999819e-01, 9.999812e-01, & ! + 9.999805e-01, 9.999799e-01, 9.999791e-01, 9.999785e-01, 9.999778e-01, & ! + 9.999771e-01, 9.999764e-01, 9.999757e-01, 9.999750e-01, 9.999743e-01, & ! + 9.999736e-01, 9.999729e-01, 9.999722e-01, 9.999715e-01, 9.999709e-01, & ! + 9.999701e-01, 9.999695e-01, 9.999688e-01, 9.999682e-01, 9.999675e-01, & ! + 9.999669e-01, 9.999662e-01, 9.999655e-01, 9.999649e-01, 9.999642e-01, & ! + 9.999636e-01, 9.999630e-01, 9.999624e-01, 9.999618e-01, 9.999612e-01, & ! + 9.999606e-01, 9.999600e-01, 9.9996e-01, & ! + 8.505737e-01, 8.465102e-01, 8.394829e-01, 8.279508e-01, 8.110806e-01, & ! 14 + 7.900397e-01, 7.669615e-01, 7.444422e-01, 7.253055e-01, 7.124831e-01, & ! + 7.016434e-01, 6.885485e-01, 6.767340e-01, 6.661029e-01, 6.565577e-01, & ! + 6.480013e-01, 6.403373e-01, 6.334697e-01, 6.273034e-01, 6.217440e-01, & ! + 6.166983e-01, 6.120740e-01, 6.077796e-01, 6.037249e-01, 5.998207e-01, & ! + 5.959788e-01, 5.921123e-01, 5.881354e-01, 5.891285e-01, 5.851143e-01, & ! + 5.814653e-01, 5.781606e-01, 5.751792e-01, 5.724998e-01, 5.701016e-01, & ! + 5.679634e-01, 5.660642e-01, 5.643829e-01, 5.628984e-01, 5.615898e-01, & ! + 5.604359e-01, 5.594158e-01, 5.585083e-01, 5.576924e-01, 5.569470e-01, & ! + 5.562512e-01, 5.555838e-01, 5.549239e-01, 5.542503e-01, 5.535420e-01, & ! + 5.527781e-01, 5.519374e-01, 5.509989e-01, 5.499417e-01, 5.487445e-01, & ! + 5.473865e-01, 5.458466e-01, 5.4410e-01 /), & ! + shape = (/58,nBandsSW_RRTMG/)) + + real(kind_phys),dimension(58,nBandsSW_RRTMG),parameter :: & ! + ssaliq2 = reshape(source= (/ & ! + 8.362119e-01, 8.098460e-01, 7.762291e-01, 7.486042e-01, 7.294172e-01, & ! 1 + 7.161000e-01, 7.060656e-01, 6.978387e-01, 6.907193e-01, 6.843551e-01, & ! + 6.785668e-01, 6.732450e-01, 6.683191e-01, 6.637264e-01, 6.594307e-01, & ! + 6.554033e-01, 6.516115e-01, 6.480295e-01, 6.446429e-01, 6.414306e-01, & ! + 6.383783e-01, 6.354750e-01, 6.327068e-01, 6.300665e-01, 6.275376e-01, & ! + 6.251245e-01, 6.228136e-01, 6.205944e-01, 6.184720e-01, 6.164330e-01, & ! + 6.144742e-01, 6.125962e-01, 6.108004e-01, 6.090740e-01, 6.074200e-01, & ! + 6.058381e-01, 6.043209e-01, 6.028681e-01, 6.014836e-01, 6.001626e-01, & ! + 5.988957e-01, 5.976864e-01, 5.965390e-01, 5.954379e-01, 5.943972e-01, & ! + 5.934019e-01, 5.924624e-01, 5.915579e-01, 5.907025e-01, 5.898913e-01, & ! + 5.891213e-01, 5.883815e-01, 5.876851e-01, 5.870158e-01, 5.863868e-01, & ! + 5.857821e-01, 5.852111e-01, 5.846579e-01, & ! + 6.995459e-01, 7.158012e-01, 7.076001e-01, 6.927244e-01, 6.786434e-01, & ! 2 + 6.673545e-01, 6.585859e-01, 6.516314e-01, 6.459010e-01, 6.410225e-01, & ! + 6.367574e-01, 6.329554e-01, 6.295119e-01, 6.263595e-01, 6.234462e-01, & ! + 6.207274e-01, 6.181755e-01, 6.157678e-01, 6.134880e-01, 6.113173e-01, & ! + 6.092495e-01, 6.072689e-01, 6.053717e-01, 6.035507e-01, 6.018001e-01, & ! + 6.001134e-01, 5.984951e-01, 5.969294e-01, 5.954256e-01, 5.939698e-01, & ! + 5.925716e-01, 5.912265e-01, 5.899270e-01, 5.886771e-01, 5.874746e-01, & ! + 5.863185e-01, 5.852077e-01, 5.841460e-01, 5.831249e-01, 5.821474e-01, & ! + 5.812078e-01, 5.803173e-01, 5.794616e-01, 5.786443e-01, 5.778617e-01, & ! + 5.771236e-01, 5.764191e-01, 5.757400e-01, 5.750971e-01, 5.744842e-01, & ! + 5.739012e-01, 5.733482e-01, 5.728175e-01, 5.723214e-01, 5.718383e-01, & ! + 5.713827e-01, 5.709471e-01, 5.705330e-01, & ! + 9.929711e-01, 9.896942e-01, 9.852408e-01, 9.806820e-01, 9.764512e-01, & ! 3 + 9.725375e-01, 9.688677e-01, 9.653832e-01, 9.620552e-01, 9.588522e-01, & ! + 9.557475e-01, 9.527265e-01, 9.497731e-01, 9.468756e-01, 9.440270e-01, & ! + 9.412230e-01, 9.384592e-01, 9.357287e-01, 9.330369e-01, 9.303778e-01, & ! + 9.277502e-01, 9.251546e-01, 9.225907e-01, 9.200553e-01, 9.175521e-01, & ! + 9.150773e-01, 9.126352e-01, 9.102260e-01, 9.078485e-01, 9.055057e-01, & ! + 9.031978e-01, 9.009306e-01, 8.987010e-01, 8.965177e-01, 8.943774e-01, & ! + 8.922869e-01, 8.902430e-01, 8.882551e-01, 8.863182e-01, 8.844373e-01, & ! + 8.826143e-01, 8.808499e-01, 8.791413e-01, 8.774940e-01, 8.759019e-01, & ! + 8.743650e-01, 8.728941e-01, 8.714712e-01, 8.701065e-01, 8.688008e-01, & ! + 8.675409e-01, 8.663295e-01, 8.651714e-01, 8.640637e-01, 8.629943e-01, & ! + 8.619762e-01, 8.609995e-01, 8.600581e-01, & ! + 9.910612e-01, 9.854226e-01, 9.795008e-01, 9.742920e-01, 9.695996e-01, & ! 4 + 9.652274e-01, 9.610648e-01, 9.570521e-01, 9.531397e-01, 9.493086e-01, & ! + 9.455413e-01, 9.418362e-01, 9.381902e-01, 9.346016e-01, 9.310718e-01, & ! + 9.275957e-01, 9.241757e-01, 9.208038e-01, 9.174802e-01, 9.142058e-01, & ! + 9.109753e-01, 9.077895e-01, 9.046433e-01, 9.015409e-01, 8.984784e-01, & ! + 8.954572e-01, 8.924748e-01, 8.895367e-01, 8.866395e-01, 8.837864e-01, & ! + 8.809819e-01, 8.782267e-01, 8.755231e-01, 8.728712e-01, 8.702802e-01, & ! + 8.677443e-01, 8.652733e-01, 8.628678e-01, 8.605300e-01, 8.582593e-01, & ! + 8.560596e-01, 8.539352e-01, 8.518782e-01, 8.498915e-01, 8.479790e-01, & ! + 8.461384e-01, 8.443645e-01, 8.426613e-01, 8.410229e-01, 8.394495e-01, & ! + 8.379428e-01, 8.364967e-01, 8.351117e-01, 8.337820e-01, 8.325091e-01, & ! + 8.312874e-01, 8.301169e-01, 8.289985e-01, & ! + 9.969802e-01, 9.950445e-01, 9.931448e-01, 9.914272e-01, 9.898652e-01, & ! 5 + 9.884250e-01, 9.870637e-01, 9.857482e-01, 9.844558e-01, 9.831755e-01, & ! + 9.819068e-01, 9.806477e-01, 9.794000e-01, 9.781666e-01, 9.769461e-01, & ! + 9.757386e-01, 9.745459e-01, 9.733650e-01, 9.721953e-01, 9.710398e-01, & ! + 9.698936e-01, 9.687583e-01, 9.676334e-01, 9.665192e-01, 9.654132e-01, & ! + 9.643208e-01, 9.632374e-01, 9.621625e-01, 9.611003e-01, 9.600518e-01, & ! + 9.590144e-01, 9.579922e-01, 9.569864e-01, 9.559948e-01, 9.550239e-01, & ! + 9.540698e-01, 9.531382e-01, 9.522280e-01, 9.513409e-01, 9.504772e-01, & ! + 9.496360e-01, 9.488220e-01, 9.480327e-01, 9.472693e-01, 9.465333e-01, & ! + 9.458211e-01, 9.451344e-01, 9.444732e-01, 9.438372e-01, 9.432268e-01, & ! + 9.426391e-01, 9.420757e-01, 9.415308e-01, 9.410102e-01, 9.405115e-01, & ! + 9.400326e-01, 9.395716e-01, 9.391313e-01, & ! + 9.980034e-01, 9.968572e-01, 9.958696e-01, 9.949747e-01, 9.941241e-01, & ! 6 + 9.933043e-01, 9.924971e-01, 9.916978e-01, 9.909023e-01, 9.901046e-01, & ! + 9.893087e-01, 9.885146e-01, 9.877195e-01, 9.869283e-01, 9.861379e-01, & ! + 9.853523e-01, 9.845715e-01, 9.837945e-01, 9.830217e-01, 9.822567e-01, & ! + 9.814935e-01, 9.807356e-01, 9.799815e-01, 9.792332e-01, 9.784845e-01, & ! + 9.777424e-01, 9.770042e-01, 9.762695e-01, 9.755416e-01, 9.748152e-01, & ! + 9.740974e-01, 9.733873e-01, 9.726813e-01, 9.719861e-01, 9.713010e-01, & ! + 9.706262e-01, 9.699647e-01, 9.693144e-01, 9.686794e-01, 9.680596e-01, & ! + 9.674540e-01, 9.668657e-01, 9.662926e-01, 9.657390e-01, 9.652019e-01, & ! + 9.646820e-01, 9.641784e-01, 9.636945e-01, 9.632260e-01, 9.627743e-01, & ! + 9.623418e-01, 9.619227e-01, 9.615194e-01, 9.611341e-01, 9.607629e-01, & ! + 9.604057e-01, 9.600622e-01, 9.597322e-01, & ! + 9.988219e-01, 9.981767e-01, 9.976168e-01, 9.971066e-01, 9.966195e-01, & ! 7 + 9.961566e-01, 9.956995e-01, 9.952481e-01, 9.947982e-01, 9.943495e-01, & ! + 9.938955e-01, 9.934368e-01, 9.929825e-01, 9.925239e-01, 9.920653e-01, & ! + 9.916096e-01, 9.911552e-01, 9.907067e-01, 9.902594e-01, 9.898178e-01, & ! + 9.893791e-01, 9.889453e-01, 9.885122e-01, 9.880837e-01, 9.876567e-01, & ! + 9.872331e-01, 9.868121e-01, 9.863938e-01, 9.859790e-01, 9.855650e-01, & ! + 9.851548e-01, 9.847491e-01, 9.843496e-01, 9.839521e-01, 9.835606e-01, & ! + 9.831771e-01, 9.827975e-01, 9.824292e-01, 9.820653e-01, 9.817124e-01, & ! + 9.813644e-01, 9.810291e-01, 9.807020e-01, 9.803864e-01, 9.800782e-01, & ! + 9.797821e-01, 9.794958e-01, 9.792179e-01, 9.789509e-01, 9.786940e-01, & ! + 9.784460e-01, 9.782090e-01, 9.779789e-01, 9.777553e-01, 9.775425e-01, & ! + 9.773387e-01, 9.771420e-01, 9.769529e-01, & ! + 9.998902e-01, 9.998395e-01, 9.997915e-01, 9.997442e-01, 9.997016e-01, & ! 8 + 9.996600e-01, 9.996200e-01, 9.995806e-01, 9.995411e-01, 9.995005e-01, & ! + 9.994589e-01, 9.994178e-01, 9.993766e-01, 9.993359e-01, 9.992948e-01, & ! + 9.992533e-01, 9.992120e-01, 9.991723e-01, 9.991313e-01, 9.990906e-01, & ! + 9.990510e-01, 9.990113e-01, 9.989716e-01, 9.989323e-01, 9.988923e-01, & ! + 9.988532e-01, 9.988140e-01, 9.987761e-01, 9.987373e-01, 9.986989e-01, & ! + 9.986597e-01, 9.986239e-01, 9.985861e-01, 9.985485e-01, 9.985123e-01, & ! + 9.984762e-01, 9.984415e-01, 9.984065e-01, 9.983722e-01, 9.983398e-01, & ! + 9.983078e-01, 9.982758e-01, 9.982461e-01, 9.982157e-01, 9.981872e-01, & ! + 9.981595e-01, 9.981324e-01, 9.981068e-01, 9.980811e-01, 9.980580e-01, & ! + 9.980344e-01, 9.980111e-01, 9.979908e-01, 9.979690e-01, 9.979492e-01, & ! + 9.979316e-01, 9.979116e-01, 9.978948e-01, & ! + 9.999978e-01, 9.999948e-01, 9.999915e-01, 9.999905e-01, 9.999896e-01, & ! 9 + 9.999887e-01, 9.999888e-01, 9.999888e-01, 9.999870e-01, 9.999854e-01, & ! + 9.999855e-01, 9.999856e-01, 9.999839e-01, 9.999834e-01, 9.999829e-01, & ! + 9.999809e-01, 9.999816e-01, 9.999793e-01, 9.999782e-01, 9.999779e-01, & ! + 9.999772e-01, 9.999764e-01, 9.999756e-01, 9.999744e-01, 9.999744e-01, & ! + 9.999736e-01, 9.999729e-01, 9.999716e-01, 9.999706e-01, 9.999692e-01, & ! + 9.999690e-01, 9.999675e-01, 9.999673e-01, 9.999660e-01, 9.999654e-01, & ! + 9.999647e-01, 9.999647e-01, 9.999625e-01, 9.999620e-01, 9.999614e-01, & ! + 9.999613e-01, 9.999607e-01, 9.999604e-01, 9.999594e-01, 9.999589e-01, & ! + 9.999586e-01, 9.999567e-01, 9.999550e-01, 9.999557e-01, 9.999542e-01, & ! + 9.999546e-01, 9.999539e-01, 9.999536e-01, 9.999526e-01, 9.999523e-01, & ! + 9.999508e-01, 9.999534e-01, 9.999507e-01, & ! + 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, & ! 10 + 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, & ! + 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, & ! + 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, 9.999995e-01, & ! + 9.999995e-01, 9.999990e-01, 9.999991e-01, 9.999991e-01, 9.999990e-01, & ! + 9.999989e-01, 9.999988e-01, 9.999988e-01, 9.999986e-01, 9.999988e-01, & ! + 9.999986e-01, 9.999987e-01, 9.999986e-01, 9.999985e-01, 9.999985e-01, & ! + 9.999985e-01, 9.999985e-01, 9.999983e-01, 9.999983e-01, 9.999981e-01, & ! + 9.999981e-01, 9.999986e-01, 9.999985e-01, 9.999983e-01, 9.999984e-01, & ! + 9.999982e-01, 9.999983e-01, 9.999982e-01, 9.999980e-01, 9.999981e-01, & ! + 9.999978e-01, 9.999979e-01, 9.999985e-01, 9.999985e-01, 9.999983e-01, & ! + 9.999983e-01, 9.999983e-01, 9.999983e-01, & ! + 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, & ! 11 + 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, & ! + 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, & ! + 1.000000e+00, 1.000000e+00, 1.000000e+00, 1.000000e+00, 9.999991e-01, & ! + 9.999990e-01, 9.999992e-01, 9.999995e-01, 9.999986e-01, 9.999994e-01, & ! + 9.999985e-01, 9.999980e-01, 9.999984e-01, 9.999983e-01, 9.999979e-01, & ! + 9.999969e-01, 9.999977e-01, 9.999971e-01, 9.999969e-01, 9.999969e-01, & ! + 9.999965e-01, 9.999970e-01, 9.999985e-01, 9.999973e-01, 9.999961e-01, & ! + 9.999968e-01, 9.999952e-01, 9.999970e-01, 9.999974e-01, 9.999965e-01, & ! + 9.999969e-01, 9.999970e-01, 9.999970e-01, 9.999960e-01, 9.999923e-01, & ! + 9.999958e-01, 9.999937e-01, 9.999960e-01, 9.999953e-01, 9.999946e-01, & ! + 9.999946e-01, 9.999957e-01, 9.999951e-01, & ! + 1.000000e+00, 1.000000e+00, 9.999983e-01, 9.999979e-01, 9.999965e-01, & ! 12 + 9.999949e-01, 9.999948e-01, 9.999918e-01, 9.999917e-01, 9.999923e-01, & ! + 9.999908e-01, 9.999889e-01, 9.999902e-01, 9.999895e-01, 9.999881e-01, & ! + 9.999882e-01, 9.999876e-01, 9.999866e-01, 9.999866e-01, 9.999858e-01, & ! + 9.999860e-01, 9.999852e-01, 9.999836e-01, 9.999831e-01, 9.999818e-01, & ! + 9.999808e-01, 9.999816e-01, 9.999800e-01, 9.999783e-01, 9.999780e-01, & ! + 9.999763e-01, 9.999746e-01, 9.999731e-01, 9.999713e-01, 9.999762e-01, & ! + 9.999740e-01, 9.999670e-01, 9.999703e-01, 9.999687e-01, 9.999666e-01, & ! + 9.999683e-01, 9.999667e-01, 9.999611e-01, 9.999635e-01, 9.999600e-01, & ! + 9.999635e-01, 9.999594e-01, 9.999601e-01, 9.999586e-01, 9.999559e-01, & ! + 9.999569e-01, 9.999558e-01, 9.999523e-01, 9.999535e-01, 9.999529e-01, & ! + 9.999553e-01, 9.999495e-01, 9.999490e-01, & ! + 9.999920e-01, 9.999873e-01, 9.999855e-01, 9.999832e-01, 9.999807e-01, & ! 13 + 9.999778e-01, 9.999754e-01, 9.999721e-01, 9.999692e-01, 9.999651e-01, & ! + 9.999621e-01, 9.999607e-01, 9.999567e-01, 9.999546e-01, 9.999521e-01, & ! + 9.999491e-01, 9.999457e-01, 9.999439e-01, 9.999403e-01, 9.999374e-01, & ! + 9.999353e-01, 9.999315e-01, 9.999282e-01, 9.999244e-01, 9.999234e-01, & ! + 9.999189e-01, 9.999130e-01, 9.999117e-01, 9.999073e-01, 9.999020e-01, & ! + 9.998993e-01, 9.998987e-01, 9.998922e-01, 9.998893e-01, 9.998869e-01, & ! + 9.998805e-01, 9.998778e-01, 9.998751e-01, 9.998708e-01, 9.998676e-01, & ! + 9.998624e-01, 9.998642e-01, 9.998582e-01, 9.998547e-01, 9.998546e-01, & ! + 9.998477e-01, 9.998487e-01, 9.998466e-01, 9.998403e-01, 9.998412e-01, & ! + 9.998406e-01, 9.998342e-01, 9.998326e-01, 9.998333e-01, 9.998328e-01, & ! + 9.998290e-01, 9.998276e-01, 9.998249e-01, & ! + 8.383753e-01, 8.461471e-01, 8.373325e-01, 8.212889e-01, 8.023834e-01, & ! 14 + 7.829501e-01, 7.641777e-01, 7.466000e-01, 7.304023e-01, 7.155998e-01, & ! + 7.021259e-01, 6.898840e-01, 6.787615e-01, 6.686479e-01, 6.594414e-01, & ! + 6.510417e-01, 6.433668e-01, 6.363335e-01, 6.298788e-01, 6.239398e-01, & ! + 6.184633e-01, 6.134055e-01, 6.087228e-01, 6.043786e-01, 6.003439e-01, & ! + 5.965910e-01, 5.930917e-01, 5.898280e-01, 5.867798e-01, 5.839264e-01, & ! + 5.812576e-01, 5.787592e-01, 5.764163e-01, 5.742189e-01, 5.721598e-01, & ! + 5.702286e-01, 5.684182e-01, 5.667176e-01, 5.651237e-01, 5.636253e-01, & ! + 5.622228e-01, 5.609074e-01, 5.596713e-01, 5.585089e-01, 5.574223e-01, & ! + 5.564002e-01, 5.554411e-01, 5.545397e-01, 5.536914e-01, 5.528967e-01, & ! + 5.521495e-01, 5.514457e-01, 5.507818e-01, 5.501623e-01, 5.495750e-01, & ! + 5.490192e-01, 5.484980e-01, 5.480046e-01/), & ! + shape = (/58,nBandsSW_RRTMG/)) + + real(kind_phys),dimension(58,nBandsSW_RRTMG),parameter :: & ! + asyliq1 = reshape(source= (/ & ! + 8.133297e-01, 8.133528e-01, 8.173865e-01, 8.243205e-01, 8.333063e-01, & ! 1 + 8.436317e-01, 8.546611e-01, 8.657934e-01, 8.764345e-01, 8.859837e-01, & ! + 8.627394e-01, 8.824569e-01, 8.976887e-01, 9.089541e-01, 9.167699e-01, & ! + 9.216517e-01, 9.241147e-01, 9.246743e-01, 9.238469e-01, 9.221504e-01, & ! + 9.201045e-01, 9.182299e-01, 9.170491e-01, 9.170862e-01, 9.188653e-01, & ! + 9.229111e-01, 9.297468e-01, 9.398950e-01, 9.203269e-01, 9.260693e-01, & ! + 9.309373e-01, 9.349918e-01, 9.382935e-01, 9.409030e-01, 9.428809e-01, & ! + 9.442881e-01, 9.451851e-01, 9.456331e-01, 9.456926e-01, 9.454247e-01, & ! + 9.448902e-01, 9.441503e-01, 9.432661e-01, 9.422987e-01, 9.413094e-01, & ! + 9.403594e-01, 9.395102e-01, 9.388230e-01, 9.383594e-01, 9.381810e-01, & ! + 9.383489e-01, 9.389251e-01, 9.399707e-01, 9.415475e-01, 9.437167e-01, & ! + 9.465399e-01, 9.500786e-01, 9.5439e-01, & ! + 8.794448e-01, 8.819306e-01, 8.837667e-01, 8.853832e-01, 8.871010e-01, & ! 2 + 8.892675e-01, 8.922584e-01, 8.964666e-01, 9.022940e-01, 9.101456e-01, & ! + 8.839999e-01, 9.035610e-01, 9.184568e-01, 9.292315e-01, 9.364282e-01, & ! + 9.405887e-01, 9.422554e-01, 9.419703e-01, 9.402759e-01, 9.377159e-01, & ! + 9.348345e-01, 9.321769e-01, 9.302888e-01, 9.297166e-01, 9.310075e-01, & ! + 9.347080e-01, 9.413643e-01, 9.515216e-01, 9.306286e-01, 9.361781e-01, & ! + 9.408374e-01, 9.446692e-01, 9.477363e-01, 9.501013e-01, 9.518268e-01, & ! + 9.529756e-01, 9.536105e-01, 9.537938e-01, 9.535886e-01, 9.530574e-01, & ! + 9.522633e-01, 9.512688e-01, 9.501370e-01, 9.489306e-01, 9.477126e-01, & ! + 9.465459e-01, 9.454934e-01, 9.446183e-01, 9.439833e-01, 9.436519e-01, & ! + 9.436866e-01, 9.441508e-01, 9.451073e-01, 9.466195e-01, 9.487501e-01, & ! + 9.515621e-01, 9.551185e-01, 9.5948e-01, & ! + 8.478817e-01, 8.269312e-01, 8.161352e-01, 8.135960e-01, 8.173586e-01, & ! 3 + 8.254167e-01, 8.357072e-01, 8.461167e-01, 8.544952e-01, 8.586776e-01, & ! + 8.335562e-01, 8.524273e-01, 8.669052e-01, 8.775014e-01, 8.847277e-01, & ! + 8.890958e-01, 8.911173e-01, 8.913038e-01, 8.901669e-01, 8.882182e-01, & ! + 8.859692e-01, 8.839315e-01, 8.826164e-01, 8.825356e-01, 8.842004e-01, & ! + 8.881223e-01, 8.948131e-01, 9.047837e-01, 8.855951e-01, 8.911796e-01, & ! + 8.959229e-01, 8.998837e-01, 9.031209e-01, 9.056939e-01, 9.076609e-01, & ! + 9.090812e-01, 9.100134e-01, 9.105167e-01, 9.106496e-01, 9.104712e-01, & ! + 9.100404e-01, 9.094159e-01, 9.086568e-01, 9.078218e-01, 9.069697e-01, & ! + 9.061595e-01, 9.054499e-01, 9.048999e-01, 9.045683e-01, 9.045142e-01, & ! + 9.047962e-01, 9.054730e-01, 9.066037e-01, 9.082472e-01, 9.104623e-01, & ! + 9.133079e-01, 9.168427e-01, 9.2113e-01, & ! + 8.216697e-01, 7.982871e-01, 7.891147e-01, 7.909083e-01, 8.003833e-01, & ! 4 + 8.142516e-01, 8.292290e-01, 8.420356e-01, 8.493945e-01, 8.480316e-01, & ! + 8.212381e-01, 8.394984e-01, 8.534095e-01, 8.634813e-01, 8.702242e-01, & ! + 8.741483e-01, 8.757638e-01, 8.755808e-01, 8.741095e-01, 8.718604e-01, & ! + 8.693433e-01, 8.670686e-01, 8.655464e-01, 8.652872e-01, 8.668006e-01, & ! + 8.705973e-01, 8.771874e-01, 8.870809e-01, 8.678284e-01, 8.732315e-01, & ! + 8.778084e-01, 8.816166e-01, 8.847146e-01, 8.871603e-01, 8.890116e-01, & ! + 8.903266e-01, 8.911632e-01, 8.915796e-01, 8.916337e-01, 8.913834e-01, & ! + 8.908869e-01, 8.902022e-01, 8.893873e-01, 8.885001e-01, 8.875986e-01, & ! + 8.867411e-01, 8.859852e-01, 8.853891e-01, 8.850111e-01, 8.849089e-01, & ! + 8.851405e-01, 8.857639e-01, 8.868372e-01, 8.884185e-01, 8.905656e-01, & ! + 8.933368e-01, 8.967899e-01, 9.0098e-01, & ! + 8.063610e-01, 7.938147e-01, 7.921304e-01, 7.985092e-01, 8.101339e-01, & ! 5 + 8.242175e-01, 8.379913e-01, 8.486920e-01, 8.535547e-01, 8.498083e-01, & ! + 8.224849e-01, 8.405509e-01, 8.542436e-01, 8.640770e-01, 8.705653e-01, & ! + 8.742227e-01, 8.755630e-01, 8.751004e-01, 8.733491e-01, 8.708231e-01, & ! + 8.680365e-01, 8.655035e-01, 8.637381e-01, 8.632544e-01, 8.645665e-01, & ! + 8.681885e-01, 8.746346e-01, 8.844188e-01, 8.648180e-01, 8.700563e-01, & ! + 8.744672e-01, 8.781087e-01, 8.810393e-01, 8.833174e-01, 8.850011e-01, & ! + 8.861485e-01, 8.868183e-01, 8.870687e-01, 8.869579e-01, 8.865441e-01, & ! + 8.858857e-01, 8.850412e-01, 8.840686e-01, 8.830263e-01, 8.819726e-01, & ! + 8.809658e-01, 8.800642e-01, 8.793260e-01, 8.788099e-01, 8.785737e-01, & ! + 8.786758e-01, 8.791746e-01, 8.801283e-01, 8.815955e-01, 8.836340e-01, & ! + 8.863024e-01, 8.896592e-01, 8.9376e-01, & ! + 7.885899e-01, 7.937172e-01, 8.020658e-01, 8.123971e-01, 8.235502e-01, & ! 6 + 8.343776e-01, 8.437336e-01, 8.504711e-01, 8.534421e-01, 8.514978e-01, & ! + 8.238888e-01, 8.417463e-01, 8.552057e-01, 8.647853e-01, 8.710038e-01, & ! + 8.743798e-01, 8.754319e-01, 8.746786e-01, 8.726386e-01, 8.698303e-01, & ! + 8.667724e-01, 8.639836e-01, 8.619823e-01, 8.612870e-01, 8.624165e-01, & ! + 8.658893e-01, 8.722241e-01, 8.819394e-01, 8.620216e-01, 8.671239e-01, & ! + 8.713983e-01, 8.749032e-01, 8.776970e-01, 8.798385e-01, 8.813860e-01, & ! + 8.823980e-01, 8.829332e-01, 8.830500e-01, 8.828068e-01, 8.822623e-01, & ! + 8.814750e-01, 8.805031e-01, 8.794056e-01, 8.782407e-01, 8.770672e-01, & ! + 8.759432e-01, 8.749275e-01, 8.740784e-01, 8.734547e-01, 8.731146e-01, & ! + 8.731170e-01, 8.735199e-01, 8.743823e-01, 8.757625e-01, 8.777191e-01, & ! + 8.803105e-01, 8.835953e-01, 8.8763e-01, & ! + 7.811516e-01, 7.962229e-01, 8.096199e-01, 8.212996e-01, 8.312212e-01, & ! 7 + 8.393430e-01, 8.456236e-01, 8.500214e-01, 8.524950e-01, 8.530031e-01, & ! + 8.251485e-01, 8.429043e-01, 8.562461e-01, 8.656954e-01, 8.717737e-01, & ! + 8.750020e-01, 8.759022e-01, 8.749953e-01, 8.728027e-01, 8.698461e-01, & ! + 8.666466e-01, 8.637257e-01, 8.616047e-01, 8.608051e-01, 8.618483e-01, & ! + 8.652557e-01, 8.715487e-01, 8.812485e-01, 8.611645e-01, 8.662052e-01, & ! + 8.704173e-01, 8.738594e-01, 8.765901e-01, 8.786678e-01, 8.801517e-01, & ! + 8.810999e-01, 8.815713e-01, 8.816246e-01, 8.813185e-01, 8.807114e-01, & ! + 8.798621e-01, 8.788290e-01, 8.776713e-01, 8.764470e-01, 8.752152e-01, & ! + 8.740343e-01, 8.729631e-01, 8.720602e-01, 8.713842e-01, 8.709936e-01, & ! + 8.709475e-01, 8.713041e-01, 8.721221e-01, 8.734602e-01, 8.753774e-01, & ! + 8.779319e-01, 8.811825e-01, 8.8519e-01, & ! + 7.865744e-01, 8.093340e-01, 8.257596e-01, 8.369940e-01, 8.441574e-01, & ! 8 + 8.483602e-01, 8.507096e-01, 8.523139e-01, 8.542834e-01, 8.577321e-01, & ! + 8.288960e-01, 8.465308e-01, 8.597175e-01, 8.689830e-01, 8.748542e-01, & ! + 8.778584e-01, 8.785222e-01, 8.773728e-01, 8.749370e-01, 8.717419e-01, & ! + 8.683145e-01, 8.651816e-01, 8.628704e-01, 8.619077e-01, 8.628205e-01, & ! + 8.661356e-01, 8.723803e-01, 8.820815e-01, 8.616715e-01, 8.666389e-01, & ! + 8.707753e-01, 8.741398e-01, 8.767912e-01, 8.787885e-01, 8.801908e-01, & ! + 8.810570e-01, 8.814460e-01, 8.814167e-01, 8.810283e-01, 8.803395e-01, & ! + 8.794095e-01, 8.782971e-01, 8.770613e-01, 8.757610e-01, 8.744553e-01, & ! + 8.732031e-01, 8.720634e-01, 8.710951e-01, 8.703572e-01, 8.699086e-01, & ! + 8.698084e-01, 8.701155e-01, 8.708887e-01, 8.721872e-01, 8.740698e-01, & ! + 8.765957e-01, 8.798235e-01, 8.8381e-01, & ! + 8.069513e-01, 8.262939e-01, 8.398241e-01, 8.486352e-01, 8.538213e-01, & ! 9 + 8.564743e-01, 8.576854e-01, 8.585455e-01, 8.601452e-01, 8.635755e-01, & ! + 8.337383e-01, 8.512655e-01, 8.643049e-01, 8.733896e-01, 8.790535e-01, & ! + 8.818295e-01, 8.822518e-01, 8.808533e-01, 8.781676e-01, 8.747284e-01, & ! + 8.710690e-01, 8.677229e-01, 8.652236e-01, 8.641047e-01, 8.648993e-01, & ! + 8.681413e-01, 8.743640e-01, 8.841007e-01, 8.633558e-01, 8.682719e-01, & ! + 8.723543e-01, 8.756621e-01, 8.782547e-01, 8.801915e-01, 8.815318e-01, & ! + 8.823347e-01, 8.826598e-01, 8.825663e-01, 8.821135e-01, 8.813608e-01, & ! + 8.803674e-01, 8.791928e-01, 8.778960e-01, 8.765366e-01, 8.751738e-01, & ! + 8.738670e-01, 8.726755e-01, 8.716585e-01, 8.708755e-01, 8.703856e-01, & ! + 8.702483e-01, 8.705229e-01, 8.712687e-01, 8.725448e-01, 8.744109e-01, & ! + 8.769260e-01, 8.801496e-01, 8.8414e-01, & ! + 8.252182e-01, 8.379244e-01, 8.471709e-01, 8.535760e-01, 8.577540e-01, & ! 10 + 8.603183e-01, 8.618820e-01, 8.630578e-01, 8.644587e-01, 8.666970e-01, & ! + 8.362159e-01, 8.536817e-01, 8.666387e-01, 8.756240e-01, 8.811746e-01, & ! + 8.838273e-01, 8.841191e-01, 8.825871e-01, 8.797681e-01, 8.761992e-01, & ! + 8.724174e-01, 8.689593e-01, 8.663623e-01, 8.651632e-01, 8.658988e-01, & ! + 8.691064e-01, 8.753226e-01, 8.850847e-01, 8.641620e-01, 8.690500e-01, & ! + 8.731026e-01, 8.763795e-01, 8.789400e-01, 8.808438e-01, 8.821503e-01, & ! + 8.829191e-01, 8.832095e-01, 8.830813e-01, 8.825938e-01, 8.818064e-01, & ! + 8.807787e-01, 8.795704e-01, 8.782408e-01, 8.768493e-01, 8.754557e-01, & ! + 8.741193e-01, 8.728995e-01, 8.718561e-01, 8.710484e-01, 8.705360e-01, & ! + 8.703782e-01, 8.706347e-01, 8.713650e-01, 8.726285e-01, 8.744849e-01, & ! + 8.769933e-01, 8.802136e-01, 8.8421e-01, & ! + 8.370583e-01, 8.467920e-01, 8.537769e-01, 8.585136e-01, 8.615034e-01, & ! 11 + 8.632474e-01, 8.642468e-01, 8.650026e-01, 8.660161e-01, 8.677882e-01, & ! + 8.369760e-01, 8.543821e-01, 8.672699e-01, 8.761782e-01, 8.816454e-01, & ! + 8.842103e-01, 8.844114e-01, 8.827872e-01, 8.798766e-01, 8.762179e-01, & ! + 8.723500e-01, 8.688112e-01, 8.661403e-01, 8.648758e-01, 8.655563e-01, & ! + 8.687206e-01, 8.749072e-01, 8.846546e-01, 8.636289e-01, 8.684849e-01, & ! + 8.725054e-01, 8.757501e-01, 8.782785e-01, 8.801503e-01, 8.814249e-01, & ! + 8.821620e-01, 8.824211e-01, 8.822620e-01, 8.817440e-01, 8.809268e-01, & ! + 8.798699e-01, 8.786330e-01, 8.772756e-01, 8.758572e-01, 8.744374e-01, & ! + 8.730760e-01, 8.718323e-01, 8.707660e-01, 8.699366e-01, 8.694039e-01, & ! + 8.692271e-01, 8.694661e-01, 8.701803e-01, 8.714293e-01, 8.732727e-01, & ! + 8.757702e-01, 8.789811e-01, 8.8297e-01, & ! + 8.430819e-01, 8.510060e-01, 8.567270e-01, 8.606533e-01, 8.631934e-01, & ! 12 + 8.647554e-01, 8.657471e-01, 8.665760e-01, 8.676496e-01, 8.693754e-01, & ! + 8.384298e-01, 8.557913e-01, 8.686214e-01, 8.774605e-01, 8.828495e-01, & ! + 8.853287e-01, 8.854393e-01, 8.837215e-01, 8.807161e-01, 8.769639e-01, & ! + 8.730053e-01, 8.693812e-01, 8.666321e-01, 8.652988e-01, 8.659219e-01, & ! + 8.690419e-01, 8.751999e-01, 8.849360e-01, 8.638013e-01, 8.686371e-01, & ! + 8.726369e-01, 8.758605e-01, 8.783674e-01, 8.802176e-01, 8.814705e-01, & ! + 8.821859e-01, 8.824234e-01, 8.822429e-01, 8.817038e-01, 8.808658e-01, & ! + 8.797887e-01, 8.785323e-01, 8.771560e-01, 8.757196e-01, 8.742828e-01, & ! + 8.729052e-01, 8.716467e-01, 8.705666e-01, 8.697250e-01, 8.691812e-01, & ! + 8.689950e-01, 8.692264e-01, 8.699346e-01, 8.711795e-01, 8.730209e-01, & ! + 8.755181e-01, 8.787312e-01, 8.8272e-01, & ! + 8.452284e-01, 8.522700e-01, 8.572973e-01, 8.607031e-01, 8.628802e-01, & ! 13 + 8.642215e-01, 8.651198e-01, 8.659679e-01, 8.671588e-01, 8.690853e-01, & ! + 8.383803e-01, 8.557485e-01, 8.685851e-01, 8.774303e-01, 8.828245e-01, & ! + 8.853077e-01, 8.854207e-01, 8.837034e-01, 8.806962e-01, 8.769398e-01, & ! + 8.729740e-01, 8.693393e-01, 8.665761e-01, 8.652247e-01, 8.658253e-01, & ! + 8.689182e-01, 8.750438e-01, 8.847424e-01, 8.636140e-01, 8.684449e-01, & ! + 8.724400e-01, 8.756589e-01, 8.781613e-01, 8.800072e-01, 8.812559e-01, & ! + 8.819671e-01, 8.822007e-01, 8.820165e-01, 8.814737e-01, 8.806322e-01, & ! + 8.795518e-01, 8.782923e-01, 8.769129e-01, 8.754737e-01, 8.740342e-01, & ! + 8.726542e-01, 8.713934e-01, 8.703111e-01, 8.694677e-01, 8.689222e-01, & ! + 8.687344e-01, 8.689646e-01, 8.696715e-01, 8.709156e-01, 8.727563e-01, & ! + 8.752531e-01, 8.784659e-01, 8.8245e-01, & ! + 7.800869e-01, 8.091120e-01, 8.325369e-01, 8.466266e-01, 8.515495e-01, & ! 14 + 8.499371e-01, 8.456203e-01, 8.430521e-01, 8.470286e-01, 8.625431e-01, & ! + 8.402261e-01, 8.610822e-01, 8.776608e-01, 8.904485e-01, 8.999294e-01, & ! + 9.065860e-01, 9.108995e-01, 9.133503e-01, 9.144187e-01, 9.145855e-01, & ! + 9.143320e-01, 9.141402e-01, 9.144933e-01, 9.158754e-01, 9.187716e-01, & ! + 9.236677e-01, 9.310503e-01, 9.414058e-01, 9.239108e-01, 9.300719e-01, & ! + 9.353612e-01, 9.398378e-01, 9.435609e-01, 9.465895e-01, 9.489829e-01, & ! + 9.508000e-01, 9.521002e-01, 9.529424e-01, 9.533860e-01, 9.534902e-01, & ! + 9.533143e-01, 9.529177e-01, 9.523596e-01, 9.516997e-01, 9.509973e-01, & ! + 9.503121e-01, 9.497037e-01, 9.492317e-01, 9.489558e-01, 9.489356e-01, & ! + 9.492311e-01, 9.499019e-01, 9.510077e-01, 9.526084e-01, 9.547636e-01, & ! + 9.575331e-01, 9.609766e-01, 9.6515e-01 /), & ! + shape = (/58,nBandsSW_RRTMG/)) + + real(kind_phys),dimension(58,nBandsSW_RRTMG),parameter :: & ! + asyliq2 = reshape(source= (/ & ! + 8.038165e-01, 8.014154e-01, 7.942381e-01, 7.970521e-01, 8.086621e-01, & ! 1 + 8.233392e-01, 8.374127e-01, 8.495742e-01, 8.596945e-01, 8.680497e-01, & ! + 8.750005e-01, 8.808589e-01, 8.858749e-01, 8.902403e-01, 8.940939e-01, & ! + 8.975379e-01, 9.006450e-01, 9.034741e-01, 9.060659e-01, 9.084561e-01, & ! + 9.106675e-01, 9.127198e-01, 9.146332e-01, 9.164194e-01, 9.180970e-01, & ! + 9.196658e-01, 9.211421e-01, 9.225352e-01, 9.238443e-01, 9.250841e-01, & ! + 9.262541e-01, 9.273620e-01, 9.284081e-01, 9.294002e-01, 9.303395e-01, & ! + 9.312285e-01, 9.320715e-01, 9.328716e-01, 9.336271e-01, 9.343427e-01, & ! + 9.350219e-01, 9.356647e-01, 9.362728e-01, 9.368495e-01, 9.373956e-01, & ! + 9.379113e-01, 9.383987e-01, 9.388608e-01, 9.392986e-01, 9.397132e-01, & ! + 9.401063e-01, 9.404776e-01, 9.408299e-01, 9.411641e-01, 9.414800e-01, & ! + 9.417787e-01, 9.420633e-01, 9.423364e-01, & ! + 8.941000e-01, 9.054049e-01, 9.049510e-01, 9.027216e-01, 9.021636e-01, & ! 2 + 9.037878e-01, 9.069852e-01, 9.109817e-01, 9.152013e-01, 9.193040e-01, & ! + 9.231177e-01, 9.265712e-01, 9.296606e-01, 9.324048e-01, 9.348419e-01, & ! + 9.370131e-01, 9.389529e-01, 9.406954e-01, 9.422727e-01, 9.437088e-01, & ! + 9.450221e-01, 9.462308e-01, 9.473488e-01, 9.483830e-01, 9.493492e-01, & ! + 9.502541e-01, 9.510999e-01, 9.518971e-01, 9.526455e-01, 9.533554e-01, & ! + 9.540249e-01, 9.546571e-01, 9.552551e-01, 9.558258e-01, 9.563603e-01, & ! + 9.568713e-01, 9.573569e-01, 9.578141e-01, 9.582485e-01, 9.586604e-01, & ! + 9.590525e-01, 9.594218e-01, 9.597710e-01, 9.601052e-01, 9.604181e-01, & ! + 9.607159e-01, 9.609979e-01, 9.612655e-01, 9.615184e-01, 9.617564e-01, & ! + 9.619860e-01, 9.622009e-01, 9.624031e-01, 9.625957e-01, 9.627792e-01, & ! + 9.629530e-01, 9.631171e-01, 9.632746e-01, & ! + 8.574638e-01, 8.351383e-01, 8.142977e-01, 8.083068e-01, 8.129284e-01, & ! 3 + 8.215827e-01, 8.307238e-01, 8.389963e-01, 8.460481e-01, 8.519273e-01, & ! + 8.568153e-01, 8.609116e-01, 8.643892e-01, 8.673941e-01, 8.700248e-01, & ! + 8.723707e-01, 8.744902e-01, 8.764240e-01, 8.782057e-01, 8.798593e-01, & ! + 8.814063e-01, 8.828573e-01, 8.842261e-01, 8.855196e-01, 8.867497e-01, & ! + 8.879164e-01, 8.890316e-01, 8.900941e-01, 8.911118e-01, 8.920832e-01, & ! + 8.930156e-01, 8.939091e-01, 8.947663e-01, 8.955888e-01, 8.963786e-01, & ! + 8.971350e-01, 8.978617e-01, 8.985590e-01, 8.992243e-01, 8.998631e-01, & ! + 9.004753e-01, 9.010602e-01, 9.016192e-01, 9.021542e-01, 9.026644e-01, & ! + 9.031535e-01, 9.036194e-01, 9.040656e-01, 9.044894e-01, 9.048933e-01, & ! + 9.052789e-01, 9.056481e-01, 9.060004e-01, 9.063343e-01, 9.066544e-01, & ! + 9.069604e-01, 9.072512e-01, 9.075290e-01, & ! + 8.349569e-01, 8.034579e-01, 7.932136e-01, 8.010156e-01, 8.137083e-01, & ! 4 + 8.255339e-01, 8.351938e-01, 8.428286e-01, 8.488944e-01, 8.538187e-01, & ! + 8.579255e-01, 8.614473e-01, 8.645338e-01, 8.672908e-01, 8.697947e-01, & ! + 8.720843e-01, 8.742015e-01, 8.761718e-01, 8.780160e-01, 8.797479e-01, & ! + 8.813810e-01, 8.829250e-01, 8.843907e-01, 8.857822e-01, 8.871059e-01, & ! + 8.883724e-01, 8.895810e-01, 8.907384e-01, 8.918456e-01, 8.929083e-01, & ! + 8.939284e-01, 8.949060e-01, 8.958463e-01, 8.967486e-01, 8.976129e-01, & ! + 8.984463e-01, 8.992439e-01, 9.000094e-01, 9.007438e-01, 9.014496e-01, & ! + 9.021235e-01, 9.027699e-01, 9.033859e-01, 9.039772e-01, 9.045419e-01, & ! + 9.050819e-01, 9.055975e-01, 9.060907e-01, 9.065607e-01, 9.070093e-01, & ! + 9.074389e-01, 9.078475e-01, 9.082388e-01, 9.086117e-01, 9.089678e-01, & ! + 9.093081e-01, 9.096307e-01, 9.099410e-01, & ! + 8.109692e-01, 7.846657e-01, 7.881928e-01, 8.009509e-01, 8.131208e-01, & ! 5 + 8.230400e-01, 8.309448e-01, 8.372920e-01, 8.424837e-01, 8.468166e-01, & ! + 8.504947e-01, 8.536642e-01, 8.564256e-01, 8.588513e-01, 8.610011e-01, & ! + 8.629122e-01, 8.646262e-01, 8.661720e-01, 8.675752e-01, 8.688582e-01, & ! + 8.700379e-01, 8.711300e-01, 8.721485e-01, 8.731027e-01, 8.740010e-01, & ! + 8.748499e-01, 8.756564e-01, 8.764239e-01, 8.771542e-01, 8.778523e-01, & ! + 8.785211e-01, 8.791601e-01, 8.797725e-01, 8.803589e-01, 8.809173e-01, & ! + 8.814552e-01, 8.819705e-01, 8.824611e-01, 8.829311e-01, 8.833791e-01, & ! + 8.838078e-01, 8.842148e-01, 8.846044e-01, 8.849756e-01, 8.853291e-01, & ! + 8.856645e-01, 8.859841e-01, 8.862904e-01, 8.865801e-01, 8.868551e-01, & ! + 8.871182e-01, 8.873673e-01, 8.876059e-01, 8.878307e-01, 8.880462e-01, & ! + 8.882501e-01, 8.884453e-01, 8.886339e-01, & ! + 7.838510e-01, 7.803151e-01, 7.980477e-01, 8.144160e-01, 8.261784e-01, & ! 6 + 8.344240e-01, 8.404278e-01, 8.450391e-01, 8.487593e-01, 8.518741e-01, & ! + 8.545484e-01, 8.568890e-01, 8.589560e-01, 8.607983e-01, 8.624504e-01, & ! + 8.639408e-01, 8.652945e-01, 8.665301e-01, 8.676634e-01, 8.687121e-01, & ! + 8.696855e-01, 8.705933e-01, 8.714448e-01, 8.722454e-01, 8.730014e-01, & ! + 8.737180e-01, 8.743982e-01, 8.750436e-01, 8.756598e-01, 8.762481e-01, & ! + 8.768089e-01, 8.773427e-01, 8.778532e-01, 8.783434e-01, 8.788089e-01, & ! + 8.792530e-01, 8.796784e-01, 8.800845e-01, 8.804716e-01, 8.808411e-01, & ! + 8.811923e-01, 8.815276e-01, 8.818472e-01, 8.821504e-01, 8.824408e-01, & ! + 8.827155e-01, 8.829777e-01, 8.832269e-01, 8.834631e-01, 8.836892e-01, & ! + 8.839034e-01, 8.841075e-01, 8.843021e-01, 8.844866e-01, 8.846631e-01, & ! + 8.848304e-01, 8.849910e-01, 8.851425e-01, & ! + 7.760783e-01, 7.890215e-01, 8.090192e-01, 8.230252e-01, 8.321369e-01, & ! 7 + 8.384258e-01, 8.431529e-01, 8.469558e-01, 8.501499e-01, 8.528899e-01, & ! + 8.552899e-01, 8.573956e-01, 8.592570e-01, 8.609098e-01, 8.623897e-01, & ! + 8.637169e-01, 8.649184e-01, 8.660097e-01, 8.670096e-01, 8.679338e-01, & ! + 8.687896e-01, 8.695880e-01, 8.703365e-01, 8.710422e-01, 8.717092e-01, & ! + 8.723378e-01, 8.729363e-01, 8.735063e-01, 8.740475e-01, 8.745661e-01, & ! + 8.750560e-01, 8.755275e-01, 8.759731e-01, 8.764000e-01, 8.768071e-01, & ! + 8.771942e-01, 8.775628e-01, 8.779126e-01, 8.782483e-01, 8.785626e-01, & ! + 8.788610e-01, 8.791482e-01, 8.794180e-01, 8.796765e-01, 8.799207e-01, & ! + 8.801522e-01, 8.803707e-01, 8.805777e-01, 8.807749e-01, 8.809605e-01, & ! + 8.811362e-01, 8.813047e-01, 8.814647e-01, 8.816131e-01, 8.817588e-01, & ! + 8.818930e-01, 8.820230e-01, 8.821445e-01, & ! + 7.847907e-01, 8.099917e-01, 8.257428e-01, 8.350423e-01, 8.411971e-01, & ! 8 + 8.457241e-01, 8.493010e-01, 8.522565e-01, 8.547660e-01, 8.569311e-01, & ! + 8.588181e-01, 8.604729e-01, 8.619296e-01, 8.632208e-01, 8.643725e-01, & ! + 8.654050e-01, 8.663363e-01, 8.671835e-01, 8.679590e-01, 8.686707e-01, & ! + 8.693308e-01, 8.699433e-01, 8.705147e-01, 8.710490e-01, 8.715497e-01, & ! + 8.720219e-01, 8.724669e-01, 8.728849e-01, 8.732806e-01, 8.736550e-01, & ! + 8.740099e-01, 8.743435e-01, 8.746601e-01, 8.749610e-01, 8.752449e-01, & ! + 8.755143e-01, 8.757688e-01, 8.760095e-01, 8.762375e-01, 8.764532e-01, & ! + 8.766579e-01, 8.768506e-01, 8.770323e-01, 8.772049e-01, 8.773690e-01, & ! + 8.775226e-01, 8.776679e-01, 8.778062e-01, 8.779360e-01, 8.780587e-01, & ! + 8.781747e-01, 8.782852e-01, 8.783892e-01, 8.784891e-01, 8.785824e-01, & ! + 8.786705e-01, 8.787546e-01, 8.788336e-01, & ! + 8.054324e-01, 8.266282e-01, 8.378075e-01, 8.449848e-01, 8.502166e-01, & ! 9 + 8.542268e-01, 8.573477e-01, 8.598022e-01, 8.617689e-01, 8.633859e-01, & ! + 8.647536e-01, 8.659354e-01, 8.669807e-01, 8.679143e-01, 8.687577e-01, & ! + 8.695222e-01, 8.702207e-01, 8.708591e-01, 8.714446e-01, 8.719836e-01, & ! + 8.724812e-01, 8.729426e-01, 8.733689e-01, 8.737665e-01, 8.741373e-01, & ! + 8.744834e-01, 8.748070e-01, 8.751131e-01, 8.754011e-01, 8.756676e-01, & ! + 8.759219e-01, 8.761599e-01, 8.763857e-01, 8.765984e-01, 8.767999e-01, & ! + 8.769889e-01, 8.771669e-01, 8.773373e-01, 8.774969e-01, 8.776469e-01, & ! + 8.777894e-01, 8.779237e-01, 8.780505e-01, 8.781703e-01, 8.782820e-01, & ! + 8.783886e-01, 8.784894e-01, 8.785844e-01, 8.786736e-01, 8.787584e-01, & ! + 8.788379e-01, 8.789130e-01, 8.789849e-01, 8.790506e-01, 8.791141e-01, & ! + 8.791750e-01, 8.792324e-01, 8.792867e-01, & ! + 8.249534e-01, 8.391988e-01, 8.474107e-01, 8.526860e-01, 8.563983e-01, & ! 10 + 8.592389e-01, 8.615144e-01, 8.633790e-01, 8.649325e-01, 8.662504e-01, & ! + 8.673841e-01, 8.683741e-01, 8.692495e-01, 8.700309e-01, 8.707328e-01, & ! + 8.713650e-01, 8.719432e-01, 8.724676e-01, 8.729498e-01, 8.733922e-01, & ! + 8.737981e-01, 8.741745e-01, 8.745225e-01, 8.748467e-01, 8.751512e-01, & ! + 8.754315e-01, 8.756962e-01, 8.759450e-01, 8.761774e-01, 8.763945e-01, & ! + 8.766021e-01, 8.767970e-01, 8.769803e-01, 8.771511e-01, 8.773151e-01, & ! + 8.774689e-01, 8.776147e-01, 8.777533e-01, 8.778831e-01, 8.780050e-01, & ! + 8.781197e-01, 8.782301e-01, 8.783323e-01, 8.784312e-01, 8.785222e-01, & ! + 8.786096e-01, 8.786916e-01, 8.787688e-01, 8.788411e-01, 8.789122e-01, & ! + 8.789762e-01, 8.790373e-01, 8.790954e-01, 8.791514e-01, 8.792018e-01, & ! + 8.792517e-01, 8.792990e-01, 8.793429e-01, & ! + 8.323091e-01, 8.429776e-01, 8.498123e-01, 8.546929e-01, 8.584295e-01, & ! 11 + 8.613489e-01, 8.636324e-01, 8.654303e-01, 8.668675e-01, 8.680404e-01, & ! + 8.690174e-01, 8.698495e-01, 8.705666e-01, 8.711961e-01, 8.717556e-01, & ! + 8.722546e-01, 8.727063e-01, 8.731170e-01, 8.734933e-01, 8.738382e-01, & ! + 8.741590e-01, 8.744525e-01, 8.747295e-01, 8.749843e-01, 8.752210e-01, & ! + 8.754437e-01, 8.756524e-01, 8.758472e-01, 8.760288e-01, 8.762030e-01, & ! + 8.763603e-01, 8.765122e-01, 8.766539e-01, 8.767894e-01, 8.769130e-01, & ! + 8.770310e-01, 8.771422e-01, 8.772437e-01, 8.773419e-01, 8.774355e-01, & ! + 8.775221e-01, 8.776047e-01, 8.776802e-01, 8.777539e-01, 8.778216e-01, & ! + 8.778859e-01, 8.779473e-01, 8.780031e-01, 8.780562e-01, 8.781097e-01, & ! + 8.781570e-01, 8.782021e-01, 8.782463e-01, 8.782845e-01, 8.783235e-01, & ! + 8.783610e-01, 8.783953e-01, 8.784273e-01, & ! + 8.396448e-01, 8.480172e-01, 8.535934e-01, 8.574145e-01, 8.600835e-01, & ! 12 + 8.620347e-01, 8.635500e-01, 8.648003e-01, 8.658758e-01, 8.668248e-01, & ! + 8.676697e-01, 8.684220e-01, 8.690893e-01, 8.696807e-01, 8.702046e-01, & ! + 8.706676e-01, 8.710798e-01, 8.714478e-01, 8.717778e-01, 8.720747e-01, & ! + 8.723431e-01, 8.725889e-01, 8.728144e-01, 8.730201e-01, 8.732129e-01, & ! + 8.733907e-01, 8.735541e-01, 8.737100e-01, 8.738533e-01, 8.739882e-01, & ! + 8.741164e-01, 8.742362e-01, 8.743485e-01, 8.744530e-01, 8.745512e-01, & ! + 8.746471e-01, 8.747373e-01, 8.748186e-01, 8.748973e-01, 8.749732e-01, & ! + 8.750443e-01, 8.751105e-01, 8.751747e-01, 8.752344e-01, 8.752902e-01, & ! + 8.753412e-01, 8.753917e-01, 8.754393e-01, 8.754843e-01, 8.755282e-01, & ! + 8.755662e-01, 8.756039e-01, 8.756408e-01, 8.756722e-01, 8.757072e-01, & ! + 8.757352e-01, 8.757653e-01, 8.757932e-01, & ! + 8.374590e-01, 8.465669e-01, 8.518701e-01, 8.547627e-01, 8.565745e-01, & ! 13 + 8.579065e-01, 8.589717e-01, 8.598632e-01, 8.606363e-01, 8.613268e-01, & ! + 8.619560e-01, 8.625340e-01, 8.630689e-01, 8.635601e-01, 8.640084e-01, & ! + 8.644180e-01, 8.647885e-01, 8.651220e-01, 8.654218e-01, 8.656908e-01, & ! + 8.659294e-01, 8.661422e-01, 8.663334e-01, 8.665037e-01, 8.666543e-01, & ! + 8.667913e-01, 8.669156e-01, 8.670242e-01, 8.671249e-01, 8.672161e-01, & ! + 8.672993e-01, 8.673733e-01, 8.674457e-01, 8.675103e-01, 8.675713e-01, & ! + 8.676267e-01, 8.676798e-01, 8.677286e-01, 8.677745e-01, 8.678178e-01, & ! + 8.678601e-01, 8.678986e-01, 8.679351e-01, 8.679693e-01, 8.680013e-01, & ! + 8.680334e-01, 8.680624e-01, 8.680915e-01, 8.681178e-01, 8.681428e-01, & ! + 8.681654e-01, 8.681899e-01, 8.682103e-01, 8.682317e-01, 8.682498e-01, & ! + 8.682677e-01, 8.682861e-01, 8.683041e-01, & ! + 7.877069e-01, 8.244281e-01, 8.367971e-01, 8.409074e-01, 8.429859e-01, & ! 14 + 8.454386e-01, 8.489350e-01, 8.534141e-01, 8.585814e-01, 8.641267e-01, & ! + 8.697999e-01, 8.754223e-01, 8.808785e-01, 8.860944e-01, 8.910354e-01, & ! + 8.956837e-01, 9.000392e-01, 9.041091e-01, 9.079071e-01, 9.114479e-01, & ! + 9.147462e-01, 9.178234e-01, 9.206903e-01, 9.233663e-01, 9.258668e-01, & ! + 9.282006e-01, 9.303847e-01, 9.324288e-01, 9.343418e-01, 9.361356e-01, & ! + 9.378176e-01, 9.393939e-01, 9.408736e-01, 9.422622e-01, 9.435670e-01, & ! + 9.447900e-01, 9.459395e-01, 9.470199e-01, 9.480335e-01, 9.489852e-01, & ! + 9.498782e-01, 9.507168e-01, 9.515044e-01, 9.522470e-01, 9.529409e-01, & ! + 9.535946e-01, 9.542071e-01, 9.547838e-01, 9.553256e-01, 9.558351e-01, & ! + 9.563139e-01, 9.567660e-01, 9.571915e-01, 9.575901e-01, 9.579685e-01, & ! + 9.583239e-01, 9.586602e-01, 9.589766e-01/), & ! + shape = (/58,nBandsSW_RRTMG/)) + + real(kind_phys),dimension(43,nBandsSW_RRTMG),parameter :: & ! + extice2 = reshape(source= (/ & ! + 4.101824e-01, 2.435514e-01, 1.713697e-01, 1.314865e-01, 1.063406e-01, & ! 1 + 8.910701e-02, 7.659480e-02, 6.711784e-02, 5.970353e-02, 5.375249e-02, & ! + 4.887577e-02, 4.481025e-02, 4.137171e-02, 3.842744e-02, 3.587948e-02, & ! + 3.365396e-02, 3.169419e-02, 2.995593e-02, 2.840419e-02, 2.701091e-02, & ! + 2.575336e-02, 2.461293e-02, 2.357423e-02, 2.262443e-02, 2.175276e-02, & ! + 2.095012e-02, 2.020875e-02, 1.952199e-02, 1.888412e-02, 1.829018e-02, & ! + 1.773586e-02, 1.721738e-02, 1.673144e-02, 1.627510e-02, 1.584579e-02, & ! + 1.544122e-02, 1.505934e-02, 1.469833e-02, 1.435654e-02, 1.403251e-02, & ! + 1.372492e-02, 1.343255e-02, 1.315433e-02, & ! + 3.836650e-01, 2.304055e-01, 1.637265e-01, 1.266681e-01, 1.031602e-01, & ! 2 + 8.695191e-02, 7.511544e-02, 6.610009e-02, 5.900909e-02, 5.328833e-02, & ! + 4.857728e-02, 4.463133e-02, 4.127880e-02, 3.839567e-02, 3.589013e-02, & ! + 3.369280e-02, 3.175027e-02, 3.002079e-02, 2.847121e-02, 2.707493e-02, & ! + 2.581031e-02, 2.465962e-02, 2.360815e-02, 2.264363e-02, 2.175571e-02, & ! + 2.093563e-02, 2.017592e-02, 1.947015e-02, 1.881278e-02, 1.819901e-02, & ! + 1.762463e-02, 1.708598e-02, 1.657982e-02, 1.610330e-02, 1.565390e-02, & ! + 1.522937e-02, 1.482768e-02, 1.444706e-02, 1.408588e-02, 1.374270e-02, & ! + 1.341619e-02, 1.310517e-02, 1.280857e-02, & ! + 4.152673e-01, 2.436816e-01, 1.702243e-01, 1.299704e-01, 1.047528e-01, & ! 3 + 8.756039e-02, 7.513327e-02, 6.575690e-02, 5.844616e-02, 5.259609e-02, & ! + 4.781531e-02, 4.383980e-02, 4.048517e-02, 3.761891e-02, 3.514342e-02, & ! + 3.298525e-02, 3.108814e-02, 2.940825e-02, 2.791096e-02, 2.656858e-02, & ! + 2.535869e-02, 2.426297e-02, 2.326627e-02, 2.235602e-02, 2.152164e-02, & ! + 2.075420e-02, 2.004613e-02, 1.939091e-02, 1.878296e-02, 1.821744e-02, & ! + 1.769015e-02, 1.719741e-02, 1.673600e-02, 1.630308e-02, 1.589615e-02, & ! + 1.551298e-02, 1.515159e-02, 1.481021e-02, 1.448726e-02, 1.418131e-02, & ! + 1.389109e-02, 1.361544e-02, 1.335330e-02, & ! + 3.873250e-01, 2.331609e-01, 1.655002e-01, 1.277753e-01, 1.038247e-01, & ! 4 + 8.731780e-02, 7.527638e-02, 6.611873e-02, 5.892850e-02, 5.313885e-02, & ! + 4.838068e-02, 4.440356e-02, 4.103167e-02, 3.813804e-02, 3.562870e-02, & ! + 3.343269e-02, 3.149539e-02, 2.977414e-02, 2.823510e-02, 2.685112e-02, & ! + 2.560015e-02, 2.446411e-02, 2.342805e-02, 2.247948e-02, 2.160789e-02, & ! + 2.080438e-02, 2.006139e-02, 1.937238e-02, 1.873177e-02, 1.813469e-02, & ! + 1.757689e-02, 1.705468e-02, 1.656479e-02, 1.610435e-02, 1.567081e-02, & ! + 1.526192e-02, 1.487565e-02, 1.451020e-02, 1.416396e-02, 1.383546e-02, & ! + 1.352339e-02, 1.322657e-02, 1.294392e-02, & ! + 3.784280e-01, 2.291396e-01, 1.632551e-01, 1.263775e-01, 1.028944e-01, & ! 5 + 8.666975e-02, 7.480952e-02, 6.577335e-02, 5.866714e-02, 5.293694e-02, & ! + 4.822153e-02, 4.427547e-02, 4.092626e-02, 3.804918e-02, 3.555184e-02, & ! + 3.336440e-02, 3.143307e-02, 2.971577e-02, 2.817912e-02, 2.679632e-02, & ! + 2.554558e-02, 2.440903e-02, 2.337187e-02, 2.242173e-02, 2.154821e-02, & ! + 2.074249e-02, 1.999706e-02, 1.930546e-02, 1.866212e-02, 1.806221e-02, & ! + 1.750152e-02, 1.697637e-02, 1.648352e-02, 1.602010e-02, 1.558358e-02, & ! + 1.517172e-02, 1.478250e-02, 1.441413e-02, 1.406498e-02, 1.373362e-02, & ! + 1.341872e-02, 1.311911e-02, 1.283371e-02, & ! + 3.719909e-01, 2.259490e-01, 1.613144e-01, 1.250648e-01, 1.019462e-01, & ! 6 + 8.595358e-02, 7.425064e-02, 6.532618e-02, 5.830218e-02, 5.263421e-02, & ! + 4.796697e-02, 4.405891e-02, 4.074013e-02, 3.788776e-02, 3.541071e-02, & ! + 3.324008e-02, 3.132280e-02, 2.961733e-02, 2.809071e-02, 2.671645e-02, & ! + 2.547302e-02, 2.434276e-02, 2.331102e-02, 2.236558e-02, 2.149614e-02, & ! + 2.069397e-02, 1.995163e-02, 1.926272e-02, 1.862174e-02, 1.802389e-02, & ! + 1.746500e-02, 1.694142e-02, 1.644994e-02, 1.598772e-02, 1.555225e-02, & ! + 1.514129e-02, 1.475286e-02, 1.438515e-02, 1.403659e-02, 1.370572e-02, & ! + 1.339124e-02, 1.309197e-02, 1.280685e-02, & ! + 3.713158e-01, 2.253816e-01, 1.608461e-01, 1.246718e-01, 1.016109e-01, & ! 7 + 8.566332e-02, 7.399666e-02, 6.510199e-02, 5.810290e-02, 5.245608e-02, & ! + 4.780702e-02, 4.391478e-02, 4.060989e-02, 3.776982e-02, 3.530374e-02, & ! + 3.314296e-02, 3.123458e-02, 2.953719e-02, 2.801794e-02, 2.665043e-02, & ! + 2.541321e-02, 2.428868e-02, 2.326224e-02, 2.232173e-02, 2.145688e-02, & ! + 2.065899e-02, 1.992067e-02, 1.923552e-02, 1.859808e-02, 1.800356e-02, & ! + 1.744782e-02, 1.692721e-02, 1.643855e-02, 1.597900e-02, 1.554606e-02, & ! + 1.513751e-02, 1.475137e-02, 1.438586e-02, 1.403938e-02, 1.371050e-02, & ! + 1.339793e-02, 1.310050e-02, 1.281713e-02, & ! + 3.605883e-01, 2.204388e-01, 1.580431e-01, 1.229033e-01, 1.004203e-01, & ! 8 + 8.482616e-02, 7.338941e-02, 6.465105e-02, 5.776176e-02, 5.219398e-02, & ! + 4.760288e-02, 4.375369e-02, 4.048111e-02, 3.766539e-02, 3.521771e-02, & ! + 3.307079e-02, 3.117277e-02, 2.948303e-02, 2.796929e-02, 2.660560e-02, & ! + 2.537086e-02, 2.424772e-02, 2.322182e-02, 2.228114e-02, 2.141556e-02, & ! + 2.061649e-02, 1.987661e-02, 1.918962e-02, 1.855009e-02, 1.795330e-02, & ! + 1.739514e-02, 1.687199e-02, 1.638069e-02, 1.591845e-02, 1.548276e-02, & ! + 1.507143e-02, 1.468249e-02, 1.431416e-02, 1.396486e-02, 1.363318e-02, & ! + 1.331781e-02, 1.301759e-02, 1.273147e-02, & ! + 3.527890e-01, 2.168469e-01, 1.560090e-01, 1.216216e-01, 9.955787e-02, & ! 9 + 8.421942e-02, 7.294827e-02, 6.432192e-02, 5.751081e-02, 5.199888e-02, & ! + 4.744835e-02, 4.362899e-02, 4.037847e-02, 3.757910e-02, 3.514351e-02, & ! + 3.300546e-02, 3.111382e-02, 2.942853e-02, 2.791775e-02, 2.655584e-02, & ! + 2.532195e-02, 2.419892e-02, 2.317255e-02, 2.223092e-02, 2.136402e-02, & ! + 2.056334e-02, 1.982160e-02, 1.913258e-02, 1.849087e-02, 1.789178e-02, & ! + 1.733124e-02, 1.680565e-02, 1.631187e-02, 1.584711e-02, 1.540889e-02, & ! + 1.499502e-02, 1.460354e-02, 1.423269e-02, 1.388088e-02, 1.354670e-02, & ! + 1.322887e-02, 1.292620e-02, 1.263767e-02, & ! + 3.477874e-01, 2.143515e-01, 1.544887e-01, 1.205942e-01, 9.881779e-02, & ! 10 + 8.366261e-02, 7.251586e-02, 6.397790e-02, 5.723183e-02, 5.176908e-02, & ! + 4.725658e-02, 4.346715e-02, 4.024055e-02, 3.746055e-02, 3.504080e-02, & ! + 3.291583e-02, 3.103507e-02, 2.935891e-02, 2.785582e-02, 2.650042e-02, & ! + 2.527206e-02, 2.415376e-02, 2.313142e-02, 2.219326e-02, 2.132934e-02, & ! + 2.053122e-02, 1.979169e-02, 1.910456e-02, 1.846448e-02, 1.786680e-02, & ! + 1.730745e-02, 1.678289e-02, 1.628998e-02, 1.582595e-02, 1.538835e-02, & ! + 1.497499e-02, 1.458393e-02, 1.421341e-02, 1.386187e-02, 1.352788e-02, & ! + 1.321019e-02, 1.290762e-02, 1.261913e-02, & ! + 3.453721e-01, 2.130744e-01, 1.536698e-01, 1.200140e-01, 9.838078e-02, & ! 11 + 8.331940e-02, 7.223803e-02, 6.374775e-02, 5.703770e-02, 5.160290e-02, & ! + 4.711259e-02, 4.334110e-02, 4.012923e-02, 3.736150e-02, 3.495208e-02, & ! + 3.283589e-02, 3.096267e-02, 2.929302e-02, 2.779560e-02, 2.644517e-02, & ! + 2.522119e-02, 2.410677e-02, 2.308788e-02, 2.215281e-02, 2.129165e-02, & ! + 2.049602e-02, 1.975874e-02, 1.907365e-02, 1.843542e-02, 1.783943e-02, & ! + 1.728162e-02, 1.675847e-02, 1.626685e-02, 1.580401e-02, 1.536750e-02, & ! + 1.495515e-02, 1.456502e-02, 1.419537e-02, 1.384463e-02, 1.351139e-02, & ! + 1.319438e-02, 1.289246e-02, 1.260456e-02, & ! + 3.417883e-01, 2.113379e-01, 1.526395e-01, 1.193347e-01, 9.790253e-02, & ! 12 + 8.296715e-02, 7.196979e-02, 6.353806e-02, 5.687024e-02, 5.146670e-02, & ! + 4.700001e-02, 4.324667e-02, 4.004894e-02, 3.729233e-02, 3.489172e-02, & ! + 3.278257e-02, 3.091499e-02, 2.924987e-02, 2.775609e-02, 2.640859e-02, & ! + 2.518695e-02, 2.407439e-02, 2.305697e-02, 2.212303e-02, 2.126273e-02, & ! + 2.046774e-02, 1.973090e-02, 1.904610e-02, 1.840801e-02, 1.781204e-02, & ! + 1.725417e-02, 1.673086e-02, 1.623902e-02, 1.577590e-02, 1.533906e-02, & ! + 1.492634e-02, 1.453580e-02, 1.416571e-02, 1.381450e-02, 1.348078e-02, & ! + 1.316327e-02, 1.286082e-02, 1.257240e-02, & ! + 3.416111e-01, 2.114124e-01, 1.527734e-01, 1.194809e-01, 9.804612e-02, & ! 13 + 8.310287e-02, 7.209595e-02, 6.365442e-02, 5.697710e-02, 5.156460e-02, & ! + 4.708957e-02, 4.332850e-02, 4.012361e-02, 3.736037e-02, 3.495364e-02, & ! + 3.283879e-02, 3.096593e-02, 2.929589e-02, 2.779751e-02, 2.644571e-02, & ! + 2.522004e-02, 2.410369e-02, 2.308271e-02, 2.214542e-02, 2.128195e-02, & ! + 2.048396e-02, 1.974429e-02, 1.905679e-02, 1.841614e-02, 1.781774e-02, & ! + 1.725754e-02, 1.673203e-02, 1.623807e-02, 1.577293e-02, 1.533416e-02, & ! + 1.491958e-02, 1.452727e-02, 1.415547e-02, 1.380262e-02, 1.346732e-02, & ! + 1.314830e-02, 1.284439e-02, 1.255456e-02, & ! + 4.196611e-01, 2.493642e-01, 1.761261e-01, 1.357197e-01, 1.102161e-01, & ! 14 + 9.269376e-02, 7.992985e-02, 7.022538e-02, 6.260168e-02, 5.645603e-02, & ! + 5.139732e-02, 4.716088e-02, 4.356133e-02, 4.046498e-02, 3.777303e-02, & ! + 3.541094e-02, 3.332137e-02, 3.145954e-02, 2.978998e-02, 2.828419e-02, & ! + 2.691905e-02, 2.567559e-02, 2.453811e-02, 2.349350e-02, 2.253072e-02, & ! + 2.164042e-02, 2.081464e-02, 2.004652e-02, 1.933015e-02, 1.866041e-02, & ! + 1.803283e-02, 1.744348e-02, 1.688894e-02, 1.636616e-02, 1.587244e-02, & ! + 1.540539e-02, 1.496287e-02, 1.454295e-02, 1.414392e-02, 1.376423e-02, & ! + 1.340247e-02, 1.305739e-02, 1.272784e-02/), & ! + shape = (/43,nBandsSW_RRTMG/)) + + real(kind_phys),dimension(43,nBandsSW_RRTMG),parameter :: & ! + ssaice2 = reshape(source= (/ & ! + 6.630615e-01, 6.451169e-01, 6.333696e-01, 6.246927e-01, 6.178420e-01, & ! 1 + 6.121976e-01, 6.074069e-01, 6.032505e-01, 5.995830e-01, 5.963030e-01, & ! + 5.933372e-01, 5.906311e-01, 5.881427e-01, 5.858395e-01, 5.836955e-01, & ! + 5.816896e-01, 5.798046e-01, 5.780264e-01, 5.763429e-01, 5.747441e-01, & ! + 5.732213e-01, 5.717672e-01, 5.703754e-01, 5.690403e-01, 5.677571e-01, & ! + 5.665215e-01, 5.653297e-01, 5.641782e-01, 5.630643e-01, 5.619850e-01, & ! + 5.609381e-01, 5.599214e-01, 5.589328e-01, 5.579707e-01, 5.570333e-01, & ! + 5.561193e-01, 5.552272e-01, 5.543558e-01, 5.535041e-01, 5.526708e-01, & ! + 5.518551e-01, 5.510561e-01, 5.502729e-01, & ! + 7.689749e-01, 7.398171e-01, 7.205819e-01, 7.065690e-01, 6.956928e-01, & ! 2 + 6.868989e-01, 6.795813e-01, 6.733606e-01, 6.679838e-01, 6.632742e-01, & ! + 6.591036e-01, 6.553766e-01, 6.520197e-01, 6.489757e-01, 6.461991e-01, & ! + 6.436531e-01, 6.413075e-01, 6.391375e-01, 6.371221e-01, 6.352438e-01, & ! + 6.334876e-01, 6.318406e-01, 6.302918e-01, 6.288315e-01, 6.274512e-01, & ! + 6.261436e-01, 6.249022e-01, 6.237211e-01, 6.225953e-01, 6.215201e-01, & ! + 6.204914e-01, 6.195055e-01, 6.185592e-01, 6.176492e-01, 6.167730e-01, & ! + 6.159280e-01, 6.151120e-01, 6.143228e-01, 6.135587e-01, 6.128177e-01, & ! + 6.120984e-01, 6.113993e-01, 6.107189e-01, & ! + 9.956167e-01, 9.814770e-01, 9.716104e-01, 9.639746e-01, 9.577179e-01, & ! 3 + 9.524010e-01, 9.477672e-01, 9.436527e-01, 9.399467e-01, 9.365708e-01, & ! + 9.334672e-01, 9.305921e-01, 9.279118e-01, 9.253993e-01, 9.230330e-01, & ! + 9.207954e-01, 9.186719e-01, 9.166501e-01, 9.147199e-01, 9.128722e-01, & ! + 9.110997e-01, 9.093956e-01, 9.077544e-01, 9.061708e-01, 9.046406e-01, & ! + 9.031598e-01, 9.017248e-01, 9.003326e-01, 8.989804e-01, 8.976655e-01, & ! + 8.963857e-01, 8.951389e-01, 8.939233e-01, 8.927370e-01, 8.915785e-01, & ! + 8.904464e-01, 8.893392e-01, 8.882559e-01, 8.871951e-01, 8.861559e-01, & ! + 8.851373e-01, 8.841383e-01, 8.831581e-01, & ! + 9.723177e-01, 9.452119e-01, 9.267592e-01, 9.127393e-01, 9.014238e-01, & ! 4 + 8.919334e-01, 8.837584e-01, 8.765773e-01, 8.701736e-01, 8.643950e-01, & ! + 8.591299e-01, 8.542942e-01, 8.498230e-01, 8.456651e-01, 8.417794e-01, & ! + 8.381324e-01, 8.346964e-01, 8.314484e-01, 8.283687e-01, 8.254408e-01, & ! + 8.226505e-01, 8.199854e-01, 8.174348e-01, 8.149891e-01, 8.126403e-01, & ! + 8.103808e-01, 8.082041e-01, 8.061044e-01, 8.040765e-01, 8.021156e-01, & ! + 8.002174e-01, 7.983781e-01, 7.965941e-01, 7.948622e-01, 7.931795e-01, & ! + 7.915432e-01, 7.899508e-01, 7.884002e-01, 7.868891e-01, 7.854156e-01, & ! + 7.839779e-01, 7.825742e-01, 7.812031e-01, & ! + 9.933294e-01, 9.860917e-01, 9.811564e-01, 9.774008e-01, 9.743652e-01, & ! 5 + 9.718155e-01, 9.696159e-01, 9.676810e-01, 9.659531e-01, 9.643915e-01, & ! + 9.629667e-01, 9.616561e-01, 9.604426e-01, 9.593125e-01, 9.582548e-01, & ! + 9.572607e-01, 9.563227e-01, 9.554347e-01, 9.545915e-01, 9.537888e-01, & ! + 9.530226e-01, 9.522898e-01, 9.515874e-01, 9.509130e-01, 9.502643e-01, & ! + 9.496394e-01, 9.490366e-01, 9.484542e-01, 9.478910e-01, 9.473456e-01, & ! + 9.468169e-01, 9.463039e-01, 9.458056e-01, 9.453212e-01, 9.448499e-01, & ! + 9.443910e-01, 9.439438e-01, 9.435077e-01, 9.430821e-01, 9.426666e-01, & ! + 9.422607e-01, 9.418638e-01, 9.414756e-01, & ! + 9.900787e-01, 9.828880e-01, 9.779258e-01, 9.741173e-01, 9.710184e-01, & ! 6 + 9.684012e-01, 9.661332e-01, 9.641301e-01, 9.623352e-01, 9.607083e-01, & ! + 9.592198e-01, 9.578474e-01, 9.565739e-01, 9.553856e-01, 9.542715e-01, & ! + 9.532226e-01, 9.522314e-01, 9.512919e-01, 9.503986e-01, 9.495472e-01, & ! + 9.487337e-01, 9.479549e-01, 9.472077e-01, 9.464897e-01, 9.457985e-01, & ! + 9.451322e-01, 9.444890e-01, 9.438673e-01, 9.432656e-01, 9.426826e-01, & ! + 9.421173e-01, 9.415684e-01, 9.410351e-01, 9.405164e-01, 9.400115e-01, & ! + 9.395198e-01, 9.390404e-01, 9.385728e-01, 9.381164e-01, 9.376707e-01, & ! + 9.372350e-01, 9.368091e-01, 9.363923e-01, & ! + 9.986793e-01, 9.985239e-01, 9.983911e-01, 9.982715e-01, 9.981606e-01, & ! 7 + 9.980562e-01, 9.979567e-01, 9.978613e-01, 9.977691e-01, 9.976798e-01, & ! + 9.975929e-01, 9.975081e-01, 9.974251e-01, 9.973438e-01, 9.972640e-01, & ! + 9.971855e-01, 9.971083e-01, 9.970322e-01, 9.969571e-01, 9.968830e-01, & ! + 9.968099e-01, 9.967375e-01, 9.966660e-01, 9.965951e-01, 9.965250e-01, & ! + 9.964555e-01, 9.963867e-01, 9.963185e-01, 9.962508e-01, 9.961836e-01, & ! + 9.961170e-01, 9.960508e-01, 9.959851e-01, 9.959198e-01, 9.958550e-01, & ! + 9.957906e-01, 9.957266e-01, 9.956629e-01, 9.955997e-01, 9.955367e-01, & ! + 9.954742e-01, 9.954119e-01, 9.953500e-01, & ! + 9.997944e-01, 9.997791e-01, 9.997664e-01, 9.997547e-01, 9.997436e-01, & ! 8 + 9.997327e-01, 9.997219e-01, 9.997110e-01, 9.996999e-01, 9.996886e-01, & ! + 9.996771e-01, 9.996653e-01, 9.996533e-01, 9.996409e-01, 9.996282e-01, & ! + 9.996152e-01, 9.996019e-01, 9.995883e-01, 9.995743e-01, 9.995599e-01, & ! + 9.995453e-01, 9.995302e-01, 9.995149e-01, 9.994992e-01, 9.994831e-01, & ! + 9.994667e-01, 9.994500e-01, 9.994329e-01, 9.994154e-01, 9.993976e-01, & ! + 9.993795e-01, 9.993610e-01, 9.993422e-01, 9.993230e-01, 9.993035e-01, & ! + 9.992837e-01, 9.992635e-01, 9.992429e-01, 9.992221e-01, 9.992008e-01, & ! + 9.991793e-01, 9.991574e-01, 9.991352e-01, & ! + 9.999949e-01, 9.999947e-01, 9.999943e-01, 9.999939e-01, 9.999934e-01, & ! 9 + 9.999927e-01, 9.999920e-01, 9.999913e-01, 9.999904e-01, 9.999895e-01, & ! + 9.999885e-01, 9.999874e-01, 9.999863e-01, 9.999851e-01, 9.999838e-01, & ! + 9.999824e-01, 9.999810e-01, 9.999795e-01, 9.999780e-01, 9.999764e-01, & ! + 9.999747e-01, 9.999729e-01, 9.999711e-01, 9.999692e-01, 9.999673e-01, & ! + 9.999653e-01, 9.999632e-01, 9.999611e-01, 9.999589e-01, 9.999566e-01, & ! + 9.999543e-01, 9.999519e-01, 9.999495e-01, 9.999470e-01, 9.999444e-01, & ! + 9.999418e-01, 9.999392e-01, 9.999364e-01, 9.999336e-01, 9.999308e-01, & ! + 9.999279e-01, 9.999249e-01, 9.999219e-01, & ! + 9.999997e-01, 9.999997e-01, 9.999997e-01, 9.999996e-01, 9.999996e-01, & ! 10 + 9.999995e-01, 9.999994e-01, 9.999993e-01, 9.999993e-01, 9.999992e-01, & ! + 9.999991e-01, 9.999989e-01, 9.999988e-01, 9.999987e-01, 9.999986e-01, & ! + 9.999984e-01, 9.999983e-01, 9.999981e-01, 9.999980e-01, 9.999978e-01, & ! + 9.999976e-01, 9.999974e-01, 9.999972e-01, 9.999971e-01, 9.999969e-01, & ! + 9.999966e-01, 9.999964e-01, 9.999962e-01, 9.999960e-01, 9.999957e-01, & ! + 9.999955e-01, 9.999953e-01, 9.999950e-01, 9.999947e-01, 9.999945e-01, & ! + 9.999942e-01, 9.999939e-01, 9.999936e-01, 9.999934e-01, 9.999931e-01, & ! + 9.999928e-01, 9.999925e-01, 9.999921e-01, & ! + 9.999997e-01, 9.999996e-01, 9.999996e-01, 9.999995e-01, 9.999994e-01, & ! 11 + 9.999993e-01, 9.999992e-01, 9.999991e-01, 9.999990e-01, 9.999989e-01, & ! + 9.999987e-01, 9.999986e-01, 9.999984e-01, 9.999982e-01, 9.999980e-01, & ! + 9.999978e-01, 9.999976e-01, 9.999974e-01, 9.999972e-01, 9.999970e-01, & ! + 9.999967e-01, 9.999965e-01, 9.999962e-01, 9.999959e-01, 9.999956e-01, & ! + 9.999954e-01, 9.999951e-01, 9.999947e-01, 9.999944e-01, 9.999941e-01, & ! + 9.999938e-01, 9.999934e-01, 9.999931e-01, 9.999927e-01, 9.999923e-01, & ! + 9.999920e-01, 9.999916e-01, 9.999912e-01, 9.999908e-01, 9.999904e-01, & ! + 9.999899e-01, 9.999895e-01, 9.999891e-01, & ! + 9.999987e-01, 9.999987e-01, 9.999985e-01, 9.999984e-01, 9.999982e-01, & ! 12 + 9.999980e-01, 9.999978e-01, 9.999976e-01, 9.999973e-01, 9.999970e-01, & ! + 9.999967e-01, 9.999964e-01, 9.999960e-01, 9.999956e-01, 9.999952e-01, & ! + 9.999948e-01, 9.999944e-01, 9.999939e-01, 9.999934e-01, 9.999929e-01, & ! + 9.999924e-01, 9.999918e-01, 9.999913e-01, 9.999907e-01, 9.999901e-01, & ! + 9.999894e-01, 9.999888e-01, 9.999881e-01, 9.999874e-01, 9.999867e-01, & ! + 9.999860e-01, 9.999853e-01, 9.999845e-01, 9.999837e-01, 9.999829e-01, & ! + 9.999821e-01, 9.999813e-01, 9.999804e-01, 9.999796e-01, 9.999787e-01, & ! + 9.999778e-01, 9.999768e-01, 9.999759e-01, & ! + 9.999989e-01, 9.999989e-01, 9.999987e-01, 9.999986e-01, 9.999984e-01, & ! 13 + 9.999982e-01, 9.999980e-01, 9.999978e-01, 9.999975e-01, 9.999972e-01, & ! + 9.999969e-01, 9.999966e-01, 9.999962e-01, 9.999958e-01, 9.999954e-01, & ! + 9.999950e-01, 9.999945e-01, 9.999941e-01, 9.999936e-01, 9.999931e-01, & ! + 9.999925e-01, 9.999920e-01, 9.999914e-01, 9.999908e-01, 9.999902e-01, & ! + 9.999896e-01, 9.999889e-01, 9.999883e-01, 9.999876e-01, 9.999869e-01, & ! + 9.999861e-01, 9.999854e-01, 9.999846e-01, 9.999838e-01, 9.999830e-01, & ! + 9.999822e-01, 9.999814e-01, 9.999805e-01, 9.999796e-01, 9.999787e-01, & ! + 9.999778e-01, 9.999769e-01, 9.999759e-01, & ! + 7.042143e-01, 6.691161e-01, 6.463240e-01, 6.296590e-01, 6.166381e-01, & ! 14 + 6.060183e-01, 5.970908e-01, 5.894144e-01, 5.826968e-01, 5.767343e-01, & ! + 5.713804e-01, 5.665256e-01, 5.620867e-01, 5.579987e-01, 5.542101e-01, & ! + 5.506794e-01, 5.473727e-01, 5.442620e-01, 5.413239e-01, 5.385389e-01, & ! + 5.358901e-01, 5.333633e-01, 5.309460e-01, 5.286277e-01, 5.263988e-01, & ! + 5.242512e-01, 5.221777e-01, 5.201719e-01, 5.182280e-01, 5.163410e-01, & ! + 5.145062e-01, 5.127197e-01, 5.109776e-01, 5.092766e-01, 5.076137e-01, & ! + 5.059860e-01, 5.043911e-01, 5.028266e-01, 5.012904e-01, 4.997805e-01, & ! + 4.982951e-01, 4.968326e-01, 4.953913e-01/), & ! + shape = (/43,nBandsSW_RRTMG/)) + + real(kind_phys),dimension(43,nBandsSW_RRTMG),parameter :: & ! + asyice2 = reshape(source= (/ & ! + 7.946655e-01, 8.547685e-01, 8.806016e-01, 8.949880e-01, 9.041676e-01, & ! 1 + 9.105399e-01, 9.152249e-01, 9.188160e-01, 9.216573e-01, 9.239620e-01, & ! + 9.258695e-01, 9.274745e-01, 9.288441e-01, 9.300267e-01, 9.310584e-01, & ! + 9.319665e-01, 9.327721e-01, 9.334918e-01, 9.341387e-01, 9.347236e-01, & ! + 9.352551e-01, 9.357402e-01, 9.361850e-01, 9.365942e-01, 9.369722e-01, & ! + 9.373225e-01, 9.376481e-01, 9.379516e-01, 9.382352e-01, 9.385010e-01, & ! + 9.387505e-01, 9.389854e-01, 9.392070e-01, 9.394163e-01, 9.396145e-01, & ! + 9.398024e-01, 9.399809e-01, 9.401508e-01, 9.403126e-01, 9.404670e-01, & ! + 9.406144e-01, 9.407555e-01, 9.408906e-01, & ! + 9.078091e-01, 9.195850e-01, 9.267250e-01, 9.317083e-01, 9.354632e-01, & ! 2 + 9.384323e-01, 9.408597e-01, 9.428935e-01, 9.446301e-01, 9.461351e-01, & ! + 9.474555e-01, 9.486259e-01, 9.496722e-01, 9.506146e-01, 9.514688e-01, & ! + 9.522476e-01, 9.529612e-01, 9.536181e-01, 9.542251e-01, 9.547883e-01, & ! + 9.553124e-01, 9.558019e-01, 9.562601e-01, 9.566904e-01, 9.570953e-01, & ! + 9.574773e-01, 9.578385e-01, 9.581806e-01, 9.585054e-01, 9.588142e-01, & ! + 9.591083e-01, 9.593888e-01, 9.596569e-01, 9.599135e-01, 9.601593e-01, & ! + 9.603952e-01, 9.606219e-01, 9.608399e-01, 9.610499e-01, 9.612523e-01, & ! + 9.614477e-01, 9.616365e-01, 9.618192e-01, & ! + 8.322045e-01, 8.528693e-01, 8.648167e-01, 8.729163e-01, 8.789054e-01, & ! 3 + 8.835845e-01, 8.873819e-01, 8.905511e-01, 8.932532e-01, 8.955965e-01, & ! + 8.976567e-01, 8.994887e-01, 9.011334e-01, 9.026221e-01, 9.039791e-01, & ! + 9.052237e-01, 9.063715e-01, 9.074349e-01, 9.084245e-01, 9.093489e-01, & ! + 9.102154e-01, 9.110303e-01, 9.117987e-01, 9.125253e-01, 9.132140e-01, & ! + 9.138682e-01, 9.144910e-01, 9.150850e-01, 9.156524e-01, 9.161955e-01, & ! + 9.167160e-01, 9.172157e-01, 9.176959e-01, 9.181581e-01, 9.186034e-01, & ! + 9.190330e-01, 9.194478e-01, 9.198488e-01, 9.202368e-01, 9.206126e-01, & ! + 9.209768e-01, 9.213301e-01, 9.216731e-01, & ! + 8.116560e-01, 8.488278e-01, 8.674331e-01, 8.788148e-01, 8.865810e-01, & ! 4 + 8.922595e-01, 8.966149e-01, 9.000747e-01, 9.028980e-01, 9.052513e-01, & ! + 9.072468e-01, 9.089632e-01, 9.104574e-01, 9.117713e-01, 9.129371e-01, & ! + 9.139793e-01, 9.149174e-01, 9.157668e-01, 9.165400e-01, 9.172473e-01, & ! + 9.178970e-01, 9.184962e-01, 9.190508e-01, 9.195658e-01, 9.200455e-01, & ! + 9.204935e-01, 9.209130e-01, 9.213067e-01, 9.216771e-01, 9.220262e-01, & ! + 9.223560e-01, 9.226680e-01, 9.229636e-01, 9.232443e-01, 9.235112e-01, & ! + 9.237652e-01, 9.240074e-01, 9.242385e-01, 9.244594e-01, 9.246708e-01, & ! + 9.248733e-01, 9.250674e-01, 9.252536e-01, & ! + 8.047113e-01, 8.402864e-01, 8.570332e-01, 8.668455e-01, 8.733206e-01, & ! 5 + 8.779272e-01, 8.813796e-01, 8.840676e-01, 8.862225e-01, 8.879904e-01, & ! + 8.894682e-01, 8.907228e-01, 8.918019e-01, 8.927404e-01, 8.935645e-01, & ! + 8.942943e-01, 8.949452e-01, 8.955296e-01, 8.960574e-01, 8.965366e-01, & ! + 8.969736e-01, 8.973740e-01, 8.977422e-01, 8.980820e-01, 8.983966e-01, & ! + 8.986889e-01, 8.989611e-01, 8.992153e-01, 8.994533e-01, 8.996766e-01, & ! + 8.998865e-01, 9.000843e-01, 9.002709e-01, 9.004474e-01, 9.006146e-01, & ! + 9.007731e-01, 9.009237e-01, 9.010670e-01, 9.012034e-01, 9.013336e-01, & ! + 9.014579e-01, 9.015767e-01, 9.016904e-01, & ! + 8.179122e-01, 8.480726e-01, 8.621945e-01, 8.704354e-01, 8.758555e-01, & ! 6 + 8.797007e-01, 8.825750e-01, 8.848078e-01, 8.865939e-01, 8.880564e-01, & ! + 8.892765e-01, 8.903105e-01, 8.911982e-01, 8.919689e-01, 8.926446e-01, & ! + 8.932419e-01, 8.937738e-01, 8.942506e-01, 8.946806e-01, 8.950702e-01, & ! + 8.954251e-01, 8.957497e-01, 8.960477e-01, 8.963223e-01, 8.965762e-01, & ! + 8.968116e-01, 8.970306e-01, 8.972347e-01, 8.974255e-01, 8.976042e-01, & ! + 8.977720e-01, 8.979298e-01, 8.980784e-01, 8.982188e-01, 8.983515e-01, & ! + 8.984771e-01, 8.985963e-01, 8.987095e-01, 8.988171e-01, 8.989195e-01, & ! + 8.990172e-01, 8.991104e-01, 8.991994e-01, & ! + 8.169789e-01, 8.455024e-01, 8.586925e-01, 8.663283e-01, 8.713217e-01, & ! 7 + 8.748488e-01, 8.774765e-01, 8.795122e-01, 8.811370e-01, 8.824649e-01, & ! + 8.835711e-01, 8.845073e-01, 8.853103e-01, 8.860068e-01, 8.866170e-01, & ! + 8.871560e-01, 8.876358e-01, 8.880658e-01, 8.884533e-01, 8.888044e-01, & ! + 8.891242e-01, 8.894166e-01, 8.896851e-01, 8.899324e-01, 8.901612e-01, & ! + 8.903733e-01, 8.905706e-01, 8.907545e-01, 8.909265e-01, 8.910876e-01, & ! + 8.912388e-01, 8.913812e-01, 8.915153e-01, 8.916419e-01, 8.917617e-01, & ! + 8.918752e-01, 8.919829e-01, 8.920851e-01, 8.921824e-01, 8.922751e-01, & ! + 8.923635e-01, 8.924478e-01, 8.925284e-01, & ! + 8.387642e-01, 8.569979e-01, 8.658630e-01, 8.711825e-01, 8.747605e-01, & ! 8 + 8.773472e-01, 8.793129e-01, 8.808621e-01, 8.821179e-01, 8.831583e-01, & ! + 8.840361e-01, 8.847875e-01, 8.854388e-01, 8.860094e-01, 8.865138e-01, & ! + 8.869634e-01, 8.873668e-01, 8.877310e-01, 8.880617e-01, 8.883635e-01, & ! + 8.886401e-01, 8.888947e-01, 8.891298e-01, 8.893477e-01, 8.895504e-01, & ! + 8.897393e-01, 8.899159e-01, 8.900815e-01, 8.902370e-01, 8.903833e-01, & ! + 8.905214e-01, 8.906518e-01, 8.907753e-01, 8.908924e-01, 8.910036e-01, & ! + 8.911094e-01, 8.912101e-01, 8.913062e-01, 8.913979e-01, 8.914856e-01, & ! + 8.915695e-01, 8.916498e-01, 8.917269e-01, & ! + 8.522208e-01, 8.648132e-01, 8.711224e-01, 8.749901e-01, 8.776354e-01, & ! 9 + 8.795743e-01, 8.810649e-01, 8.822518e-01, 8.832225e-01, 8.840333e-01, & ! + 8.847224e-01, 8.853162e-01, 8.858342e-01, 8.862906e-01, 8.866962e-01, & ! + 8.870595e-01, 8.873871e-01, 8.876842e-01, 8.879551e-01, 8.882032e-01, & ! + 8.884316e-01, 8.886425e-01, 8.888380e-01, 8.890199e-01, 8.891895e-01, & ! + 8.893481e-01, 8.894968e-01, 8.896366e-01, 8.897683e-01, 8.898926e-01, & ! + 8.900102e-01, 8.901215e-01, 8.902272e-01, 8.903276e-01, 8.904232e-01, & ! + 8.905144e-01, 8.906014e-01, 8.906845e-01, 8.907640e-01, 8.908402e-01, & ! + 8.909132e-01, 8.909834e-01, 8.910507e-01, & ! + 8.578202e-01, 8.683033e-01, 8.735431e-01, 8.767488e-01, 8.789378e-01, & ! 10 + 8.805399e-01, 8.817701e-01, 8.827485e-01, 8.835480e-01, 8.842152e-01, & ! + 8.847817e-01, 8.852696e-01, 8.856949e-01, 8.860694e-01, 8.864020e-01, & ! + 8.866997e-01, 8.869681e-01, 8.872113e-01, 8.874330e-01, 8.876360e-01, & ! + 8.878227e-01, 8.879951e-01, 8.881548e-01, 8.883033e-01, 8.884418e-01, & ! + 8.885712e-01, 8.886926e-01, 8.888066e-01, 8.889139e-01, 8.890152e-01, & ! + 8.891110e-01, 8.892017e-01, 8.892877e-01, 8.893695e-01, 8.894473e-01, & ! + 8.895214e-01, 8.895921e-01, 8.896597e-01, 8.897243e-01, 8.897862e-01, & ! + 8.898456e-01, 8.899025e-01, 8.899572e-01, & ! + 8.625615e-01, 8.713831e-01, 8.755799e-01, 8.780560e-01, 8.796983e-01, & ! 11 + 8.808714e-01, 8.817534e-01, 8.824420e-01, 8.829953e-01, 8.834501e-01, & ! + 8.838310e-01, 8.841549e-01, 8.844338e-01, 8.846767e-01, 8.848902e-01, & ! + 8.850795e-01, 8.852484e-01, 8.854002e-01, 8.855374e-01, 8.856620e-01, & ! + 8.857758e-01, 8.858800e-01, 8.859759e-01, 8.860644e-01, 8.861464e-01, & ! + 8.862225e-01, 8.862935e-01, 8.863598e-01, 8.864218e-01, 8.864800e-01, & ! + 8.865347e-01, 8.865863e-01, 8.866349e-01, 8.866809e-01, 8.867245e-01, & ! + 8.867658e-01, 8.868050e-01, 8.868423e-01, 8.868778e-01, 8.869117e-01, & ! + 8.869440e-01, 8.869749e-01, 8.870044e-01, & ! + 8.587495e-01, 8.684764e-01, 8.728189e-01, 8.752872e-01, 8.768846e-01, & ! 12 + 8.780060e-01, 8.788386e-01, 8.794824e-01, 8.799960e-01, 8.804159e-01, & ! + 8.807660e-01, 8.810626e-01, 8.813175e-01, 8.815390e-01, 8.817335e-01, & ! + 8.819057e-01, 8.820593e-01, 8.821973e-01, 8.823220e-01, 8.824353e-01, & ! + 8.825387e-01, 8.826336e-01, 8.827209e-01, 8.828016e-01, 8.828764e-01, & ! + 8.829459e-01, 8.830108e-01, 8.830715e-01, 8.831283e-01, 8.831817e-01, & ! + 8.832320e-01, 8.832795e-01, 8.833244e-01, 8.833668e-01, 8.834071e-01, & ! + 8.834454e-01, 8.834817e-01, 8.835164e-01, 8.835495e-01, 8.835811e-01, & ! + 8.836113e-01, 8.836402e-01, 8.836679e-01, & ! + 8.561110e-01, 8.678583e-01, 8.727554e-01, 8.753892e-01, 8.770154e-01, & ! 13 + 8.781109e-01, 8.788949e-01, 8.794812e-01, 8.799348e-01, 8.802952e-01, & ! + 8.805880e-01, 8.808300e-01, 8.810331e-01, 8.812058e-01, 8.813543e-01, & ! + 8.814832e-01, 8.815960e-01, 8.816956e-01, 8.817839e-01, 8.818629e-01, & ! + 8.819339e-01, 8.819979e-01, 8.820560e-01, 8.821089e-01, 8.821573e-01, & ! + 8.822016e-01, 8.822425e-01, 8.822801e-01, 8.823150e-01, 8.823474e-01, & ! + 8.823775e-01, 8.824056e-01, 8.824318e-01, 8.824564e-01, 8.824795e-01, & ! + 8.825011e-01, 8.825215e-01, 8.825408e-01, 8.825589e-01, 8.825761e-01, & ! + 8.825924e-01, 8.826078e-01, 8.826224e-01, & ! + 8.311124e-01, 8.688197e-01, 8.900274e-01, 9.040696e-01, 9.142334e-01, & ! 14 + 9.220181e-01, 9.282195e-01, 9.333048e-01, 9.375689e-01, 9.412085e-01, & ! + 9.443604e-01, 9.471230e-01, 9.495694e-01, 9.517549e-01, 9.537224e-01, & ! + 9.555057e-01, 9.571316e-01, 9.586222e-01, 9.599952e-01, 9.612656e-01, & ! + 9.624458e-01, 9.635461e-01, 9.645756e-01, 9.655418e-01, 9.664513e-01, & ! + 9.673098e-01, 9.681222e-01, 9.688928e-01, 9.696256e-01, 9.703237e-01, & ! + 9.709903e-01, 9.716280e-01, 9.722391e-01, 9.728258e-01, 9.733901e-01, & ! + 9.739336e-01, 9.744579e-01, 9.749645e-01, 9.754546e-01, 9.759294e-01, & ! + 9.763901e-01, 9.768376e-01, 9.772727e-01/), & ! + shape = (/43,nBandsSW_RRTMG/)) + + real(kind_phys),dimension(46,nBandsSW_RRTMG),parameter :: & ! + extice3 = reshape(source= (/ & ! + 5.194013e-01, 3.215089e-01, 2.327917e-01, 1.824424e-01, 1.499977e-01, & ! 1 + 1.273492e-01, 1.106421e-01, 9.780982e-02, 8.764435e-02, 7.939266e-02, & ! + 7.256081e-02, 6.681137e-02, 6.190600e-02, 5.767154e-02, 5.397915e-02, & ! + 5.073102e-02, 4.785151e-02, 4.528125e-02, 4.297296e-02, 4.088853e-02, & ! + 3.899690e-02, 3.727251e-02, 3.569411e-02, 3.424393e-02, 3.290694e-02, & ! + 3.167040e-02, 3.052340e-02, 2.945654e-02, 2.846172e-02, 2.753188e-02, & ! + 2.666085e-02, 2.584322e-02, 2.507423e-02, 2.434967e-02, 2.366579e-02, & ! + 2.301926e-02, 2.240711e-02, 2.182666e-02, 2.127551e-02, 2.075150e-02, & ! + 2.025267e-02, 1.977725e-02, 1.932364e-02, 1.889035e-02, 1.847607e-02, & ! + 1.807956e-02, & ! + 4.901155e-01, 3.065286e-01, 2.230800e-01, 1.753951e-01, 1.445402e-01, & ! 2 + 1.229417e-01, 1.069777e-01, 9.469760e-02, 8.495824e-02, 7.704501e-02, & ! + 7.048834e-02, 6.496693e-02, 6.025353e-02, 5.618286e-02, 5.263186e-02, & ! + 4.950698e-02, 4.673585e-02, 4.426164e-02, 4.203904e-02, 4.003153e-02, & ! + 3.820932e-02, 3.654790e-02, 3.502688e-02, 3.362919e-02, 3.234041e-02, & ! + 3.114829e-02, 3.004234e-02, 2.901356e-02, 2.805413e-02, 2.715727e-02, & ! + 2.631705e-02, 2.552828e-02, 2.478637e-02, 2.408725e-02, 2.342734e-02, & ! + 2.280343e-02, 2.221264e-02, 2.165242e-02, 2.112043e-02, 2.061461e-02, & ! + 2.013308e-02, 1.967411e-02, 1.923616e-02, 1.881783e-02, 1.841781e-02, & ! + 1.803494e-02, & ! + 5.056264e-01, 3.160261e-01, 2.298442e-01, 1.805973e-01, 1.487318e-01, & ! 3 + 1.264258e-01, 1.099389e-01, 9.725656e-02, 8.719819e-02, 7.902576e-02, & ! + 7.225433e-02, 6.655206e-02, 6.168427e-02, 5.748028e-02, 5.381296e-02, & ! + 5.058572e-02, 4.772383e-02, 4.516857e-02, 4.287317e-02, 4.079990e-02, & ! + 3.891801e-02, 3.720217e-02, 3.563133e-02, 3.418786e-02, 3.285686e-02, & ! + 3.162569e-02, 3.048352e-02, 2.942104e-02, 2.843018e-02, 2.750395e-02, & ! + 2.663621e-02, 2.582160e-02, 2.505539e-02, 2.433337e-02, 2.365185e-02, & ! + 2.300750e-02, 2.239736e-02, 2.181878e-02, 2.126937e-02, 2.074699e-02, & ! + 2.024968e-02, 1.977567e-02, 1.932338e-02, 1.889134e-02, 1.847823e-02, & ! + 1.808281e-02, & ! + 4.881605e-01, 3.055237e-01, 2.225070e-01, 1.750688e-01, 1.443736e-01, & ! 4 + 1.228869e-01, 1.070054e-01, 9.478893e-02, 8.509997e-02, 7.722769e-02, & ! + 7.070495e-02, 6.521211e-02, 6.052311e-02, 5.647351e-02, 5.294088e-02, & ! + 4.983217e-02, 4.707539e-02, 4.461398e-02, 4.240288e-02, 4.040575e-02, & ! + 3.859298e-02, 3.694016e-02, 3.542701e-02, 3.403655e-02, 3.275444e-02, & ! + 3.156849e-02, 3.046827e-02, 2.944481e-02, 2.849034e-02, 2.759812e-02, & ! + 2.676226e-02, 2.597757e-02, 2.523949e-02, 2.454400e-02, 2.388750e-02, & ! + 2.326682e-02, 2.267909e-02, 2.212176e-02, 2.159253e-02, 2.108933e-02, & ! + 2.061028e-02, 2.015369e-02, 1.971801e-02, 1.930184e-02, 1.890389e-02, & ! + 1.852300e-02, & ! + 5.103703e-01, 3.188144e-01, 2.317435e-01, 1.819887e-01, 1.497944e-01, & ! 5 + 1.272584e-01, 1.106013e-01, 9.778822e-02, 8.762610e-02, 7.936938e-02, & ! + 7.252809e-02, 6.676701e-02, 6.184901e-02, 5.760165e-02, 5.389651e-02, & ! + 5.063598e-02, 4.774457e-02, 4.516295e-02, 4.284387e-02, 4.074922e-02, & ! + 3.884792e-02, 3.711438e-02, 3.552734e-02, 3.406898e-02, 3.272425e-02, & ! + 3.148038e-02, 3.032643e-02, 2.925299e-02, 2.825191e-02, 2.731612e-02, & ! + 2.643943e-02, 2.561642e-02, 2.484230e-02, 2.411284e-02, 2.342429e-02, & ! + 2.277329e-02, 2.215686e-02, 2.157231e-02, 2.101724e-02, 2.048946e-02, & ! + 1.998702e-02, 1.950813e-02, 1.905118e-02, 1.861468e-02, 1.819730e-02, & ! + 1.779781e-02, & ! + 5.031161e-01, 3.144511e-01, 2.286942e-01, 1.796903e-01, 1.479819e-01, & ! 6 + 1.257860e-01, 1.093803e-01, 9.676059e-02, 8.675183e-02, 7.861971e-02, & ! + 7.188168e-02, 6.620754e-02, 6.136376e-02, 5.718050e-02, 5.353127e-02, & ! + 5.031995e-02, 4.747218e-02, 4.492952e-02, 4.264544e-02, 4.058240e-02, & ! + 3.870979e-02, 3.700242e-02, 3.543933e-02, 3.400297e-02, 3.267854e-02, & ! + 3.145345e-02, 3.031691e-02, 2.925967e-02, 2.827370e-02, 2.735203e-02, & ! + 2.648858e-02, 2.567798e-02, 2.491555e-02, 2.419710e-02, 2.351893e-02, & ! + 2.287776e-02, 2.227063e-02, 2.169491e-02, 2.114821e-02, 2.062840e-02, & ! + 2.013354e-02, 1.966188e-02, 1.921182e-02, 1.878191e-02, 1.837083e-02, & ! + 1.797737e-02, & ! + 4.949453e-01, 3.095918e-01, 2.253402e-01, 1.771964e-01, 1.460446e-01, & ! 7 + 1.242383e-01, 1.081206e-01, 9.572235e-02, 8.588928e-02, 7.789990e-02, & ! + 7.128013e-02, 6.570559e-02, 6.094684e-02, 5.683701e-02, 5.325183e-02, & ! + 5.009688e-02, 4.729909e-02, 4.480106e-02, 4.255708e-02, 4.053025e-02, & ! + 3.869051e-02, 3.701310e-02, 3.547745e-02, 3.406631e-02, 3.276512e-02, & ! + 3.156153e-02, 3.044494e-02, 2.940626e-02, 2.843759e-02, 2.753211e-02, & ! + 2.668381e-02, 2.588744e-02, 2.513839e-02, 2.443255e-02, 2.376629e-02, & ! + 2.313637e-02, 2.253990e-02, 2.197428e-02, 2.143718e-02, 2.092649e-02, & ! + 2.044032e-02, 1.997694e-02, 1.953478e-02, 1.911241e-02, 1.870855e-02, & ! + 1.832199e-02, & ! + 5.052816e-01, 3.157665e-01, 2.296233e-01, 1.803986e-01, 1.485473e-01, & ! 8 + 1.262514e-01, 1.097718e-01, 9.709524e-02, 8.704139e-02, 7.887264e-02, & ! + 7.210424e-02, 6.640454e-02, 6.153894e-02, 5.733683e-02, 5.367116e-02, & ! + 5.044537e-02, 4.758477e-02, 4.503066e-02, 4.273629e-02, 4.066395e-02, & ! + 3.878291e-02, 3.706784e-02, 3.549771e-02, 3.405488e-02, 3.272448e-02, & ! + 3.149387e-02, 3.035221e-02, 2.929020e-02, 2.829979e-02, 2.737397e-02, & ! + 2.650663e-02, 2.569238e-02, 2.492651e-02, 2.420482e-02, 2.352361e-02, & ! + 2.287954e-02, 2.226968e-02, 2.169136e-02, 2.114220e-02, 2.062005e-02, & ! + 2.012296e-02, 1.964917e-02, 1.919709e-02, 1.876524e-02, 1.835231e-02, & ! + 1.795707e-02, & ! + 5.042067e-01, 3.151195e-01, 2.291708e-01, 1.800573e-01, 1.482779e-01, & ! 9 + 1.260324e-01, 1.095900e-01, 9.694202e-02, 8.691087e-02, 7.876056e-02, & ! + 7.200745e-02, 6.632062e-02, 6.146600e-02, 5.727338e-02, 5.361599e-02, & ! + 5.039749e-02, 4.754334e-02, 4.499500e-02, 4.270580e-02, 4.063815e-02, & ! + 3.876135e-02, 3.705016e-02, 3.548357e-02, 3.404400e-02, 3.271661e-02, & ! + 3.148877e-02, 3.034969e-02, 2.929008e-02, 2.830191e-02, 2.737818e-02, & ! + 2.651279e-02, 2.570039e-02, 2.493624e-02, 2.421618e-02, 2.353650e-02, & ! + 2.289390e-02, 2.228541e-02, 2.170840e-02, 2.116048e-02, 2.063950e-02, & ! + 2.014354e-02, 1.967082e-02, 1.921975e-02, 1.878888e-02, 1.837688e-02, & ! + 1.798254e-02, & ! + 5.022507e-01, 3.139246e-01, 2.283218e-01, 1.794059e-01, 1.477544e-01, & ! 10 + 1.255984e-01, 1.092222e-01, 9.662516e-02, 8.663439e-02, 7.851688e-02, & ! + 7.179095e-02, 6.612700e-02, 6.129193e-02, 5.711618e-02, 5.347351e-02, & ! + 5.026796e-02, 4.742530e-02, 4.488721e-02, 4.260724e-02, 4.054790e-02, & ! + 3.867866e-02, 3.697435e-02, 3.541407e-02, 3.398029e-02, 3.265824e-02, & ! + 3.143535e-02, 3.030085e-02, 2.924551e-02, 2.826131e-02, 2.734130e-02, & ! + 2.647939e-02, 2.567026e-02, 2.490919e-02, 2.419203e-02, 2.351509e-02, & ! + 2.287507e-02, 2.226903e-02, 2.169434e-02, 2.114862e-02, 2.062975e-02, & ! + 2.013578e-02, 1.966496e-02, 1.921571e-02, 1.878658e-02, 1.837623e-02, & ! + 1.798348e-02, & ! + 5.068316e-01, 3.166869e-01, 2.302576e-01, 1.808693e-01, 1.489122e-01, & ! 11 + 1.265423e-01, 1.100080e-01, 9.728926e-02, 8.720201e-02, 7.900612e-02, & ! + 7.221524e-02, 6.649660e-02, 6.161484e-02, 5.739877e-02, 5.372093e-02, & ! + 5.048442e-02, 4.761431e-02, 4.505172e-02, 4.274972e-02, 4.067050e-02, & ! + 3.878321e-02, 3.706244e-02, 3.548710e-02, 3.403948e-02, 3.270466e-02, & ! + 3.146995e-02, 3.032450e-02, 2.925897e-02, 2.826527e-02, 2.733638e-02, & ! + 2.646615e-02, 2.564920e-02, 2.488078e-02, 2.415670e-02, 2.347322e-02, & ! + 2.282702e-02, 2.221513e-02, 2.163489e-02, 2.108390e-02, 2.056002e-02, & ! + 2.006128e-02, 1.958591e-02, 1.913232e-02, 1.869904e-02, 1.828474e-02, & ! + 1.788819e-02, & ! + 5.077707e-01, 3.172636e-01, 2.306695e-01, 1.811871e-01, 1.491691e-01, & ! 12 + 1.267565e-01, 1.101907e-01, 9.744773e-02, 8.734125e-02, 7.912973e-02, & ! + 7.232591e-02, 6.659637e-02, 6.170530e-02, 5.748120e-02, 5.379634e-02, & ! + 5.055367e-02, 4.767809e-02, 4.511061e-02, 4.280423e-02, 4.072104e-02, & ! + 3.883015e-02, 3.710611e-02, 3.552776e-02, 3.407738e-02, 3.274002e-02, & ! + 3.150296e-02, 3.035532e-02, 2.928776e-02, 2.829216e-02, 2.736150e-02, & ! + 2.648961e-02, 2.567111e-02, 2.490123e-02, 2.417576e-02, 2.349098e-02, & ! + 2.284354e-02, 2.223049e-02, 2.164914e-02, 2.109711e-02, 2.057222e-02, & ! + 2.007253e-02, 1.959626e-02, 1.914181e-02, 1.870770e-02, 1.829261e-02, & ! + 1.789531e-02, & ! + 5.062281e-01, 3.163402e-01, 2.300275e-01, 1.807060e-01, 1.487921e-01, & ! 13 + 1.264523e-01, 1.099403e-01, 9.723879e-02, 8.716516e-02, 7.898034e-02, & ! + 7.219863e-02, 6.648771e-02, 6.161254e-02, 5.740217e-02, 5.372929e-02, & ! + 5.049716e-02, 4.763092e-02, 4.507179e-02, 4.277290e-02, 4.069649e-02, & ! + 3.881175e-02, 3.709331e-02, 3.552008e-02, 3.407442e-02, 3.274141e-02, & ! + 3.150837e-02, 3.036447e-02, 2.930037e-02, 2.830801e-02, 2.738037e-02, & ! + 2.651132e-02, 2.569547e-02, 2.492810e-02, 2.420499e-02, 2.352243e-02, & ! + 2.287710e-02, 2.226604e-02, 2.168658e-02, 2.113634e-02, 2.061316e-02, & ! + 2.011510e-02, 1.964038e-02, 1.918740e-02, 1.875471e-02, 1.834096e-02, & ! + 1.794495e-02, & ! + 1.338834e-01, 1.924912e-01, 1.755523e-01, 1.534793e-01, 1.343937e-01, & ! 14 + 1.187883e-01, 1.060654e-01, 9.559106e-02, 8.685880e-02, 7.948698e-02, & ! + 7.319086e-02, 6.775669e-02, 6.302215e-02, 5.886236e-02, 5.517996e-02, & ! + 5.189810e-02, 4.895539e-02, 4.630225e-02, 4.389823e-02, 4.171002e-02, & ! + 3.970998e-02, 3.787493e-02, 3.618537e-02, 3.462471e-02, 3.317880e-02, & ! + 3.183547e-02, 3.058421e-02, 2.941590e-02, 2.832256e-02, 2.729724e-02, & ! + 2.633377e-02, 2.542675e-02, 2.457136e-02, 2.376332e-02, 2.299882e-02, & ! + 2.227443e-02, 2.158707e-02, 2.093400e-02, 2.031270e-02, 1.972091e-02, & ! + 1.915659e-02, 1.861787e-02, 1.810304e-02, 1.761055e-02, 1.713899e-02, & ! + 1.668704e-02 /), & ! + shape = (/46,nBandsSW_RRTMG/)) + + real(kind_phys),dimension(46,nBandsSW_RRTMG),parameter :: & ! + ssaice3 = reshape(source= (/ & ! + 6.749442e-01, 6.649947e-01, 6.565828e-01, 6.489928e-01, 6.420046e-01, & ! 1 + 6.355231e-01, 6.294964e-01, 6.238901e-01, 6.186783e-01, 6.138395e-01, & ! + 6.093543e-01, 6.052049e-01, 6.013742e-01, 5.978457e-01, 5.946030e-01, & ! + 5.916302e-01, 5.889115e-01, 5.864310e-01, 5.841731e-01, 5.821221e-01, & ! + 5.802624e-01, 5.785785e-01, 5.770549e-01, 5.756759e-01, 5.744262e-01, & ! + 5.732901e-01, 5.722524e-01, 5.712974e-01, 5.704097e-01, 5.695739e-01, & ! + 5.687747e-01, 5.679964e-01, 5.672238e-01, 5.664415e-01, 5.656340e-01, & ! + 5.647860e-01, 5.638821e-01, 5.629070e-01, 5.618452e-01, 5.606815e-01, & ! + 5.594006e-01, 5.579870e-01, 5.564255e-01, 5.547008e-01, 5.527976e-01, & ! + 5.507005e-01, & ! + 7.628550e-01, 7.567297e-01, 7.508463e-01, 7.451972e-01, 7.397745e-01, & ! 2 + 7.345705e-01, 7.295775e-01, 7.247881e-01, 7.201945e-01, 7.157894e-01, & ! + 7.115652e-01, 7.075145e-01, 7.036300e-01, 6.999044e-01, 6.963304e-01, & ! + 6.929007e-01, 6.896083e-01, 6.864460e-01, 6.834067e-01, 6.804833e-01, & ! + 6.776690e-01, 6.749567e-01, 6.723397e-01, 6.698109e-01, 6.673637e-01, & ! + 6.649913e-01, 6.626870e-01, 6.604441e-01, 6.582561e-01, 6.561163e-01, & ! + 6.540182e-01, 6.519554e-01, 6.499215e-01, 6.479099e-01, 6.459145e-01, & ! + 6.439289e-01, 6.419468e-01, 6.399621e-01, 6.379686e-01, 6.359601e-01, & ! + 6.339306e-01, 6.318740e-01, 6.297845e-01, 6.276559e-01, 6.254825e-01, & ! + 6.232583e-01, & ! + 9.924147e-01, 9.882792e-01, 9.842257e-01, 9.802522e-01, 9.763566e-01, & ! 3 + 9.725367e-01, 9.687905e-01, 9.651157e-01, 9.615104e-01, 9.579725e-01, & ! + 9.544997e-01, 9.510901e-01, 9.477416e-01, 9.444520e-01, 9.412194e-01, & ! + 9.380415e-01, 9.349165e-01, 9.318421e-01, 9.288164e-01, 9.258373e-01, & ! + 9.229027e-01, 9.200106e-01, 9.171589e-01, 9.143457e-01, 9.115688e-01, & ! + 9.088263e-01, 9.061161e-01, 9.034362e-01, 9.007846e-01, 8.981592e-01, & ! + 8.955581e-01, 8.929792e-01, 8.904206e-01, 8.878803e-01, 8.853562e-01, & ! + 8.828464e-01, 8.803488e-01, 8.778616e-01, 8.753827e-01, 8.729102e-01, & ! + 8.704421e-01, 8.679764e-01, 8.655112e-01, 8.630445e-01, 8.605744e-01, & ! + 8.580989e-01, & ! + 9.629413e-01, 9.517182e-01, 9.409209e-01, 9.305366e-01, 9.205529e-01, & ! 4 + 9.109569e-01, 9.017362e-01, 8.928780e-01, 8.843699e-01, 8.761992e-01, & ! + 8.683536e-01, 8.608204e-01, 8.535873e-01, 8.466417e-01, 8.399712e-01, & ! + 8.335635e-01, 8.274062e-01, 8.214868e-01, 8.157932e-01, 8.103129e-01, & ! + 8.050336e-01, 7.999432e-01, 7.950294e-01, 7.902798e-01, 7.856825e-01, & ! + 7.812250e-01, 7.768954e-01, 7.726815e-01, 7.685711e-01, 7.645522e-01, & ! + 7.606126e-01, 7.567404e-01, 7.529234e-01, 7.491498e-01, 7.454074e-01, & ! + 7.416844e-01, 7.379688e-01, 7.342485e-01, 7.305118e-01, 7.267468e-01, & ! + 7.229415e-01, 7.190841e-01, 7.151628e-01, 7.111657e-01, 7.070811e-01, & ! + 7.028972e-01, & ! + 9.942270e-01, 9.909206e-01, 9.876775e-01, 9.844960e-01, 9.813746e-01, & ! 5 + 9.783114e-01, 9.753049e-01, 9.723535e-01, 9.694553e-01, 9.666088e-01, & ! + 9.638123e-01, 9.610641e-01, 9.583626e-01, 9.557060e-01, 9.530928e-01, & ! + 9.505211e-01, 9.479895e-01, 9.454961e-01, 9.430393e-01, 9.406174e-01, & ! + 9.382288e-01, 9.358717e-01, 9.335446e-01, 9.312456e-01, 9.289731e-01, & ! + 9.267255e-01, 9.245010e-01, 9.222980e-01, 9.201147e-01, 9.179496e-01, & ! + 9.158008e-01, 9.136667e-01, 9.115457e-01, 9.094359e-01, 9.073358e-01, & ! + 9.052436e-01, 9.031577e-01, 9.010763e-01, 8.989977e-01, 8.969203e-01, & ! + 8.948423e-01, 8.927620e-01, 8.906778e-01, 8.885879e-01, 8.864907e-01, & ! + 8.843843e-01, & ! + 9.934014e-01, 9.899331e-01, 9.865537e-01, 9.832610e-01, 9.800523e-01, & ! 6 + 9.769254e-01, 9.738777e-01, 9.709069e-01, 9.680106e-01, 9.651862e-01, & ! + 9.624315e-01, 9.597439e-01, 9.571212e-01, 9.545608e-01, 9.520605e-01, & ! + 9.496177e-01, 9.472301e-01, 9.448954e-01, 9.426111e-01, 9.403749e-01, & ! + 9.381843e-01, 9.360370e-01, 9.339307e-01, 9.318629e-01, 9.298313e-01, & ! + 9.278336e-01, 9.258673e-01, 9.239302e-01, 9.220198e-01, 9.201338e-01, & ! + 9.182700e-01, 9.164258e-01, 9.145991e-01, 9.127874e-01, 9.109884e-01, & ! + 9.091999e-01, 9.074194e-01, 9.056447e-01, 9.038735e-01, 9.021033e-01, & ! + 9.003320e-01, 8.985572e-01, 8.967766e-01, 8.949879e-01, 8.931888e-01, & ! + 8.913770e-01, & ! + 9.994833e-01, 9.992055e-01, 9.989278e-01, 9.986500e-01, 9.983724e-01, & ! 7 + 9.980947e-01, 9.978172e-01, 9.975397e-01, 9.972623e-01, 9.969849e-01, & ! + 9.967077e-01, 9.964305e-01, 9.961535e-01, 9.958765e-01, 9.955997e-01, & ! + 9.953230e-01, 9.950464e-01, 9.947699e-01, 9.944936e-01, 9.942174e-01, & ! + 9.939414e-01, 9.936656e-01, 9.933899e-01, 9.931144e-01, 9.928390e-01, & ! + 9.925639e-01, 9.922889e-01, 9.920141e-01, 9.917396e-01, 9.914652e-01, & ! + 9.911911e-01, 9.909171e-01, 9.906434e-01, 9.903700e-01, 9.900967e-01, & ! + 9.898237e-01, 9.895510e-01, 9.892784e-01, 9.890062e-01, 9.887342e-01, & ! + 9.884625e-01, 9.881911e-01, 9.879199e-01, 9.876490e-01, 9.873784e-01, & ! + 9.871081e-01, & ! + 9.999343e-01, 9.998917e-01, 9.998492e-01, 9.998067e-01, 9.997642e-01, & ! 8 + 9.997218e-01, 9.996795e-01, 9.996372e-01, 9.995949e-01, 9.995528e-01, & ! + 9.995106e-01, 9.994686e-01, 9.994265e-01, 9.993845e-01, 9.993426e-01, & ! + 9.993007e-01, 9.992589e-01, 9.992171e-01, 9.991754e-01, 9.991337e-01, & ! + 9.990921e-01, 9.990505e-01, 9.990089e-01, 9.989674e-01, 9.989260e-01, & ! + 9.988846e-01, 9.988432e-01, 9.988019e-01, 9.987606e-01, 9.987194e-01, & ! + 9.986782e-01, 9.986370e-01, 9.985959e-01, 9.985549e-01, 9.985139e-01, & ! + 9.984729e-01, 9.984319e-01, 9.983910e-01, 9.983502e-01, 9.983094e-01, & ! + 9.982686e-01, 9.982279e-01, 9.981872e-01, 9.981465e-01, 9.981059e-01, & ! + 9.980653e-01, & ! + 9.999978e-01, 9.999965e-01, 9.999952e-01, 9.999939e-01, 9.999926e-01, & ! 9 + 9.999913e-01, 9.999900e-01, 9.999887e-01, 9.999873e-01, 9.999860e-01, & ! + 9.999847e-01, 9.999834e-01, 9.999821e-01, 9.999808e-01, 9.999795e-01, & ! + 9.999782e-01, 9.999769e-01, 9.999756e-01, 9.999743e-01, 9.999730e-01, & ! + 9.999717e-01, 9.999704e-01, 9.999691e-01, 9.999678e-01, 9.999665e-01, & ! + 9.999652e-01, 9.999639e-01, 9.999626e-01, 9.999613e-01, 9.999600e-01, & ! + 9.999587e-01, 9.999574e-01, 9.999561e-01, 9.999548e-01, 9.999535e-01, & ! + 9.999522e-01, 9.999509e-01, 9.999496e-01, 9.999483e-01, 9.999470e-01, & ! + 9.999457e-01, 9.999444e-01, 9.999431e-01, 9.999418e-01, 9.999405e-01, & ! + 9.999392e-01, & ! + 9.999994e-01, 9.999993e-01, 9.999991e-01, 9.999990e-01, 9.999989e-01, & ! 10 + 9.999987e-01, 9.999986e-01, 9.999984e-01, 9.999983e-01, 9.999982e-01, & ! + 9.999980e-01, 9.999979e-01, 9.999977e-01, 9.999976e-01, 9.999975e-01, & ! + 9.999973e-01, 9.999972e-01, 9.999970e-01, 9.999969e-01, 9.999967e-01, & ! + 9.999966e-01, 9.999965e-01, 9.999963e-01, 9.999962e-01, 9.999960e-01, & ! + 9.999959e-01, 9.999957e-01, 9.999956e-01, 9.999954e-01, 9.999953e-01, & ! + 9.999952e-01, 9.999950e-01, 9.999949e-01, 9.999947e-01, 9.999946e-01, & ! + 9.999944e-01, 9.999943e-01, 9.999941e-01, 9.999940e-01, 9.999939e-01, & ! + 9.999937e-01, 9.999936e-01, 9.999934e-01, 9.999933e-01, 9.999931e-01, & ! + 9.999930e-01, & ! + 9.999997e-01, 9.999995e-01, 9.999992e-01, 9.999990e-01, 9.999987e-01, & ! 11 + 9.999985e-01, 9.999983e-01, 9.999980e-01, 9.999978e-01, 9.999976e-01, & ! + 9.999973e-01, 9.999971e-01, 9.999969e-01, 9.999967e-01, 9.999965e-01, & ! + 9.999963e-01, 9.999960e-01, 9.999958e-01, 9.999956e-01, 9.999954e-01, & ! + 9.999952e-01, 9.999950e-01, 9.999948e-01, 9.999946e-01, 9.999944e-01, & ! + 9.999942e-01, 9.999939e-01, 9.999937e-01, 9.999935e-01, 9.999933e-01, & ! + 9.999931e-01, 9.999929e-01, 9.999927e-01, 9.999925e-01, 9.999923e-01, & ! + 9.999920e-01, 9.999918e-01, 9.999916e-01, 9.999914e-01, 9.999911e-01, & ! + 9.999909e-01, 9.999907e-01, 9.999905e-01, 9.999902e-01, 9.999900e-01, & ! + 9.999897e-01, & ! + 9.999991e-01, 9.999985e-01, 9.999980e-01, 9.999974e-01, 9.999968e-01, & ! 12 + 9.999963e-01, 9.999957e-01, 9.999951e-01, 9.999946e-01, 9.999940e-01, & ! + 9.999934e-01, 9.999929e-01, 9.999923e-01, 9.999918e-01, 9.999912e-01, & ! + 9.999907e-01, 9.999901e-01, 9.999896e-01, 9.999891e-01, 9.999885e-01, & ! + 9.999880e-01, 9.999874e-01, 9.999869e-01, 9.999863e-01, 9.999858e-01, & ! + 9.999853e-01, 9.999847e-01, 9.999842e-01, 9.999836e-01, 9.999831e-01, & ! + 9.999826e-01, 9.999820e-01, 9.999815e-01, 9.999809e-01, 9.999804e-01, & ! + 9.999798e-01, 9.999793e-01, 9.999787e-01, 9.999782e-01, 9.999776e-01, & ! + 9.999770e-01, 9.999765e-01, 9.999759e-01, 9.999754e-01, 9.999748e-01, & ! + 9.999742e-01, & ! + 9.999975e-01, 9.999961e-01, 9.999946e-01, 9.999931e-01, 9.999917e-01, & ! 13 + 9.999903e-01, 9.999888e-01, 9.999874e-01, 9.999859e-01, 9.999845e-01, & ! + 9.999831e-01, 9.999816e-01, 9.999802e-01, 9.999788e-01, 9.999774e-01, & ! + 9.999759e-01, 9.999745e-01, 9.999731e-01, 9.999717e-01, 9.999702e-01, & ! + 9.999688e-01, 9.999674e-01, 9.999660e-01, 9.999646e-01, 9.999631e-01, & ! + 9.999617e-01, 9.999603e-01, 9.999589e-01, 9.999574e-01, 9.999560e-01, & ! + 9.999546e-01, 9.999532e-01, 9.999517e-01, 9.999503e-01, 9.999489e-01, & ! + 9.999474e-01, 9.999460e-01, 9.999446e-01, 9.999431e-01, 9.999417e-01, & ! + 9.999403e-01, 9.999388e-01, 9.999374e-01, 9.999359e-01, 9.999345e-01, & ! + 9.999330e-01, & ! + 4.526500e-01, 5.287890e-01, 5.410487e-01, 5.459865e-01, 5.485149e-01, & ! 14 + 5.498914e-01, 5.505895e-01, 5.508310e-01, 5.507364e-01, 5.503793e-01, & ! + 5.498090e-01, 5.490612e-01, 5.481637e-01, 5.471395e-01, 5.460083e-01, & ! + 5.447878e-01, 5.434946e-01, 5.421442e-01, 5.407514e-01, 5.393309e-01, & ! + 5.378970e-01, 5.364641e-01, 5.350464e-01, 5.336582e-01, 5.323140e-01, & ! + 5.310283e-01, 5.298158e-01, 5.286914e-01, 5.276704e-01, 5.267680e-01, & ! + 5.260000e-01, 5.253823e-01, 5.249311e-01, 5.246629e-01, 5.245946e-01, & ! + 5.247434e-01, 5.251268e-01, 5.257626e-01, 5.266693e-01, 5.278653e-01, & ! + 5.293698e-01, 5.312022e-01, 5.333823e-01, 5.359305e-01, 5.388676e-01, & ! + 5.422146e-01/), & ! + shape = (/46,nBandsSW_RRTMG/)) + + real(kind_phys),dimension(46,nBandsSW_RRTMG),parameter :: & ! + asyice3 = reshape(source= (/ & ! + 8.340752e-01, 8.435170e-01, 8.517487e-01, 8.592064e-01, 8.660387e-01, & ! 1 + 8.723204e-01, 8.780997e-01, 8.834137e-01, 8.882934e-01, 8.927662e-01, & ! + 8.968577e-01, 9.005914e-01, 9.039899e-01, 9.070745e-01, 9.098659e-01, & ! + 9.123836e-01, 9.146466e-01, 9.166734e-01, 9.184817e-01, 9.200886e-01, & ! + 9.215109e-01, 9.227648e-01, 9.238661e-01, 9.248304e-01, 9.256727e-01, & ! + 9.264078e-01, 9.270505e-01, 9.276150e-01, 9.281156e-01, 9.285662e-01, & ! + 9.289806e-01, 9.293726e-01, 9.297557e-01, 9.301435e-01, 9.305491e-01, & ! + 9.309859e-01, 9.314671e-01, 9.320055e-01, 9.326140e-01, 9.333053e-01, & ! + 9.340919e-01, 9.349861e-01, 9.360000e-01, 9.371451e-01, 9.384329e-01, & ! + 9.398744e-01, & ! + 8.728160e-01, 8.777333e-01, 8.823754e-01, 8.867535e-01, 8.908785e-01, & ! 2 + 8.947611e-01, 8.984118e-01, 9.018408e-01, 9.050582e-01, 9.080739e-01, & ! + 9.108976e-01, 9.135388e-01, 9.160068e-01, 9.183106e-01, 9.204595e-01, & ! + 9.224620e-01, 9.243271e-01, 9.260632e-01, 9.276788e-01, 9.291822e-01, & ! + 9.305817e-01, 9.318853e-01, 9.331012e-01, 9.342372e-01, 9.353013e-01, & ! + 9.363013e-01, 9.372450e-01, 9.381400e-01, 9.389939e-01, 9.398145e-01, & ! + 9.406092e-01, 9.413856e-01, 9.421511e-01, 9.429131e-01, 9.436790e-01, & ! + 9.444561e-01, 9.452517e-01, 9.460729e-01, 9.469270e-01, 9.478209e-01, & ! + 9.487617e-01, 9.497562e-01, 9.508112e-01, 9.519335e-01, 9.531294e-01, & ! + 9.544055e-01, & ! + 7.897566e-01, 7.948704e-01, 7.998041e-01, 8.045623e-01, 8.091495e-01, & ! 3 + 8.135702e-01, 8.178290e-01, 8.219305e-01, 8.258790e-01, 8.296792e-01, & ! + 8.333355e-01, 8.368524e-01, 8.402343e-01, 8.434856e-01, 8.466108e-01, & ! + 8.496143e-01, 8.525004e-01, 8.552737e-01, 8.579384e-01, 8.604990e-01, & ! + 8.629597e-01, 8.653250e-01, 8.675992e-01, 8.697867e-01, 8.718916e-01, & ! + 8.739185e-01, 8.758715e-01, 8.777551e-01, 8.795734e-01, 8.813308e-01, & ! + 8.830315e-01, 8.846799e-01, 8.862802e-01, 8.878366e-01, 8.893534e-01, & ! + 8.908350e-01, 8.922854e-01, 8.937090e-01, 8.951099e-01, 8.964925e-01, & ! + 8.978609e-01, 8.992192e-01, 9.005718e-01, 9.019229e-01, 9.032765e-01, & ! + 9.046369e-01, & ! + 7.812615e-01, 7.887764e-01, 7.959664e-01, 8.028413e-01, 8.094109e-01, & ! 4 + 8.156849e-01, 8.216730e-01, 8.273846e-01, 8.328294e-01, 8.380166e-01, & ! + 8.429556e-01, 8.476556e-01, 8.521258e-01, 8.563753e-01, 8.604131e-01, & ! + 8.642481e-01, 8.678893e-01, 8.713455e-01, 8.746254e-01, 8.777378e-01, & ! + 8.806914e-01, 8.834948e-01, 8.861566e-01, 8.886854e-01, 8.910897e-01, & ! + 8.933779e-01, 8.955586e-01, 8.976402e-01, 8.996311e-01, 9.015398e-01, & ! + 9.033745e-01, 9.051436e-01, 9.068555e-01, 9.085185e-01, 9.101410e-01, & ! + 9.117311e-01, 9.132972e-01, 9.148476e-01, 9.163905e-01, 9.179340e-01, & ! + 9.194864e-01, 9.210559e-01, 9.226505e-01, 9.242784e-01, 9.259476e-01, & ! + 9.276661e-01, & ! + 7.640720e-01, 7.691119e-01, 7.739941e-01, 7.787222e-01, 7.832998e-01, & ! 5 + 7.877304e-01, 7.920177e-01, 7.961652e-01, 8.001765e-01, 8.040551e-01, & ! + 8.078044e-01, 8.114280e-01, 8.149294e-01, 8.183119e-01, 8.215791e-01, & ! + 8.247344e-01, 8.277812e-01, 8.307229e-01, 8.335629e-01, 8.363046e-01, & ! + 8.389514e-01, 8.415067e-01, 8.439738e-01, 8.463560e-01, 8.486568e-01, & ! + 8.508795e-01, 8.530274e-01, 8.551039e-01, 8.571122e-01, 8.590558e-01, & ! + 8.609378e-01, 8.627618e-01, 8.645309e-01, 8.662485e-01, 8.679178e-01, & ! + 8.695423e-01, 8.711251e-01, 8.726697e-01, 8.741792e-01, 8.756571e-01, & ! + 8.771065e-01, 8.785307e-01, 8.799331e-01, 8.813169e-01, 8.826854e-01, & ! + 8.840419e-01, & ! + 7.602598e-01, 7.651572e-01, 7.699014e-01, 7.744962e-01, 7.789452e-01, & ! 6 + 7.832522e-01, 7.874205e-01, 7.914538e-01, 7.953555e-01, 7.991290e-01, & ! + 8.027777e-01, 8.063049e-01, 8.097140e-01, 8.130081e-01, 8.161906e-01, & ! + 8.192645e-01, 8.222331e-01, 8.250993e-01, 8.278664e-01, 8.305374e-01, & ! + 8.331153e-01, 8.356030e-01, 8.380037e-01, 8.403201e-01, 8.425553e-01, & ! + 8.447121e-01, 8.467935e-01, 8.488022e-01, 8.507412e-01, 8.526132e-01, & ! + 8.544210e-01, 8.561675e-01, 8.578554e-01, 8.594875e-01, 8.610665e-01, & ! + 8.625951e-01, 8.640760e-01, 8.655119e-01, 8.669055e-01, 8.682594e-01, & ! + 8.695763e-01, 8.708587e-01, 8.721094e-01, 8.733308e-01, 8.745255e-01, & ! + 8.756961e-01, & ! + 7.568957e-01, 7.606995e-01, 7.644072e-01, 7.680204e-01, 7.715402e-01, & ! 7 + 7.749682e-01, 7.783057e-01, 7.815541e-01, 7.847148e-01, 7.877892e-01, & ! + 7.907786e-01, 7.936846e-01, 7.965084e-01, 7.992515e-01, 8.019153e-01, & ! + 8.045011e-01, 8.070103e-01, 8.094444e-01, 8.118048e-01, 8.140927e-01, & ! + 8.163097e-01, 8.184571e-01, 8.205364e-01, 8.225488e-01, 8.244958e-01, & ! + 8.263789e-01, 8.281993e-01, 8.299586e-01, 8.316580e-01, 8.332991e-01, & ! + 8.348831e-01, 8.364115e-01, 8.378857e-01, 8.393071e-01, 8.406770e-01, & ! + 8.419969e-01, 8.432682e-01, 8.444923e-01, 8.456706e-01, 8.468044e-01, & ! + 8.478952e-01, 8.489444e-01, 8.499533e-01, 8.509234e-01, 8.518561e-01, & ! + 8.527528e-01, & ! + 7.575066e-01, 7.606912e-01, 7.638236e-01, 7.669035e-01, 7.699306e-01, & ! 8 + 7.729046e-01, 7.758254e-01, 7.786926e-01, 7.815060e-01, 7.842654e-01, & ! + 7.869705e-01, 7.896211e-01, 7.922168e-01, 7.947574e-01, 7.972428e-01, & ! + 7.996726e-01, 8.020466e-01, 8.043646e-01, 8.066262e-01, 8.088313e-01, & ! + 8.109796e-01, 8.130709e-01, 8.151049e-01, 8.170814e-01, 8.190001e-01, & ! + 8.208608e-01, 8.226632e-01, 8.244071e-01, 8.260924e-01, 8.277186e-01, & ! + 8.292856e-01, 8.307932e-01, 8.322411e-01, 8.336291e-01, 8.349570e-01, & ! + 8.362244e-01, 8.374312e-01, 8.385772e-01, 8.396621e-01, 8.406856e-01, & ! + 8.416476e-01, 8.425479e-01, 8.433861e-01, 8.441620e-01, 8.448755e-01, & ! + 8.455263e-01, & ! + 7.568829e-01, 7.597947e-01, 7.626745e-01, 7.655212e-01, 7.683337e-01, & ! 9 + 7.711111e-01, 7.738523e-01, 7.765565e-01, 7.792225e-01, 7.818494e-01, & ! + 7.844362e-01, 7.869819e-01, 7.894854e-01, 7.919459e-01, 7.943623e-01, & ! + 7.967337e-01, 7.990590e-01, 8.013373e-01, 8.035676e-01, 8.057488e-01, & ! + 8.078802e-01, 8.099605e-01, 8.119890e-01, 8.139645e-01, 8.158862e-01, & ! + 8.177530e-01, 8.195641e-01, 8.213183e-01, 8.230149e-01, 8.246527e-01, & ! + 8.262308e-01, 8.277483e-01, 8.292042e-01, 8.305976e-01, 8.319275e-01, & ! + 8.331929e-01, 8.343929e-01, 8.355265e-01, 8.365928e-01, 8.375909e-01, & ! + 8.385197e-01, 8.393784e-01, 8.401659e-01, 8.408815e-01, 8.415240e-01, & ! + 8.420926e-01, & ! + 7.548616e-01, 7.575454e-01, 7.602153e-01, 7.628696e-01, 7.655067e-01, & ! 10 + 7.681249e-01, 7.707225e-01, 7.732978e-01, 7.758492e-01, 7.783750e-01, & ! + 7.808735e-01, 7.833430e-01, 7.857819e-01, 7.881886e-01, 7.905612e-01, & ! + 7.928983e-01, 7.951980e-01, 7.974588e-01, 7.996789e-01, 8.018567e-01, & ! + 8.039905e-01, 8.060787e-01, 8.081196e-01, 8.101115e-01, 8.120527e-01, & ! + 8.139416e-01, 8.157764e-01, 8.175557e-01, 8.192776e-01, 8.209405e-01, & ! + 8.225427e-01, 8.240826e-01, 8.255585e-01, 8.269688e-01, 8.283117e-01, & ! + 8.295856e-01, 8.307889e-01, 8.319198e-01, 8.329767e-01, 8.339579e-01, & ! + 8.348619e-01, 8.356868e-01, 8.364311e-01, 8.370930e-01, 8.376710e-01, & ! + 8.381633e-01, & ! + 7.491854e-01, 7.518523e-01, 7.545089e-01, 7.571534e-01, 7.597839e-01, & ! 11 + 7.623987e-01, 7.649959e-01, 7.675737e-01, 7.701303e-01, 7.726639e-01, & ! + 7.751727e-01, 7.776548e-01, 7.801084e-01, 7.825318e-01, 7.849230e-01, & ! + 7.872804e-01, 7.896020e-01, 7.918862e-01, 7.941309e-01, 7.963345e-01, & ! + 7.984951e-01, 8.006109e-01, 8.026802e-01, 8.047009e-01, 8.066715e-01, & ! + 8.085900e-01, 8.104546e-01, 8.122636e-01, 8.140150e-01, 8.157072e-01, & ! + 8.173382e-01, 8.189063e-01, 8.204096e-01, 8.218464e-01, 8.232148e-01, & ! + 8.245130e-01, 8.257391e-01, 8.268915e-01, 8.279682e-01, 8.289675e-01, & ! + 8.298875e-01, 8.307264e-01, 8.314824e-01, 8.321537e-01, 8.327385e-01, & ! + 8.332350e-01, & ! + 7.397086e-01, 7.424069e-01, 7.450955e-01, 7.477725e-01, 7.504362e-01, & ! 12 + 7.530846e-01, 7.557159e-01, 7.583283e-01, 7.609199e-01, 7.634888e-01, & ! + 7.660332e-01, 7.685512e-01, 7.710411e-01, 7.735009e-01, 7.759288e-01, & ! + 7.783229e-01, 7.806814e-01, 7.830024e-01, 7.852841e-01, 7.875246e-01, & ! + 7.897221e-01, 7.918748e-01, 7.939807e-01, 7.960380e-01, 7.980449e-01, & ! + 7.999995e-01, 8.019000e-01, 8.037445e-01, 8.055311e-01, 8.072581e-01, & ! + 8.089235e-01, 8.105255e-01, 8.120623e-01, 8.135319e-01, 8.149326e-01, & ! + 8.162626e-01, 8.175198e-01, 8.187025e-01, 8.198089e-01, 8.208371e-01, & ! + 8.217852e-01, 8.226514e-01, 8.234338e-01, 8.241306e-01, 8.247399e-01, & ! + 8.252599e-01, & ! + 7.224533e-01, 7.251681e-01, 7.278728e-01, 7.305654e-01, 7.332444e-01, & ! 13 + 7.359078e-01, 7.385539e-01, 7.411808e-01, 7.437869e-01, 7.463702e-01, & ! + 7.489291e-01, 7.514616e-01, 7.539661e-01, 7.564408e-01, 7.588837e-01, & ! + 7.612933e-01, 7.636676e-01, 7.660049e-01, 7.683034e-01, 7.705612e-01, & ! + 7.727767e-01, 7.749480e-01, 7.770733e-01, 7.791509e-01, 7.811789e-01, & ! + 7.831556e-01, 7.850791e-01, 7.869478e-01, 7.887597e-01, 7.905131e-01, & ! + 7.922062e-01, 7.938372e-01, 7.954044e-01, 7.969059e-01, 7.983399e-01, & ! + 7.997047e-01, 8.009985e-01, 8.022195e-01, 8.033658e-01, 8.044357e-01, & ! + 8.054275e-01, 8.063392e-01, 8.071692e-01, 8.079157e-01, 8.085768e-01, & ! + 8.091507e-01, & ! + 8.850026e-01, 9.005489e-01, 9.069242e-01, 9.121799e-01, 9.168987e-01, & ! 14 + 9.212259e-01, 9.252176e-01, 9.289028e-01, 9.323000e-01, 9.354235e-01, & ! + 9.382858e-01, 9.408985e-01, 9.432734e-01, 9.454218e-01, 9.473557e-01, & ! + 9.490871e-01, 9.506282e-01, 9.519917e-01, 9.531904e-01, 9.542374e-01, & ! + 9.551461e-01, 9.559298e-01, 9.566023e-01, 9.571775e-01, 9.576692e-01, & ! + 9.580916e-01, 9.584589e-01, 9.587853e-01, 9.590851e-01, 9.593729e-01, & ! + 9.596632e-01, 9.599705e-01, 9.603096e-01, 9.606954e-01, 9.611427e-01, & ! + 9.616667e-01, 9.622826e-01, 9.630060e-01, 9.638524e-01, 9.648379e-01, & ! + 9.659788e-01, 9.672916e-01, 9.687933e-01, 9.705014e-01, 9.724337e-01, & ! + 9.746084e-01/), & ! + shape = (/46,nBandsSW_RRTMG/)) + + real(kind_phys),dimension(46,nBandsSW_RRTMG),parameter :: & ! + fdlice3 = reshape(source= (/ & ! + 4.959277e-02, 4.685292e-02, 4.426104e-02, 4.181231e-02, 3.950191e-02, & ! + 3.732500e-02, 3.527675e-02, 3.335235e-02, 3.154697e-02, 2.985578e-02, & ! + 2.827395e-02, 2.679666e-02, 2.541909e-02, 2.413640e-02, 2.294378e-02, & ! + 2.183639e-02, 2.080940e-02, 1.985801e-02, 1.897736e-02, 1.816265e-02, & ! + 1.740905e-02, 1.671172e-02, 1.606585e-02, 1.546661e-02, 1.490917e-02, & ! + 1.438870e-02, 1.390038e-02, 1.343939e-02, 1.300089e-02, 1.258006e-02, & ! + 1.217208e-02, 1.177212e-02, 1.137536e-02, 1.097696e-02, 1.057210e-02, & ! + 1.015596e-02, 9.723704e-03, 9.270516e-03, 8.791565e-03, 8.282026e-03, & ! + 7.737072e-03, 7.151879e-03, 6.521619e-03, 5.841467e-03, 5.106597e-03, & ! + 4.312183e-03, & ! + 5.071224e-02, 5.000217e-02, 4.933872e-02, 4.871992e-02, 4.814380e-02, & ! + 4.760839e-02, 4.711170e-02, 4.665177e-02, 4.622662e-02, 4.583426e-02, & ! + 4.547274e-02, 4.514007e-02, 4.483428e-02, 4.455340e-02, 4.429544e-02, & ! + 4.405844e-02, 4.384041e-02, 4.363939e-02, 4.345340e-02, 4.328047e-02, & ! + 4.311861e-02, 4.296586e-02, 4.282024e-02, 4.267977e-02, 4.254248e-02, & ! + 4.240640e-02, 4.226955e-02, 4.212995e-02, 4.198564e-02, 4.183462e-02, & ! + 4.167494e-02, 4.150462e-02, 4.132167e-02, 4.112413e-02, 4.091003e-02, & ! + 4.067737e-02, 4.042420e-02, 4.014854e-02, 3.984840e-02, 3.952183e-02, & ! + 3.916683e-02, 3.878144e-02, 3.836368e-02, 3.791158e-02, 3.742316e-02, & ! + 3.689645e-02, & ! + 1.062938e-01, 1.065234e-01, 1.067822e-01, 1.070682e-01, 1.073793e-01, & ! + 1.077137e-01, 1.080693e-01, 1.084442e-01, 1.088364e-01, 1.092439e-01, & ! + 1.096647e-01, 1.100970e-01, 1.105387e-01, 1.109878e-01, 1.114423e-01, & ! + 1.119004e-01, 1.123599e-01, 1.128190e-01, 1.132757e-01, 1.137279e-01, & ! + 1.141738e-01, 1.146113e-01, 1.150385e-01, 1.154534e-01, 1.158540e-01, & ! + 1.162383e-01, 1.166045e-01, 1.169504e-01, 1.172741e-01, 1.175738e-01, & ! + 1.178472e-01, 1.180926e-01, 1.183080e-01, 1.184913e-01, 1.186405e-01, & ! + 1.187538e-01, 1.188291e-01, 1.188645e-01, 1.188580e-01, 1.188076e-01, & ! + 1.187113e-01, 1.185672e-01, 1.183733e-01, 1.181277e-01, 1.178282e-01, & ! + 1.174731e-01, & ! + 1.076195e-01, 1.065195e-01, 1.054696e-01, 1.044673e-01, 1.035099e-01, & ! + 1.025951e-01, 1.017203e-01, 1.008831e-01, 1.000808e-01, 9.931116e-02, & ! + 9.857151e-02, 9.785939e-02, 9.717230e-02, 9.650774e-02, 9.586322e-02, & ! + 9.523623e-02, 9.462427e-02, 9.402484e-02, 9.343544e-02, 9.285358e-02, & ! + 9.227675e-02, 9.170245e-02, 9.112818e-02, 9.055144e-02, 8.996974e-02, & ! + 8.938056e-02, 8.878142e-02, 8.816981e-02, 8.754323e-02, 8.689919e-02, & ! + 8.623517e-02, 8.554869e-02, 8.483724e-02, 8.409832e-02, 8.332943e-02, & ! + 8.252807e-02, 8.169175e-02, 8.081795e-02, 7.990419e-02, 7.894796e-02, & ! + 7.794676e-02, 7.689809e-02, 7.579945e-02, 7.464834e-02, 7.344227e-02, & ! + 7.217872e-02, & ! + 1.119014e-01, 1.122706e-01, 1.126690e-01, 1.130947e-01, 1.135456e-01, & ! + 1.140199e-01, 1.145154e-01, 1.150302e-01, 1.155623e-01, 1.161096e-01, & ! + 1.166703e-01, 1.172422e-01, 1.178233e-01, 1.184118e-01, 1.190055e-01, & ! + 1.196025e-01, 1.202008e-01, 1.207983e-01, 1.213931e-01, 1.219832e-01, & ! + 1.225665e-01, 1.231411e-01, 1.237050e-01, 1.242561e-01, 1.247926e-01, & ! + 1.253122e-01, 1.258132e-01, 1.262934e-01, 1.267509e-01, 1.271836e-01, & ! + 1.275896e-01, 1.279669e-01, 1.283134e-01, 1.286272e-01, 1.289063e-01, & ! + 1.291486e-01, 1.293522e-01, 1.295150e-01, 1.296351e-01, 1.297104e-01, & ! + 1.297390e-01, 1.297189e-01, 1.296480e-01, 1.295244e-01, 1.293460e-01, & ! + 1.291109e-01, & ! + 1.133298e-01, 1.136777e-01, 1.140556e-01, 1.144615e-01, 1.148934e-01, & ! + 1.153492e-01, 1.158269e-01, 1.163243e-01, 1.168396e-01, 1.173706e-01, & ! + 1.179152e-01, 1.184715e-01, 1.190374e-01, 1.196108e-01, 1.201897e-01, & ! + 1.207720e-01, 1.213558e-01, 1.219389e-01, 1.225194e-01, 1.230951e-01, & ! + 1.236640e-01, 1.242241e-01, 1.247733e-01, 1.253096e-01, 1.258309e-01, & ! + 1.263352e-01, 1.268205e-01, 1.272847e-01, 1.277257e-01, 1.281415e-01, & ! + 1.285300e-01, 1.288893e-01, 1.292173e-01, 1.295118e-01, 1.297710e-01, & ! + 1.299927e-01, 1.301748e-01, 1.303154e-01, 1.304124e-01, 1.304637e-01, & ! + 1.304673e-01, 1.304212e-01, 1.303233e-01, 1.301715e-01, 1.299638e-01, & ! + 1.296983e-01, & ! + 1.145360e-01, 1.153256e-01, 1.161453e-01, 1.169929e-01, 1.178666e-01, & ! + 1.187641e-01, 1.196835e-01, 1.206227e-01, 1.215796e-01, 1.225522e-01, & ! + 1.235383e-01, 1.245361e-01, 1.255433e-01, 1.265579e-01, 1.275779e-01, & ! + 1.286011e-01, 1.296257e-01, 1.306494e-01, 1.316703e-01, 1.326862e-01, & ! + 1.336951e-01, 1.346950e-01, 1.356838e-01, 1.366594e-01, 1.376198e-01, & ! + 1.385629e-01, 1.394866e-01, 1.403889e-01, 1.412678e-01, 1.421212e-01, & ! + 1.429469e-01, 1.437430e-01, 1.445074e-01, 1.452381e-01, 1.459329e-01, & ! + 1.465899e-01, 1.472069e-01, 1.477819e-01, 1.483128e-01, 1.487976e-01, & ! + 1.492343e-01, 1.496207e-01, 1.499548e-01, 1.502346e-01, 1.504579e-01, & ! + 1.506227e-01, & ! + 1.153263e-01, 1.161445e-01, 1.169932e-01, 1.178703e-01, 1.187738e-01, & ! + 1.197016e-01, 1.206516e-01, 1.216217e-01, 1.226099e-01, 1.236141e-01, & ! + 1.246322e-01, 1.256621e-01, 1.267017e-01, 1.277491e-01, 1.288020e-01, & ! + 1.298584e-01, 1.309163e-01, 1.319736e-01, 1.330281e-01, 1.340778e-01, & ! + 1.351207e-01, 1.361546e-01, 1.371775e-01, 1.381873e-01, 1.391820e-01, & ! + 1.401593e-01, 1.411174e-01, 1.420540e-01, 1.429671e-01, 1.438547e-01, & ! + 1.447146e-01, 1.455449e-01, 1.463433e-01, 1.471078e-01, 1.478364e-01, & ! + 1.485270e-01, 1.491774e-01, 1.497857e-01, 1.503497e-01, 1.508674e-01, & ! + 1.513367e-01, 1.517554e-01, 1.521216e-01, 1.524332e-01, 1.526880e-01, & ! + 1.528840e-01, & ! + 1.160842e-01, 1.169118e-01, 1.177697e-01, 1.186556e-01, 1.195676e-01, & ! + 1.205036e-01, 1.214616e-01, 1.224394e-01, 1.234349e-01, 1.244463e-01, & ! + 1.254712e-01, 1.265078e-01, 1.275539e-01, 1.286075e-01, 1.296664e-01, & ! + 1.307287e-01, 1.317923e-01, 1.328550e-01, 1.339149e-01, 1.349699e-01, & ! + 1.360179e-01, 1.370567e-01, 1.380845e-01, 1.390991e-01, 1.400984e-01, & ! + 1.410803e-01, 1.420429e-01, 1.429840e-01, 1.439016e-01, 1.447936e-01, & ! + 1.456579e-01, 1.464925e-01, 1.472953e-01, 1.480642e-01, 1.487972e-01, & ! + 1.494923e-01, 1.501472e-01, 1.507601e-01, 1.513287e-01, 1.518511e-01, & ! + 1.523252e-01, 1.527489e-01, 1.531201e-01, 1.534368e-01, 1.536969e-01, & ! + 1.538984e-01, & ! + 1.168725e-01, 1.177088e-01, 1.185747e-01, 1.194680e-01, 1.203867e-01, & ! + 1.213288e-01, 1.222923e-01, 1.232750e-01, 1.242750e-01, 1.252903e-01, & ! + 1.263187e-01, 1.273583e-01, 1.284069e-01, 1.294626e-01, 1.305233e-01, & ! + 1.315870e-01, 1.326517e-01, 1.337152e-01, 1.347756e-01, 1.358308e-01, & ! + 1.368788e-01, 1.379175e-01, 1.389449e-01, 1.399590e-01, 1.409577e-01, & ! + 1.419389e-01, 1.429007e-01, 1.438410e-01, 1.447577e-01, 1.456488e-01, & ! + 1.465123e-01, 1.473461e-01, 1.481483e-01, 1.489166e-01, 1.496492e-01, & ! + 1.503439e-01, 1.509988e-01, 1.516118e-01, 1.521808e-01, 1.527038e-01, & ! + 1.531788e-01, 1.536037e-01, 1.539764e-01, 1.542951e-01, 1.545575e-01, & ! + 1.547617e-01, & ! + 1.180509e-01, 1.189025e-01, 1.197820e-01, 1.206875e-01, 1.216171e-01, & ! + 1.225687e-01, 1.235404e-01, 1.245303e-01, 1.255363e-01, 1.265564e-01, & ! + 1.275888e-01, 1.286313e-01, 1.296821e-01, 1.307392e-01, 1.318006e-01, & ! + 1.328643e-01, 1.339284e-01, 1.349908e-01, 1.360497e-01, 1.371029e-01, & ! + 1.381486e-01, 1.391848e-01, 1.402095e-01, 1.412208e-01, 1.422165e-01, & ! + 1.431949e-01, 1.441539e-01, 1.450915e-01, 1.460058e-01, 1.468947e-01, & ! + 1.477564e-01, 1.485888e-01, 1.493900e-01, 1.501580e-01, 1.508907e-01, & ! + 1.515864e-01, 1.522428e-01, 1.528582e-01, 1.534305e-01, 1.539578e-01, & ! + 1.544380e-01, 1.548692e-01, 1.552494e-01, 1.555767e-01, 1.558490e-01, & ! + 1.560645e-01, & ! + 1.200480e-01, 1.209267e-01, 1.218304e-01, 1.227575e-01, 1.237059e-01, & ! + 1.246739e-01, 1.256595e-01, 1.266610e-01, 1.276765e-01, 1.287041e-01, & ! + 1.297420e-01, 1.307883e-01, 1.318412e-01, 1.328988e-01, 1.339593e-01, & ! + 1.350207e-01, 1.360813e-01, 1.371393e-01, 1.381926e-01, 1.392396e-01, & ! + 1.402783e-01, 1.413069e-01, 1.423235e-01, 1.433263e-01, 1.443134e-01, & ! + 1.452830e-01, 1.462332e-01, 1.471622e-01, 1.480681e-01, 1.489490e-01, & ! + 1.498032e-01, 1.506286e-01, 1.514236e-01, 1.521863e-01, 1.529147e-01, & ! + 1.536070e-01, 1.542614e-01, 1.548761e-01, 1.554491e-01, 1.559787e-01, & ! + 1.564629e-01, 1.568999e-01, 1.572879e-01, 1.576249e-01, 1.579093e-01, & ! + 1.581390e-01, & ! + 1.247813e-01, 1.256496e-01, 1.265417e-01, 1.274560e-01, 1.283905e-01, & ! + 1.293436e-01, 1.303135e-01, 1.312983e-01, 1.322964e-01, 1.333060e-01, & ! + 1.343252e-01, 1.353523e-01, 1.363855e-01, 1.374231e-01, 1.384632e-01, & ! + 1.395042e-01, 1.405441e-01, 1.415813e-01, 1.426140e-01, 1.436404e-01, & ! + 1.446587e-01, 1.456672e-01, 1.466640e-01, 1.476475e-01, 1.486157e-01, & ! + 1.495671e-01, 1.504997e-01, 1.514117e-01, 1.523016e-01, 1.531673e-01, & ! + 1.540073e-01, 1.548197e-01, 1.556026e-01, 1.563545e-01, 1.570734e-01, & ! + 1.577576e-01, 1.584054e-01, 1.590149e-01, 1.595843e-01, 1.601120e-01, & ! + 1.605962e-01, 1.610349e-01, 1.614266e-01, 1.617693e-01, 1.620614e-01, & ! + 1.623011e-01, & ! + 1.006055e-01, 9.549582e-02, 9.063960e-02, 8.602900e-02, 8.165612e-02, & ! + 7.751308e-02, 7.359199e-02, 6.988496e-02, 6.638412e-02, 6.308156e-02, & ! + 5.996942e-02, 5.703979e-02, 5.428481e-02, 5.169657e-02, 4.926719e-02, & ! + 4.698880e-02, 4.485349e-02, 4.285339e-02, 4.098061e-02, 3.922727e-02, & ! + 3.758547e-02, 3.604733e-02, 3.460497e-02, 3.325051e-02, 3.197604e-02, & ! + 3.077369e-02, 2.963558e-02, 2.855381e-02, 2.752050e-02, 2.652776e-02, & ! + 2.556772e-02, 2.463247e-02, 2.371415e-02, 2.280485e-02, 2.189670e-02, & ! + 2.098180e-02, 2.005228e-02, 1.910024e-02, 1.811781e-02, 1.709709e-02, & ! + 1.603020e-02, 1.490925e-02, 1.372635e-02, 1.247363e-02, 1.114319e-02, & ! + 9.727157e-03/), & ! + shape = (/46,nBandsSW_RRTMG/)) + + + + real(kind_phys),dimension(5) :: & + abari = (/ 3.448e-03,3.448e-03,3.448e-03,3.448e-03,3.448e-03 /), & + bbari = (/ 2.431e+00,2.431e+00,2.431e+00,2.431e+00,2.431e+00 /), & + cbari = (/ 1.000e-05,1.100e-04,1.240e-02,3.779e-02,4.666e-01 /), & + dbari = (/ 0.000e+00,1.405e-05,6.867e-04,1.284e-03,2.050e-05 /), & + ebari = (/ 7.661e-01,7.730e-01,7.865e-01,8.172e-01,9.595e-01 /), & + fbari = (/ 5.851e-04,5.665e-04,7.204e-04,7.463e-04,1.076e-04 /) + + ! ipat is bands index for ebert & curry ice cloud (for iflagice=1) + integer,dimension(nBandsSW_RRTMG),parameter :: & + ipat = (/ 5, 5, 4, 4, 3, 3, 2, 2, 1, 1, 1, 1, 1, 5 /) + +contains + ! ######################################################################################### + ! rrtmg_sw_cloud_optics + ! ######################################################################################### + subroutine rrtmg_sw_cloud_optics(ncol, nlay, nBandsSW, cld_lwp, cld_ref_liq, cld_iwp, & + cld_ref_ice, cld_rwp, cld_ref_rain, cld_swp, cld_ref_snow, cld_frac, & + tau_cld, ssa_cld, asy_cld) + ! Inputs + integer,intent(in) :: & + nBandsSW, & ! Number of spectral bands + ncol, & ! Number of horizontal gridpoints + nlay ! Number of vertical layers + real(kind_phys), dimension(ncol,nlay), intent(in) :: & + cld_frac, & ! Cloud-fraction (1) + cld_lwp, & ! Cloud liquid water path (g/m2) + cld_ref_liq, & ! Effective radius (liquid) (micron) + cld_iwp, & ! Cloud ice water path (g/m2) + cld_ref_ice, & ! Effective radius (ice) (micron) + cld_rwp, & ! Cloud rain water path (g/m2) + cld_ref_rain, & ! Effective radius (rain-drop) (micron) + cld_swp, & ! Cloud snow-water path (g/m2) + cld_ref_snow ! Effective radius (snow-flake) (micron) + + ! Outputs + real(kind_phys),dimension(ncol,nlay,nBandsSW),intent(out) :: & + tau_cld, & ! In-cloud optical depth (1) + ssa_cld, & ! In-cloud single-scattering albedo (1) + asy_cld ! In-cloud asymmetry parameter (1) + + ! Local variables + integer :: iCol, iLay, iBand, index, ia + real(kind_phys) :: tau_rain, tau_snow, factor, fint, cld_ref_iceTemp,asyw,ssaw,za1,za2 + + real(kind_phys), dimension(nBandsSW) :: ssa_rain, ssa_snow, asy_rain, asy_snow, & + tau_liq, ssa_liq, asy_liq, tau_ice, ssa_ice, asy_ice, asycoliq, & + forwice, extcoice, asycoice, ssacoice, fdelta, extcoliq, ssacoliq + + ! Initialize + tau_cld(:,:,:) = 0._kind_phys + ssa_cld(:,:,:) = 1._kind_phys + asy_cld(:,:,:) = 0._kind_phys + + ! Compute cloud radiative properties for cloud. + if (iswcliq > 0) then + do iCol=1,ncol + do iLay=1,nlay + ! Initialize + tau_liq(:) = 0._kind_phys + tau_ice(:) = 0._kind_phys + tau_rain = 0._kind_phys + tau_snow = 0._kind_phys + ssa_liq(:) = 0._kind_phys + ssa_ice(:) = 0._kind_phys + ssa_rain(:) = 0._kind_phys + ssa_snow(:) = 0._kind_phys + asy_liq(:) = 0._kind_phys + asy_ice(:) = 0._kind_phys + asy_rain(:) = 0._kind_phys + asy_snow(:) = 0._kind_phys + if (cld_frac(iCol,iLay) .gt. 1.e-12_kind_phys) then + ! ########################################################################### + ! Rain clouds + ! ########################################################################### + ! Rain optical depth (No band dependence) + tau_rain = cld_rwp(iCol,iLay)*a0r + + ! Rain single-scattering albedo and asymmetry (Band dependent) + do iBand=1,nBandsSW + ssa_rain(iBand) = tau_rain*(1.-b0r(iBand)) + asy_rain(iBand) = ssa_rain(iBand)*c0r(iBand) + enddo + + ! ########################################################################### + ! Snow clouds + ! ########################################################################### + ! Snow optical depth (No band dependence) + if (cld_swp(iCol,iLay) .gt. 0. .and. cld_ref_snow(iCol,iLay) .gt. 10._kind_phys) then + tau_snow = cld_swp(iCol,iLay) + else + tau_snow = 0._kind_phys + endif + + ! Snow single-scattering albedo and asymmetry (Band dependent) + do iBand=1,nBandsSW + ssa_snow(iBand) = tau_snow*(1.-(b0s(iBand)+b1s(iBand)*1.0315*cld_ref_snow(iCol,iLay))) + asy_snow(iBand) = ssa_snow(iBand)*c0s(iBand) + enddo + + ! ########################################################################### + ! Liquid clouds + ! ########################################################################### + if (cld_lwp(iCol,iLay) .gt. 0) then + ! Find index in coefficient LUT for corresponding partice size. + factor = cld_ref_liq(iCol,iLay) - 1.5 + index = max( 1, min( 57, int( factor ) )) + fint = factor - float(index) + + ! Extract coefficents for all bands and compute radiative properties + do iBand=1,nBandsSW + ! Interpolate coefficients + if ( iswcliq == 1 ) then + extcoliq(iBand) = max(0._kind_phys, extliq1(index,iBand) + & + fint*(extliq1(index+1,iBand)-extliq1(index,iBand))) + ssacoliq(iBand) = max(0._kind_phys, min(1._kind_phys, ssaliq1(index,iBand) + & + fint*(ssaliq1(index+1,iBand)-ssaliq1(index,iBand)))) + asycoliq(iBand) = max(0._kind_phys, min(1._kind_phys, asyliq1(index,iBand) + & + fint*(asyliq1(index+1,iBand)-asyliq1(index,iBand)))) + elseif ( iswcliq == 2 ) then ! use updated coeffs + extcoliq(iBand) = max(0._kind_phys, extliq2(index,iBand) + & + fint*(extliq2(index+1,iBand)-extliq2(index,iBand))) + ssacoliq(iBand) = max(0._kind_phys, min(1._kind_phys, ssaliq2(index,iBand) + & + fint*(ssaliq2(index+1,iBand)-ssaliq2(index,iBand)))) + asycoliq(iBand) = max(0._kind_phys, min(1._kind_phys, asyliq2(index,iBand) + & + fint*(asyliq2(index+1,iBand)-asyliq2(index,iBand)))) + endif + if (fint .lt. 0._kind_phys .and. ssacoliq(iBand) .gt. 1._kind_phys) then + ssacoliq(iBand) = ssaliq1(index,iBand) + endif + tau_liq(iBand) = cld_lwp(iCol,iLay) * extcoliq(iBand) + ssa_liq(iBand) = tau_liq(iBand) * ssacoliq(iBand) + asy_liq(iBand) = ssa_liq(iBand) * asycoliq(iBand) + enddo + endif ! IF cloudy with liquid condensate + + ! ########################################################################### + ! Ice clouds + ! ########################################################################### + if (cld_iwp(iCol,iLay) .gt. 0) then + ! Ebert and curry approach for all particle sizes though somewhat + ! unjustified for large ice particles. + if ( iswcice == 1 ) then + cld_ref_iceTemp = min(130._kind_phys, max(13._kind_phys,cld_ref_ice(iCol,iLay))) + do iBand=1,nBandsSW + ia = ipat(iBand) ! eb_&_c band index for ice cloud coeff + extcoice(iBand) = abari(ia) + bbari(ia) / cld_ref_iceTemp + ssacoice(iBand) = 1._kind_phys - cbari(ia) - dbari(ia)*cld_ref_iceTemp + asycoice(iBand) = ebari(ia)+fbari(ia)*cld_ref_iceTemp + tau_ice(iBand) = cld_iwp(iCol,iLay) * extcoice(iBand) + ssa_ice(iBand) = tau_ice(iBand) * ssacoice(iBand) + asy_ice(iBand) = ssa_ice(iBand) * asycoice(iBand) + enddo + + ! Streamer approach for ice effective radius between 5.0 and 131.0 microns. + elseif ( iswcice == 2 ) then + cld_ref_iceTemp = min(131._kind_phys, max(5.0_kind_phys,cld_ref_ice(iCol,iLay))) + factor = (cld_ref_iceTemp - 2.) / 3. + index = max( 1, min( 42, int( factor ) )) + fint = factor - float(index) + do iBand = 1,nBandsSW + extcoice(iBand) = extice2(index,iBand) + & + fint*(extice2(index+1,iBand)-extice2(index,iBand)) + ssacoice(iBand) = ssaice2(index,iBand) + & + fint*(ssaice2(index+1,iBand)-ssaice2(index,iBand)) + asycoice(iBand) = asyice2(index,iBand) + & + fint*(asyice2(index+1,iBand)-asyice2(index,iBand)) + tau_ice(iBand) = cld_iwp(iCol,iLay) * extcoice(iBand) + ssa_ice(iBand) = tau_ice(iBand) * ssacoice(iBand) + asy_ice(iBand) = ssa_ice(iBand) * asycoice(iBand) + enddo + + ! Fu's approach for ice effective radius between 4.8 and 135 microns + ! (generalized effective size from 5 to 140 microns). + ! https://doi.org/10.1175/1520-0442(1996)009<2058:AAPOTS>2.0.CO;2 + elseif ( iswcice == 3 ) then + cld_ref_iceTemp = max( 5.0, min( 140.0, 1.0315*cld_ref_ice(iCol,iLay) )) + ! Determine indices for table interpolation. + factor = (cld_ref_iceTemp - 2._kind_phys) / 3._kind_phys + index = max( 1, min( 45, int( factor ) )) + fint = factor - float(index) + do iBand = 1,nBandsSW + ! Interpolate coefficient tables to appropriate ice-particle size. + extcoice(iBand) = max(0._kind_phys, extice3(index,iBand) + & + fint*(extice3(index+1,iBand)-extice3(index,iBand))) ! eq (3.9a) + ssacoice(iBand) = max(0._kind_phys, min(1._kind_phys, ssaice3(index,iBand) + & + fint*(ssaice3(index+1,iBand)-ssaice3(index,iBand)))) ! eq (3.9b) + asycoice(iBand) = max(0._kind_phys, min(1._kind_phys, asyice3(index,iBand) + & + fint*(asyice3(index+1,iBand)-asyice3(index,iBand)))) ! eq (3.9c) + fdelta(iBand) = fdlice3(index,iBand) + & + fint*(fdlice3(index+1,iBand)-fdlice3(index,iBand)) ! eq (3.9d) + forwice(iBand) = fdelta(iBand) + 0.5_kind_phys / ssacoice(iBand) + if (forwice(iBand) .gt. asycoice(iBand)) forwice(iBand) = asycoice(iBand) + tau_ice(iBand) = cld_iwp(iCol,iLay) * extcoice(iBand) + ssa_ice(iBand) = tau_ice(iBand) * ssacoice(iBand) + asy_ice(iBand) = ssa_ice(iBand) * asycoice(iBand) + enddo + endif + endif ! IF cloudy column with ice condensate + endif ! IF cloudy column + + ! ########################################################################### + ! Compute total cloud radiative properties (tau, omega, and g) + ! ########################################################################### + if (cld_frac(iCol,iLay) .gt. 1.e-12_kind_phys) then + do iBand = 1,nBandsSW + ! Sum up radiative properties by type. + tau_cld(iCol,iLay,iBand) = max(1.e-12_kind_phys, tau_liq(iBand) + tau_ice(iBand) + tau_rain + tau_snow) + ssa_cld(iCol,iLay,iBand) = max(1.e-12_kind_phys, ssa_liq(iBand) + ssa_ice(iBand) + ssa_rain(iBand) + ssa_snow(iBand)) + asy_cld(iCol,iLay,iBand) = max(1.e-12_kind_phys, asy_liq(iBand) + asy_ice(iBand) + asy_rain(iBand) + asy_snow(iBand)) + ! Delta-scale + asyw = asy_cld(iCol,iLay,iBand)/max(1.e-12_kind_phys, ssa_cld(iCol,iLay,iBand)) + ssaw = min(1._kind_phys-0.000001, ssa_cld(iCol,iLay,iBand)/tau_cld(iCol,iLay,iBand)) + za1 = asyw * asyw + za2 = ssaw * za1 + tau_cld(iCol,iLay,iBand) = (1._kind_phys - za2) * tau_cld(iCol,iLay,iBand) + ssa_cld(iCol,iLay,iBand) = (ssaw - za2) / (1._kind_phys - za2) + asy_cld(iCol,iLay,iBand) = asyw/(1+asyw) + enddo ! Loop over SW bands + endif ! END sum cloudy properties + ! + enddo ! Loop over layers + enddo ! Loop over columns + endif + end subroutine rrtmg_sw_cloud_optics + + ! ####################################################################################### + ! SUBROUTINE mcica_subcol_sw + ! ###################################################################################### + subroutine mcica_subcol_sw(ncol, nlay, ngpts, cld_frac, icseed, dzlyr, de_lgth, & + cld_frac_mcica) + ! Inputs + integer,intent(in) :: & + ncol, & ! Number of horizontal gridpoints + nlay, & ! Number of vertical layers + ngpts ! Number of spectral g-points + integer,dimension(ncol),intent(in) :: & + icseed ! Permutation seed for each column. + real(kind_phys), dimension(ncol), intent(in) :: & + de_lgth ! Cloud decorrelation length (km) + real(kind_phys), dimension(ncol,nlay), intent(in) :: & + cld_frac, & ! Cloud-fraction + dzlyr ! Layer thinkness (km) + ! Outputs + logical,dimension(ncol,nlay,ngpts),intent(out) :: & + cld_frac_mcica + ! Local variables + type(random_stat) :: stat + integer :: icol,n,k,k1 + real(kind_phys) :: tem1 + real(kind_phys),dimension(ngpts) :: rand1D + real(kind_phys),dimension(nlay*ngpts) :: rand2D + real(kind_phys),dimension(ngpts,nlay) :: cdfunc,cdfun2 + real(kind_phys),dimension(nlay) :: fac_lcf + logical,dimension(ngpts,nlay) :: lcloudy + + ! Loop over all columns + do icol=1,ncol + ! Call random_setseed() to advance random number generator by "icseed" values. + call random_setseed(icseed(icol),stat) + + ! ################################################################################### + ! Sub-column set up according to overlapping assumption: + ! - For random overlap, pick a random value at every level + ! - For max-random overlap, pick a random value at every level + ! - For maximum overlap, pick same random numebr at every level + ! ################################################################################### + select case ( iovrsw ) + ! ################################################################################### + ! 0) Random overlap + ! ################################################################################### + case( 0 ) + call random_number(rand2D,stat) + k1 = 0 + do n = 1, ngpts + do k = 1, nlay + k1 = k1 + 1 + cdfunc(n,k) = rand2d(k1) + enddo + enddo + + ! ################################################################################### + ! 1) Maximum-random overlap + ! ################################################################################### + case(1) + call random_number(rand2D,stat) + k1 = 0 + do n = 1, ngpts + do k = 1, nlay + k1 = k1 + 1 + cdfunc(n,k) = rand2d(k1) + enddo + enddo + + ! First pick a random number for bottom (or top) layer. + ! then walk up the column: (aer's code) + ! if layer below is cloudy, use the same rand num in the layer below + ! if layer below is clear, use a new random number + do k = 2, nlay + k1 = k - 1 + tem1 = 1._kind_phys - cld_frac(icol,k1) + do n = 1, ngpts + if ( cdfunc(n,k1) > tem1 ) then + cdfunc(n,k) = cdfunc(n,k1) + else + cdfunc(n,k) = cdfunc(n,k) * tem1 + endif + enddo + enddo + + ! ################################################################################### + ! 2) Maximum overlap + ! ################################################################################### + case(2) + call random_number(rand1d,stat) + do n = 1, ngpts + tem1 = rand1d(n) + do k = 1, nlay + cdfunc(n,k) = tem1 + enddo + enddo + + ! ################################################################################### + ! 3) Decorrelation length + ! ################################################################################### + case(3) + ! Compute overlapping factors based on layer midpoint distances and decorrelation + ! depths + do k = nlay, 2, -1 + fac_lcf(k) = exp( -0.5 * (dzlyr(iCol,k)+dzlyr(iCol,k-1)) / de_lgth(iCol) ) + enddo + + ! Setup 2 sets of random numbers + call random_number ( rand2d, stat ) + k1 = 0 + do k = 1, nlay + do n = 1, ngpts + k1 = k1 + 1 + cdfunc(n,k) = rand2d(k1) + enddo + enddo + ! + call random_number ( rand2d, stat ) + k1 = 0 + do k = 1, nlay + do n = 1, ngpts + k1 = k1 + 1 + cdfun2(n,k) = rand2d(k1) + enddo + enddo + + ! Then working from the top down: + ! if a random number (from an independent set -cdfun2) is smaller then the + ! scale factor: use the upper layer's number, otherwise use a new random + ! number (keep the original assigned one). + do k = nlay-1, 1, -1 + k1 = k + 1 + do n = 1, ngpts + if ( cdfun2(n,k) <= fac_lcf(k1) ) then + cdfunc(n,k) = cdfunc(n,k1) + endif + enddo + enddo + + end select + + ! ################################################################################### + ! Generate subcolumn cloud mask (0/1 for clear/cloudy) + ! ################################################################################### + do k = 1, nlay + tem1 = 1._kind_phys - cld_frac(icol,k) + do n = 1, ngpts + lcloudy(n,k) = cdfunc(n,k) >= tem1 + if (lcloudy(n,k)) then + cld_frac_mcica(icol,k,n) = .true. + else + cld_frac_mcica(icol,k,n) = .false. + endif + enddo + enddo + enddo ! END LOOP OVER COLUMNS + end subroutine mcica_subcol_sw +end module mo_rrtmg_sw_cloud_optics diff --git a/physics/rrtmg_sw_post.meta b/physics/rrtmg_sw_post.meta index 28b54b5bf..6ed13e830 100644 --- a/physics/rrtmg_sw_post.meta +++ b/physics/rrtmg_sw_post.meta @@ -87,7 +87,7 @@ intent = in optional = F [htswc] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step_and_radiation_levels long_name = total sky heating rate due to shortwave radiation units = K s-1 dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) @@ -96,7 +96,7 @@ intent = in optional = F [htsw0] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels long_name = clear sky heating rates due to shortwave radiation units = K s-1 dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) diff --git a/physics/rrtmgp_aux.F90 b/physics/rrtmgp_aux.F90 new file mode 100644 index 000000000..d39705e7a --- /dev/null +++ b/physics/rrtmgp_aux.F90 @@ -0,0 +1,23 @@ +module rrtmgp_aux + use machine, only: & + kind_phys ! Working type + implicit none + + real(kind_phys) :: & + rrtmgp_minP, & ! Minimum pressure allowed in RRTMGP + rrtmgp_minT ! Minimum temperature allowed in RRTMGP +contains + ! ######################################################################################### + ! SUBROUTINE check_error_msg + ! ######################################################################################### + subroutine check_error_msg(routine_name, error_msg) + character(len=*), intent(in) :: & + error_msg, routine_name + + if(error_msg /= "") then + print*,"ERROR("//trim(routine_name)//"): " + print*,trim(error_msg) + return + end if + end subroutine check_error_msg +end module rrtmgp_aux diff --git a/physics/rrtmgp_lw_aerosol_optics.F90 b/physics/rrtmgp_lw_aerosol_optics.F90 new file mode 100644 index 000000000..2047deaf4 --- /dev/null +++ b/physics/rrtmgp_lw_aerosol_optics.F90 @@ -0,0 +1,103 @@ +module rrtmgp_lw_aerosol_optics + use machine, only: kind_phys + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_optical_props, only: ty_optical_props_1scl + use rrtmgp_aux, only: check_error_msg + use module_radiation_aerosols, only: & + NF_AESW, & ! Number of optical-fields in SW output (3=tau+g+omega) + NF_AELW, & ! Number of optical-fields in LW output (3=tau+g+omega) + setaer, & ! Routine to compute aerosol radiative properties (tau,g,omega) + NSPC1 ! Number of species for vertically integrated aerosol optical-depth + use netcdf + + implicit none + + public rrtmgp_lw_aerosol_optics_init, rrtmgp_lw_aerosol_optics_run, rrtmgp_lw_aerosol_optics_finalize + +contains + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_aerosol_optics_init() + ! ######################################################################################### + subroutine rrtmgp_lw_aerosol_optics_init() + end subroutine rrtmgp_lw_aerosol_optics_init + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_aerosol_optics_run() + ! ######################################################################################### +!! \section arg_table_rrtmgp_lw_aerosol_optics_run +!! \htmlinclude rrtmgp_lw_aerosol_optics.html +!! + subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nTracer, nTracerAer,& + p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, & + lw_gas_props, sw_gas_props, aerodp, lw_optical_props_aerosol, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + doLWrad ! Logical flag for longwave radiation call + integer, intent(in) :: & + nCol, & ! Number of horizontal grid points + nLev, & ! Number of vertical layers + nTracer, & ! Number of tracers + nTracerAer ! Number of aerosol tracers + real(kind_phys), dimension(nCol), intent(in) :: & + lon, & ! Longitude + lat, & ! Latitude + lsmask ! Land/sea/sea-ice mask + real(kind_phys), dimension(nCol,Nlev),intent(in) :: & + p_lay, & ! Pressure @ layer-centers (Pa) + tv_lay, & ! Virtual-temperature @ layer-centers (K) + relhum, & ! Relative-humidity @ layer-centers + p_lk ! Exner function @ layer-centers (1) + real(kind_phys), dimension(nCol, nLev, nTracer),intent(in) :: & + tracer ! trace gas concentrations + real(kind_phys), dimension(nCol, nLev, nTracerAer),intent(in) :: & + aerfld ! aerosol input concentrations + real(kind_phys), dimension(nCol,nLev+1),intent(in) :: & + p_lev ! Pressure @ layer-interfaces (Pa) + type(ty_gas_optics_rrtmgp),intent(in) :: & + sw_gas_props ! RRTMGP DDT: spectral information for SW calculation + type(ty_gas_optics_rrtmgp),intent(in) :: & + lw_gas_props ! RRTMGP DDT: spectral information for LW calculation + + ! Outputs + real(kind_phys), dimension(nCol,NSPC1), intent(inout) :: & + aerodp ! Vertical integrated optical depth for various aerosol species + type(ty_optical_props_1scl),intent(out) :: & + lw_optical_props_aerosol ! RRTMGP DDT: Longwave aerosol optical properties (tau) + integer, intent(out) :: & + errflg ! CCPP error flag + character(len=*), intent(out) :: & + errmsg ! CCPP error message + + ! Local variables + real(kind_phys), dimension(nCol, nLev, lw_gas_props%get_nband(), NF_AELW) :: & + aerosolslw ! + real(kind_phys), dimension(nCol, nLev, sw_gas_props%get_nband(), NF_AESW) :: & + aerosolssw + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doLWrad) return + + ! Call module_radiation_aerosols::setaer(),to setup aerosols property profile + call setaer(p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, ncol, nLev, & + nLev+1, .true., .true., aerosolssw, aerosolslw, aerodp) + + ! Allocate RRTMGP DDT: Aerosol optics [nCol,nlev,nBands] + call check_error_msg('rrtmgp_lw_aerosol_optics_run',lw_optical_props_aerosol%alloc_1scl( & + ncol, nlev, lw_gas_props%get_band_lims_wavenumber())) + + ! Copy aerosol optical information to RRTMGP DDT + lw_optical_props_aerosol%tau = aerosolslw(:,:,:,1) * (1. - aerosolslw(:,:,:,2)) + + end subroutine rrtmgp_lw_aerosol_optics_run + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_aerosol_optics_finalize() + ! ######################################################################################### + subroutine rrtmgp_lw_aerosol_optics_finalize() + end subroutine rrtmgp_lw_aerosol_optics_finalize +end module rrtmgp_lw_aerosol_optics diff --git a/physics/rrtmgp_lw_aerosol_optics.meta b/physics/rrtmgp_lw_aerosol_optics.meta new file mode 100644 index 000000000..305151270 --- /dev/null +++ b/physics/rrtmgp_lw_aerosol_optics.meta @@ -0,0 +1,183 @@ +[ccpp-arg-table] + name = rrtmgp_lw_aerosol_optics_run + type = scheme +[doLWrad] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[nTracer] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[nTracerAer] + standard_name = number_of_aerosol_tracers_MG + long_name = number of aerosol tracers for Morrison Gettelman MP + units = count + dimensions = () + type = integer + intent = in + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure at vertical interface for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure at vertical layer for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p_lk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = dimensionless Exner function at model layer centers + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tv_lay] + standard_name = virtual_temperature + long_name = layer virtual temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[relhum] + standard_name = relative_humidity + long_name = layer relative humidity + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lsmask] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tracer] + standard_name = chemical_tracers + long_name = chemical tracers + units = g g-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[aerfld] + standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology + long_name = GOCART aerosol climatology number concentration + units = kg-1? + dimensions = (horizontal_dimension,vertical_dimension,number_of_aerosol_tracers_MG) + type = real + kind = kind_phys + intent = in + optional = F +[lon] + standard_name = longitude + long_name = longitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lat] + standard_name = latitude + long_name = latitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lw_gas_props] + standard_name = coefficients_for_lw_gas_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + intent = in + type = ty_gas_optics_rrtmgp + optional = F +[sw_gas_props] + standard_name = coefficients_for_sw_gas_optics + long_name = DDT containing spectral information for RRTMGP SW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[aerodp] + standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles + long_name = vertical integrated optical depth for various aerosol species + units = none + dimensions = (horizontal_dimension,number_of_species_for_aerosol_optical_depth) + type = real + kind = kind_phys + intent = inout + optional = F +[lw_optical_props_aerosol] + standard_name = longwave_optical_properties_for_aerosols + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_1scl + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F \ No newline at end of file diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 new file mode 100644 index 000000000..1738f895d --- /dev/null +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -0,0 +1,372 @@ +module rrtmgp_lw_cloud_optics + use machine, only: kind_phys + use mo_rte_kind, only: wl + use mo_cloud_optics, only: ty_cloud_optics + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_optical_props, only: ty_optical_props_1scl + use mo_rrtmg_lw_cloud_optics, only: rrtmg_lw_cloud_optics + use rrtmgp_aux, only: check_error_msg + use netcdf + + implicit none + + public rrtmgp_lw_cloud_optics_init, rrtmgp_lw_cloud_optics_run, rrtmgp_lw_cloud_optics_finalize + +contains + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_cloud_optics_init() + ! ######################################################################################### +!! \section arg_table_rrtmgp_lw_cloud_optics_init +!! \htmlinclude rrtmgp_lw_cloud_optics.html +!! + subroutine rrtmgp_lw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_dir, & + rrtmgp_lw_file_clouds, mpicomm, mpirank, mpiroot, lw_cloud_props, errmsg, errflg) + + ! Inputs + integer, intent(inout) :: & + nrghice ! Number of ice-roughness categories + integer, intent(in) :: & + cld_optics_scheme, & ! Cloud-optics scheme + mpicomm, & ! MPI communicator + mpirank, & ! Current MPI rank + mpiroot ! Master MPI rank + character(len=128),intent(in) :: & + rrtmgp_root_dir, & ! RTE-RRTMGP root directory + rrtmgp_lw_file_clouds ! RRTMGP file containing coefficients used to compute clouds optical properties + + ! Outputs + type(ty_cloud_optics),intent(out) :: & + lw_cloud_props ! RRTMGP DDT: spectral information for RRTMGP LW radiation scheme + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error code + + ! Variables that will be passed to cloud_optics%load() + ! cld_optics_scheme = 1 + real(kind_phys) :: & + radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation + radliq_upr, & ! Liquid particle size upper bound for LUT interpolation + radliq_fac, & ! Factor for calculating LUT interpolation indices for liquid + radice_lwr, & ! Ice particle size upper bound for LUT interpolation + radice_upr, & ! Ice particle size lower bound for LUT interpolation + radice_fac ! Factor for calculating LUT interpolation indices for ice + real(kind_phys), dimension(:,:), allocatable :: & + lut_extliq, & ! LUT shortwave liquid extinction coefficient + lut_ssaliq, & ! LUT shortwave liquid single scattering albedo + lut_asyliq, & ! LUT shortwave liquid asymmetry parameter + band_lims ! Beginning and ending wavenumber [cm -1] for each band + real(kind_phys), dimension(:,:,:), allocatable :: & + lut_extice, & ! LUT shortwave ice extinction coefficient + lut_ssaice, & ! LUT shortwave ice single scattering albedo + lut_asyice ! LUT shortwave ice asymmetry parameter + ! cld_optics_scheme = 2 + real(kind_phys), dimension(:), allocatable :: & + pade_sizereg_extliq, & ! Particle size regime boundaries for shortwave liquid extinction + ! coefficient for Pade interpolation + pade_sizereg_ssaliq, & ! Particle size regime boundaries for shortwave liquid single + ! scattering albedo for Pade interpolation + pade_sizereg_asyliq, & ! Particle size regime boundaries for shortwave liquid asymmetry + ! parameter for Pade interpolation + pade_sizereg_extice, & ! Particle size regime boundaries for shortwave ice extinction + ! coefficient for Pade interpolation + pade_sizereg_ssaice, & ! Particle size regime boundaries for shortwave ice single + ! scattering albedo for Pade interpolation + pade_sizereg_asyice ! Particle size regime boundaries for shortwave ice asymmetry + ! parameter for Pade interpolation + real(kind_phys), dimension(:,:,:), allocatable :: & + pade_extliq, & ! PADE coefficients for shortwave liquid extinction + pade_ssaliq, & ! PADE coefficients for shortwave liquid single scattering albedo + pade_asyliq ! PADE coefficients for shortwave liquid asymmetry parameter + real(kind_phys), dimension(:,:,:,:), allocatable :: & + pade_extice, & ! PADE coefficients for shortwave ice extinction + pade_ssaice, & ! PADE coefficients for shortwave ice single scattering albedo + pade_asyice ! PADE coefficients for shortwave ice asymmetry parameter + ! Dimensions + integer :: & + nrghice_fromfile, nBand, nSize_liq, nSize_ice, nSizeReg,& + nCoeff_ext, nCoeff_ssa_g, nBound, npairs + + ! Local variables + integer :: dimID,varID,status,ncid + character(len=264) :: lw_cloud_props_file + integer,parameter :: max_strlen=256, nrghice_default=2 + + ! Initialize + errmsg = '' + errflg = 0 + + if (cld_optics_scheme .eq. 0) return + + ! Filenames are set in the physics_nml + lw_cloud_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_lw_file_clouds) + + ! On master processor only... +! if (mpirank .eq. mpiroot) then + ! Open file + status = nf90_open(trim(lw_cloud_props_file), NF90_WRITE, ncid) + + ! Read dimensions + status = nf90_inq_dimid(ncid, 'nband', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nBand) + status = nf90_inq_dimid(ncid, 'nrghice', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nrghice_fromfile) + status = nf90_inq_dimid(ncid, 'nsize_liq', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nSize_liq) + status = nf90_inq_dimid(ncid, 'nsize_ice', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nSize_ice) + status = nf90_inq_dimid(ncid, 'nsizereg', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nSizeReg) + status = nf90_inq_dimid(ncid, 'ncoeff_ext', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nCoeff_ext) + status = nf90_inq_dimid(ncid, 'ncoeff_ssa_g', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nCoeff_ssa_g) + status = nf90_inq_dimid(ncid, 'nbound', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nBound) + status = nf90_inq_dimid(ncid, 'pair', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=npairs) + status = nf90_close(ncid) + + ! Has the number of ice-roughnesses to use been provided from the namelist? + ! If not provided, use default number of ice-roughness categories + if (nrghice .eq. 0) then + nrghice = nrghice_default + else + nrghice = nrghice_fromfile + ! If provided in the namelist, check to ensure that number of ice-roughness categories is feasible. + if (nrghice .gt. nrghice_fromfile) then + errmsg = 'Number of RRTMGP ice-roughness categories requested in namelist file is not allowed. Using default number of categories.' + nrghice = nrghice_default + endif + endif + + ! Allocate space for arrays + if (cld_optics_scheme .eq. 1) then + allocate(lut_extliq(nSize_liq, nBand)) + allocate(lut_ssaliq(nSize_liq, nBand)) + allocate(lut_asyliq(nSize_liq, nBand)) + allocate(lut_extice(nSize_ice, nBand, nrghice_fromfile)) + allocate(lut_ssaice(nSize_ice, nBand, nrghice_fromfile)) + allocate(lut_asyice(nSize_ice, nBand, nrghice_fromfile)) + endif + if (cld_optics_scheme .eq. 2) then + allocate(pade_extliq(nBand, nSizeReg, nCoeff_ext )) + allocate(pade_ssaliq(nBand, nSizeReg, nCoeff_ssa_g)) + allocate(pade_asyliq(nBand, nSizeReg, nCoeff_ssa_g)) + allocate(pade_extice(nBand, nSizeReg, nCoeff_ext, nrghice_fromfile)) + allocate(pade_ssaice(nBand, nSizeReg, nCoeff_ssa_g, nrghice_fromfile)) + allocate(pade_asyice(nBand, nSizeReg, nCoeff_ssa_g, nrghice_fromfile)) + allocate(pade_sizereg_extliq(nBound)) + allocate(pade_sizereg_ssaliq(nBound)) + allocate(pade_sizereg_asyliq(nBound)) + allocate(pade_sizereg_extice(nBound)) + allocate(pade_sizereg_ssaice(nBound)) + allocate(pade_sizereg_asyice(nBound)) + endif + allocate(band_lims(2,nBand)) + + ! Read in fields from file + if (cld_optics_scheme .eq. 1) then + write (*,*) 'Reading RRTMGP longwave cloud data (LUT) ... ' + status = nf90_inq_varid(ncid,'radliq_lwr',varID) + status = nf90_get_var(ncid,varID,radliq_lwr) + status = nf90_inq_varid(ncid,'radliq_upr',varID) + status = nf90_get_var(ncid,varID,radliq_upr) + status = nf90_inq_varid(ncid,'radliq_fac',varID) + status = nf90_get_var(ncid,varID,radliq_fac) + status = nf90_inq_varid(ncid,'radice_lwr',varID) + status = nf90_get_var(ncid,varID,radice_lwr) + status = nf90_inq_varid(ncid,'radice_upr',varID) + status = nf90_get_var(ncid,varID,radice_upr) + status = nf90_inq_varid(ncid,'radice_fac',varID) + status = nf90_get_var(ncid,varID,radice_fac) + status = nf90_inq_varid(ncid,'lut_extliq',varID) + status = nf90_get_var(ncid,varID,lut_extliq) + status = nf90_inq_varid(ncid,'lut_ssaliq',varID) + status = nf90_get_var(ncid,varID,lut_ssaliq) + status = nf90_inq_varid(ncid,'lut_asyliq',varID) + status = nf90_get_var(ncid,varID,lut_asyliq) + status = nf90_inq_varid(ncid,'lut_extice',varID) + status = nf90_get_var(ncid,varID,lut_extice) + status = nf90_inq_varid(ncid,'lut_ssaice',varID) + status = nf90_get_var(ncid,varID,lut_ssaice) + status = nf90_inq_varid(ncid,'lut_asyice',varID) + status = nf90_get_var(ncid,varID,lut_asyice) + status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) + status = nf90_get_var(ncid,varID,band_lims) + endif + if (cld_optics_scheme .eq. 2) then + write (*,*) 'Reading RRTMGP longwave cloud data (PADE) ... ' + status = nf90_inq_varid(ncid,'radliq_lwr',varID) + status = nf90_get_var(ncid,varID,radliq_lwr) + status = nf90_inq_varid(ncid,'radliq_upr',varID) + status = nf90_get_var(ncid,varID,radliq_upr) + status = nf90_inq_varid(ncid,'radliq_fac',varID) + status = nf90_get_var(ncid,varID,radliq_fac) + status = nf90_inq_varid(ncid,'radice_lwr',varID) + status = nf90_get_var(ncid,varID,radice_lwr) + status = nf90_inq_varid(ncid,'radice_upr',varID) + status = nf90_get_var(ncid,varID,radice_upr) + status = nf90_inq_varid(ncid,'radice_fac',varID) + status = nf90_get_var(ncid,varID,radice_fac) + status = nf90_inq_varid(ncid,'pade_extliq',varID) + status = nf90_get_var(ncid,varID,pade_extliq) + status = nf90_inq_varid(ncid,'pade_ssaliq',varID) + status = nf90_get_var(ncid,varID,pade_ssaliq) + status = nf90_inq_varid(ncid,'pade_asyliq',varID) + status = nf90_get_var(ncid,varID,pade_asyliq) + status = nf90_inq_varid(ncid,'pade_extice',varID) + status = nf90_get_var(ncid,varID,pade_extice) + status = nf90_inq_varid(ncid,'pade_ssaice',varID) + status = nf90_get_var(ncid,varID,pade_ssaice) + status = nf90_inq_varid(ncid,'pade_asyice',varID) + status = nf90_get_var(ncid,varID,pade_asyice) + status = nf90_inq_varid(ncid,'pade_sizreg_extliq',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_extliq) + status = nf90_inq_varid(ncid,'pade_sizreg_ssaliq',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_ssaliq) + status = nf90_inq_varid(ncid,'pade_sizreg_asyliq',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_asyliq) + status = nf90_inq_varid(ncid,'pade_sizreg_extice',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_extice) + status = nf90_inq_varid(ncid,'pade_sizreg_ssaice',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_ssaice) + status = nf90_inq_varid(ncid,'pade_sizreg_asyice',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_asyice) + status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) + status = nf90_get_var(ncid,varID,band_lims) + endif + + ! Close file + status = nf90_close(ncid) +! endif + + ! Load tables data for RRTMGP cloud-optics + if (cld_optics_scheme .eq. 1) then + call check_error_msg('lw_cloud_optics_init',lw_cloud_props%load(band_lims, & + radliq_lwr, radliq_upr, radliq_fac, radice_lwr, radice_upr, radice_fac, & + lut_extliq, lut_ssaliq, lut_asyliq, lut_extice, lut_ssaice, lut_asyice)) + endif + if (cld_optics_scheme .eq. 2) then + call check_error_msg('lw_cloud_optics_init', lw_cloud_props%load(band_lims, & + pade_extliq, pade_ssaliq, pade_asyliq, pade_extice, pade_ssaice, pade_asyice,& + pade_sizereg_extliq, pade_sizereg_ssaliq, pade_sizereg_asyliq, & + pade_sizereg_extice, pade_sizereg_ssaice, pade_sizereg_asyice)) + endif + call check_error_msg('lw_cloud_optics_init', lw_cloud_props%set_ice_roughness(nrghice)) + + end subroutine rrtmgp_lw_cloud_optics_init + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_cloud_optics_run() + ! ######################################################################################### +!! \section arg_table_rrtmgp_lw_cloud_optics_run +!! \htmlinclude rrtmgp_lw_cloud_optics.html +!! + subroutine rrtmgp_lw_cloud_optics_run(doLWrad, nCol, nLev, cld_optics_scheme, nrghice, & + cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, cld_resnow, cld_rwp, & + cld_rerain, p_lay, lw_cloud_props, lw_gas_props, lon, lat, & + cldtaulw, lw_optical_props_cloudsByBand, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + doLWrad ! Logical flag for longwave radiation call + integer, intent(in) :: & + nCol, & ! Number of horizontal gridpoints + nLev, & ! Number of vertical levels + nrghice, & ! Number of ice-roughness categories + cld_optics_scheme ! Cloud-optics scheme + real(kind_phys), dimension(nCol), intent(in) :: & + lon, & ! Longitude + lat ! Latitude + real(kind_phys), dimension(ncol,nLev),intent(in) :: & + p_lay, & ! Layer pressure (Pa) + cld_frac, & ! Total cloud fraction by layer + cld_lwp, & ! Cloud liquid water path + cld_reliq, & ! Cloud liquid effective radius + cld_iwp, & ! Cloud ice water path + cld_reice, & ! Cloud ice effective radius + cld_swp, & ! Cloud snow water path (used only for RRTMG legacy scheme) + cld_resnow, & ! Cloud snow effective radius (used only for RRTMG legacy scheme) + cld_rwp, & ! Cloud rain water path (used only for RRTMG legacy scheme) + cld_rerain ! Cloud rain effective radius (used only for RRTMG legacy scheme) + type(ty_cloud_optics),intent(in) :: & + lw_cloud_props ! RRTMGP DDT: spectral information for RRTMGP LW radiation scheme + type(ty_gas_optics_rrtmgp),intent(in) :: & + lw_gas_props ! RRTMGP DDT: spectral information for RRTMGP LW radiation scheme + + ! Outputs + real(kind_phys), dimension(ncol,nLev), intent(out) :: & + cldtaulw ! Approx. 10.mu band layer cloud optical depth + type(ty_optical_props_1scl),intent(out) :: & + lw_optical_props_cloudsByBand ! RRTMGP DDT: longwave cloud optical properties in each band + integer, intent(out) :: & + errflg ! CCPP error flag + character(len=*), intent(out) :: & + errmsg ! CCPP error message + + ! Local variables + logical,dimension(ncol,nLev) :: liqmask, icemask + real(kind_phys), dimension(ncol,nLev,lw_gas_props%get_nband()) :: & + tau_cld + integer :: iCol, iLay + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + tau_cld = 0. + + if (.not. doLWrad) return + + ! Compute ice/liquid cloud masks, needed by rrtmgp_cloud_optics + liqmask = (cld_frac .gt. 0 .and. cld_lwp .gt. 0) + icemask = (cld_frac .gt. 0 .and. cld_iwp .gt. 0) + + ! Allocate space for RRTMGP DDTs containing cloud radiative properties + ! Cloud optics [nCol,nLev,nBands] + call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_cloudsByBand%alloc_1scl(& + ncol, nLev, lw_gas_props%get_band_lims_wavenumber())) + lw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys + + ! Compute cloud-optics for RTE. + if (cld_optics_scheme .gt. 0) then + ! i) RRTMGP cloud-optics. + call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_cloud_props%cloud_optics(& + !ncol, & ! IN - Number of horizontal gridpoints + !nLev, & ! IN - Number of vertical layers + !lw_cloud_props%get_nband(), & ! IN - Number of LW bands + !nrghice, & ! IN - Number of ice-roughness categories + !liqmask, & ! IN - Liquid-cloud mask (1) + !icemask, & ! IN - Ice-cloud mask (1) + cld_lwp, & ! IN - Cloud liquid water path (g/m2) + cld_iwp, & ! IN - Cloud ice water path (g/m2) + cld_reliq, & ! IN - Cloud liquid effective radius (microns) + cld_reice, & ! IN - Cloud ice effective radius (microns) + lw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT containing cloud radiative properties + ! in each band + else + ! ii) RRTMG cloud-optics. + if (any(cld_frac .gt. 0)) then + call rrtmg_lw_cloud_optics(ncol, nLev, lw_gas_props%get_nband(), cld_lwp, & + cld_reliq, cld_iwp, cld_reice, cld_rwp, cld_rerain, cld_swp, cld_resnow, & + cld_frac, tau_cld) + endif + lw_optical_props_cloudsByBand%tau = tau_cld + endif + + ! All-sky LW optical depth ~10microns + cldtaulw = lw_optical_props_cloudsByBand%tau(:,:,7) + + end subroutine rrtmgp_lw_cloud_optics_run + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_cloud_optics_finalize() + ! ######################################################################################### +!! \section arg_table_rrtmgp_lw_cloud_optics_finalize +!! \htmlinclude rrtmgp_lw_cloud_optics.html +!! + subroutine rrtmgp_lw_cloud_optics_finalize() + end subroutine rrtmgp_lw_cloud_optics_finalize + +end module rrtmgp_lw_cloud_optics diff --git a/physics/rrtmgp_lw_cloud_optics.meta b/physics/rrtmgp_lw_cloud_optics.meta new file mode 100644 index 000000000..cebbfc700 --- /dev/null +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -0,0 +1,285 @@ +[ccpp-arg-table] + name = rrtmgp_lw_cloud_optics_init + type = scheme +[cld_optics_scheme] + standard_name = rrtmgp_cloud_optics_flag + long_name = Flag to control which RRTMGP cloud-optics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[nrghice] + standard_name = number_of_rrtmgp_ice_roughness + long_name = number of ice-roughness categories in RRTMGP calculation + units = count + dimensions = () + type = integer + intent = inout + optional = F +[rrtmgp_root_dir] + standard_name = directory_for_rte_rrtmgp_source_code + long_name = directory for rte+rrtmgp source code + units = none + dimensions = () + type = character + intent = in + optional = F + kind = len=128 +[rrtmgp_lw_file_clouds] + standard_name = rrtmgp_coeff_lw_cloud_optics + long_name = file containing coefficients for RRTMGP LW cloud optics + units = none + dimensions = () + type = character + intent = in + optional = F + kind = len=128 +[mpirank] + standard_name = mpi_rank + long_name = current MPI rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpiroot] + standard_name = mpi_root + long_name = master MPI rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpicomm] + standard_name = mpi_comm + long_name = MPI communicator + units = index + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F +[lw_cloud_props] + standard_name = coefficients_for_lw_cloud_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + type = ty_cloud_optics + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = rrtmgp_lw_cloud_optics_run + type = scheme +[doLWrad] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[cld_optics_scheme] + standard_name = rrtmgp_cloud_optics_flag + long_name = Flag to control which RRTMGP cloud-optics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[nrghice] + standard_name = number_of_rrtmgp_ice_roughness + long_name = number of ice-roughness categories in RRTMGP calculation + units = count + dimensions = () + type = integer + intent = in + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + intent = in + kind = kind_phys +[cld_lwp] + standard_name = cloud_liquid_water_path + long_name = layer cloud liquid water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + intent = in + kind = kind_phys +[cld_reliq] + standard_name = mean_effective_radius_for_liquid_cloud + long_name = mean effective radius for liquid cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + intent = in + kind = kind_phys +[cld_iwp] + standard_name = cloud_ice_water_path + long_name = layer cloud ice water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + intent = in + kind = kind_phys +[cld_reice] + standard_name = mean_effective_radius_for_ice_cloud + long_name = mean effective radius for ice cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + intent = in + kind = kind_phys +[cld_swp] + standard_name = cloud_snow_water_path + long_name = cloud snow water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + intent = in + kind = kind_phys +[cld_resnow] + standard_name = mean_effective_radius_for_snow_flake + long_name = mean effective radius for snow flake + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + intent = in + kind = kind_phys +[cld_rwp] + standard_name = cloud_rain_water_path + long_name = cloud rain water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + intent = in + kind = kind_phys +[cld_rerain] + standard_name = mean_effective_radius_for_rain_drop + long_name = mean effective radius for rain drop + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + intent = in + kind = kind_phys +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure layer + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lw_gas_props] + standard_name = coefficients_for_lw_gas_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + intent = in + type = ty_gas_optics_rrtmgp + optional = F +[lw_cloud_props] + standard_name = coefficients_for_lw_cloud_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + intent = in + type = ty_cloud_optics + optional = F +[lon] + standard_name = longitude + long_name = longitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lat] + standard_name = latitude + long_name = latitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cldtaulw] + standard_name = RRTMGP_cloud_optical_depth_layers_at_10mu_band + long_name = approx 10mu band layer cloud optical depth + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[lw_optical_props_cloudsByBand] + standard_name = longwave_optical_properties_for_cloudy_atmosphere_by_band + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_1scl + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = rrtmgp_lw_cloud_optics_finalize + type = scheme diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 new file mode 100644 index 000000000..e42336923 --- /dev/null +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -0,0 +1,128 @@ +module rrtmgp_lw_cloud_sampling + use machine, only: kind_phys + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use physparam, only: isubclw, iovrlw + use mo_optical_props, only: ty_optical_props_1scl + use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_ran, draw_samples + use mersenne_twister, only: random_setseed, random_number, random_stat + use rrtmgp_aux, only: check_error_msg + use netcdf + + implicit none + +contains + + ! ######################################################################################### + ! SUBROUTINE mcica_init + ! ######################################################################################### +!! \section arg_table_rrtmgp_lw_cloud_sampling_init +!! \htmlinclude rrtmgp_lw_cloud_sampling_init.html +!! + subroutine rrtmgp_lw_cloud_sampling_init(lw_gas_props, ipsdlw0) + ! Inputs + type(ty_gas_optics_rrtmgp),intent(in) :: & + lw_gas_props ! RRTMGP DDT: K-distribution data + ! Outputs + integer, intent(out) :: & + ipsdlw0 ! Initial permutation seed for McICA + + ! Set initial permutation seed for McICA, initially set to number of G-points + ipsdlw0 = lw_gas_props%get_ngpt() + + end subroutine rrtmgp_lw_cloud_sampling_init + + ! ######################################################################################### + ! SUBROTUINE rrtmgp_lw_cloud_sampling_run() + ! ######################################################################################### +!! \section arg_table_rrtmgp_lw_cloud_sampling_run +!! \htmlinclude rrtmgp_lw_cloud_sampling_run.html +!! + subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, ipsdlw0, icseed_lw, cld_frac,& + lw_gas_props, lw_optical_props_cloudsByBand, lw_optical_props_clouds, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + doLWrad ! Logical flag for shortwave radiation call + integer, intent(in) :: & + nCol, & ! Number of horizontal gridpoints + nLev, & ! Number of vertical layers + ipsdlw0 ! Initial permutation seed for McICA + integer,intent(in),dimension(ncol) :: & + icseed_lw ! auxiliary special cloud related array when module + ! variable isubclw=2, it provides permutation seed + ! for each column profile that are used for generating + ! random numbers. when isubclw /=2, it will not be used. + real(kind_phys), dimension(ncol,nLev),intent(in) :: & + cld_frac ! Total cloud fraction by layer + type(ty_gas_optics_rrtmgp),intent(in) :: & + lw_gas_props ! RRTMGP DDT: K-distribution data + type(ty_optical_props_1scl),intent(in) :: & + lw_optical_props_cloudsByBand ! RRTMGP DDT: Shortwave optical properties (cloudy atmosphere) + + ! Outputs + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error code + type(ty_optical_props_1scl),intent(out) :: & + lw_optical_props_clouds ! RRTMGP DDT: Shortwave optical properties (cloudy atmosphere) + + ! Local variables + integer :: iCol + integer,dimension(ncol) :: ipseed_lw + type(random_stat) :: rng_stat + real(kind_phys), dimension(lw_gas_props%get_ngpt(),nLev,ncol) :: rng3D + real(kind_phys), dimension(lw_gas_props%get_ngpt()*nLev) :: rng1D + logical, dimension(ncol,nLev,lw_gas_props%get_ngpt()) :: cldfracMCICA + real(kind_phys), dimension(ncol,nLev) :: cld_frac_noSamp + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doLWrad) return + + ! Allocate space RRTMGP DDTs [nCol,nLev,nGpt] + call check_error_msg('rrtmgp_lw_cloud_sampling_run',& + lw_optical_props_clouds%alloc_1scl(nCol, nLev, lw_gas_props)) + + ! Change random number seed value for each radiation invocation (isubclw =1 or 2). + if(isubclw == 1) then ! advance prescribed permutation seed + do iCol = 1, ncol + ipseed_lw(iCol) = ipsdlw0 + iCol + enddo + elseif (isubclw == 2) then ! use input array of permutaion seeds + do iCol = 1, ncol + ipseed_lw(iCol) = icseed_lw(iCol) + enddo + endif + + ! Call McICA to generate subcolumns. + ! Call RNG. Mersennse Twister accepts 1D array, so loop over columns and collapse along G-points + ! and layers. ([nGpts,nLev,nColumn]-> [nGpts*nLev]*nColumn) + do iCol=1,ncol + call random_setseed(ipseed_lw(icol),rng_stat) + call random_number(rng1D,rng_stat) + rng3D(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) + enddo + + ! Call McICA + select case ( iovrlw ) + ! Maximumn-random + case(1) + call check_error_msg('rrtmgp_lw_cloud_sampling_run',sampled_mask_max_ran(rng3D,cld_frac,cldfracMCICA)) + end select + + ! Map band optical depth to each g-point using McICA + call check_error_msg('rrtmgp_lw_cloud_sampling_run',draw_samples(& + cldfracMCICA,lw_optical_props_cloudsByBand,lw_optical_props_clouds)) + + end subroutine rrtmgp_lw_cloud_sampling_run + + ! ######################################################################################### + ! SUBROTUINE rrtmgp_lw_cloud_sampling_finalize() + ! ######################################################################################### + subroutine rrtmgp_lw_cloud_sampling_finalize() + end subroutine rrtmgp_lw_cloud_sampling_finalize + +end module rrtmgp_lw_cloud_sampling diff --git a/physics/rrtmgp_lw_cloud_sampling.meta b/physics/rrtmgp_lw_cloud_sampling.meta new file mode 100644 index 000000000..547c6177c --- /dev/null +++ b/physics/rrtmgp_lw_cloud_sampling.meta @@ -0,0 +1,114 @@ +[ccpp-arg-table] + name = rrtmgp_lw_cloud_sampling_init + type = scheme +[lw_gas_props] + standard_name = coefficients_for_lw_gas_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[ipsdlw0] + standard_name = initial_permutation_seed_lw + long_name = initial seed for McICA LW + units = none + dimensions = () + type = integer + intent = out + optional = F + +###################################################### +[ccpp-arg-table] + name = rrtmgp_lw_cloud_sampling_run + type = scheme +[doLWrad] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[ipsdlw0] + standard_name = initial_permutation_seed_lw + long_name = initial seed for McICA LW + units = none + dimensions = () + type = integer + intent = in + optional = F +[icseed_lw] + standard_name = seed_random_numbers_lw + long_name = seed for random number generation for longwave radiation + units = none + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lw_gas_props] + standard_name = coefficients_for_lw_gas_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[lw_optical_props_cloudsByBand] + standard_name = longwave_optical_properties_for_cloudy_atmosphere_by_band + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_1scl + intent = in + optional = F +[lw_optical_props_clouds] + standard_name = longwave_optical_properties_for_cloudy_atmosphere + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_1scl + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F \ No newline at end of file diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 new file mode 100644 index 000000000..408cc48f5 --- /dev/null +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -0,0 +1,338 @@ +module rrtmgp_lw_gas_optics + use machine, only: kind_phys + use mo_rte_kind, only: wl + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_gas_concentrations, only: ty_gas_concs + use mo_source_functions, only: ty_source_func_lw + use mo_optical_props, only: ty_optical_props_1scl + use mo_compute_bc, only: compute_bc + use rrtmgp_aux, only: check_error_msg + use netcdf + + implicit none + +contains + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_gas_optics_init + ! ######################################################################################### +!! \section arg_table_rrtmgp_lw_gas_optics_init +!! \htmlinclude rrtmgp_lw_gas_optics_init.html +!! + subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp_nGases, & + active_gases_array, mpicomm, mpirank, mpiroot, lw_gas_props, errmsg, errflg) + + ! Inputs + character(len=128),intent(in) :: & + rrtmgp_root_dir, & ! RTE-RRTMGP root directory + rrtmgp_lw_file_gas ! RRTMGP file containing coefficients used to compute gaseous optical properties + integer, intent(in) :: & + rrtmgp_nGases ! Number of trace gases active in RRTMGP + character(len=*),dimension(rrtmgp_nGases), intent(in) :: & + active_gases_array ! Character array containing trace gases to include in RRTMGP + integer,intent(in) :: & + mpicomm, & ! MPI communicator + mpirank, & ! Current MPI rank + mpiroot ! Master MPI rank + + ! Outputs + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error code + type(ty_gas_optics_rrtmgp),intent(out) :: & + lw_gas_props ! RRTMGP DDT: longwave spectral information + + ! Variables that will be passed to gas_optics%load() + type(ty_gas_concs) :: & + gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) + integer, dimension(:), allocatable :: & + kminor_start_lower, & ! Starting index in the [1, nContributors] vector for a contributor + ! given by \"minor_gases_lower\" (lower atmosphere) + kminor_start_upper ! Starting index in the [1, nContributors] vector for a contributor + ! given by \"minor_gases_upper\" (upper atmosphere) + integer, dimension(:,:), allocatable :: & + band2gpt, & ! Beginning and ending gpoint for each band + minor_limits_gpt_lower, & ! Beginning and ending gpoint for each minor interval in lower atmosphere + minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere + integer, dimension(:,:,:), allocatable :: & + key_species ! Key species pair for each band + real(kind_phys) :: & + press_ref_trop, & ! Reference pressure separating the lower and upper atmosphere [Pa] + temp_ref_p, & ! Standard spectroscopic reference pressure [Pa] + temp_ref_t ! Standard spectroscopic reference temperature [K] + real(kind_phys), dimension(:), allocatable :: & + press_ref, & ! Pressures for reference atmosphere; press_ref(# reference layers) [Pa] + temp_ref ! Temperatures for reference atmosphere; temp_ref(# reference layers) [K] + real(kind_phys), dimension(:,:), allocatable :: & + band_lims, & ! Beginning and ending wavenumber [cm -1] for each band + totplnk ! Integrated Planck function by band + real(kind_phys), dimension(:,:,:), allocatable :: & + vmr_ref, & ! volume mixing ratios for reference atmosphere + kminor_lower, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to + ! [nTemp x nEta x nContributors] array) + kminor_upper, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to + ! [nTemp x nEta x nContributors] array) + rayl_lower, & ! Not used in LW, rather allocated(rayl_lower) is used + rayl_upper ! Not used in LW, rather allocated(rayl_upper) is used + real(kind_phys), dimension(:,:,:,:), allocatable :: & + kmajor, & ! Stored absorption coefficients due to major absorbing gases + planck_frac ! Planck fractions + character(len=32), dimension(:), allocatable :: & + gas_names, & ! Names of absorbing gases + gas_minor, & ! Name of absorbing minor gas + identifier_minor, & ! Unique string identifying minor gas + minor_gases_lower, & ! Names of minor absorbing gases in lower atmosphere + minor_gases_upper, & ! Names of minor absorbing gases in upper atmosphere + scaling_gas_lower, & ! Absorption also depends on the concentration of this gas + scaling_gas_upper ! Absorption also depends on the concentration of this gas + logical(wl), dimension(:), allocatable :: & + minor_scales_with_density_lower, & ! Density scaling is applied to minor absorption coefficients + minor_scales_with_density_upper, & ! Density scaling is applied to minor absorption coefficients + scale_by_complement_lower, & ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) + scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) + + ! Dimensions + integer :: & + ntemps, npress, ngpts, nabsorbers, nextrabsorbers, nminorabsorbers,& + nmixingfracs, nlayers, nbnds, npairs, ninternalSourcetemps, & + nminor_absorber_intervals_lower, nminor_absorber_intervals_upper, & + ncontributors_lower, ncontributors_upper + + ! Local variables + integer :: ncid, dimID, varID, status, iGas, ierr + integer,dimension(:),allocatable :: temp1, temp2, temp3, temp4, & + temp_log_array1, temp_log_array2, temp_log_array3, temp_log_array4 + character(len=264) :: lw_gas_props_file + + ! Initialize + errmsg = '' + errflg = 0 + + ! Filenames are set in the physics_nml + lw_gas_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_lw_file_gas) + + ! On master processor only... +! if (mpirank .eq. mpiroot) then + ! Open file + status = nf90_open(trim(lw_gas_props_file), NF90_WRITE, ncid) + + ! Read dimensions for k-distribution fields + status = nf90_inq_dimid(ncid, 'temperature', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = ntemps) + status = nf90_inq_dimid(ncid, 'pressure', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = npress) + status = nf90_inq_dimid(ncid, 'absorber', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = nabsorbers) + status = nf90_inq_dimid(ncid, 'minor_absorber', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = nminorabsorbers) + status = nf90_inq_dimid(ncid, 'absorber_ext', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = nextrabsorbers) + status = nf90_inq_dimid(ncid, 'mixing_fraction', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = nmixingfracs) + status = nf90_inq_dimid(ncid, 'atmos_layer', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = nlayers) + status = nf90_inq_dimid(ncid, 'bnd', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = nbnds) + status = nf90_inq_dimid(ncid, 'gpt', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = ngpts) + status = nf90_inq_dimid(ncid, 'pair', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = npairs) + status = nf90_inq_dimid(ncid, 'contributors_lower', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = ncontributors_lower) + status = nf90_inq_dimid(ncid, 'contributors_upper', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = ncontributors_upper) + status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_lower', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = nminor_absorber_intervals_lower) + status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_upper', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = nminor_absorber_intervals_upper) + status = nf90_inq_dimid(ncid, 'temperature_Planck', dimid) + status = nf90_inquire_dimension(ncid, dimid, len = ninternalSourcetemps) + + ! Allocate space for arrays + allocate(gas_names(nabsorbers)) + allocate(scaling_gas_lower(nminor_absorber_intervals_lower)) + allocate(scaling_gas_upper(nminor_absorber_intervals_upper)) + allocate(gas_minor(nminorabsorbers)) + allocate(identifier_minor(nminorabsorbers)) + allocate(minor_gases_lower(nminor_absorber_intervals_lower)) + allocate(minor_gases_upper(nminor_absorber_intervals_upper)) + allocate(minor_limits_gpt_lower(npairs,nminor_absorber_intervals_lower)) + allocate(minor_limits_gpt_upper(npairs,nminor_absorber_intervals_upper)) + allocate(band2gpt(2,nbnds)) + allocate(key_species(2,nlayers,nbnds)) + allocate(band_lims(2,nbnds)) + allocate(press_ref(npress)) + allocate(temp_ref(ntemps)) + allocate(vmr_ref(nlayers, nextrabsorbers, ntemps)) + allocate(kminor_lower(ncontributors_lower, nmixingfracs, ntemps)) + allocate(kmajor(ngpts, nmixingfracs, npress+1, ntemps)) + allocate(kminor_start_lower(nminor_absorber_intervals_lower)) + allocate(kminor_upper(ncontributors_upper, nmixingfracs, ntemps)) + allocate(kminor_start_upper(nminor_absorber_intervals_upper)) + allocate(minor_scales_with_density_lower(nminor_absorber_intervals_lower)) + allocate(minor_scales_with_density_upper(nminor_absorber_intervals_upper)) + allocate(scale_by_complement_lower(nminor_absorber_intervals_lower)) + allocate(scale_by_complement_upper(nminor_absorber_intervals_upper)) + allocate(temp1(nminor_absorber_intervals_lower)) + allocate(temp2(nminor_absorber_intervals_upper)) + allocate(temp3(nminor_absorber_intervals_lower)) + allocate(temp4(nminor_absorber_intervals_upper)) + allocate(totplnk(ninternalSourcetemps, nbnds)) + allocate(planck_frac(ngpts, nmixingfracs, npress+1, ntemps)) + + ! Read in fields from file + if (mpirank==mpiroot) write (*,*) 'Reading RRTMGP longwave k-distribution data ... ' + status = nf90_inq_varid(ncid, 'gas_names', varID) + status = nf90_get_var( ncid, varID, gas_names) + status = nf90_inq_varid(ncid, 'scaling_gas_lower', varID) + status = nf90_get_var( ncid, varID, scaling_gas_lower) + status = nf90_inq_varid(ncid, 'scaling_gas_upper', varID) + status = nf90_get_var( ncid, varID, scaling_gas_upper) + status = nf90_inq_varid(ncid, 'gas_minor', varID) + status = nf90_get_var( ncid, varID, gas_minor) + status = nf90_inq_varid(ncid, 'identifier_minor', varID) + status = nf90_get_var( ncid, varID, identifier_minor) + status = nf90_inq_varid(ncid, 'minor_gases_lower', varID) + status = nf90_get_var( ncid, varID, minor_gases_lower) + status = nf90_inq_varid(ncid, 'minor_gases_upper', varID) + status = nf90_get_var( ncid, varID, minor_gases_upper) + status = nf90_inq_varid(ncid, 'minor_limits_gpt_lower', varID) + status = nf90_get_var( ncid, varID, minor_limits_gpt_lower) + status = nf90_inq_varid(ncid, 'minor_limits_gpt_upper', varID) + status = nf90_get_var( ncid, varID, minor_limits_gpt_upper) + status = nf90_inq_varid(ncid, 'bnd_limits_gpt', varID) + status = nf90_get_var( ncid, varID, band2gpt) + status = nf90_inq_varid(ncid, 'key_species', varID) + status = nf90_get_var( ncid, varID, key_species) + status = nf90_inq_varid(ncid, 'bnd_limits_wavenumber', varID) + status = nf90_get_var( ncid, varID, band_lims) + status = nf90_inq_varid(ncid, 'press_ref', varID) + status = nf90_get_var( ncid, varID, press_ref) + status = nf90_inq_varid(ncid, 'temp_ref', varID) + status = nf90_get_var( ncid, varID, temp_ref) + status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_P', varID) + status = nf90_get_var( ncid, varID, temp_ref_p) + status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_T', varID) + status = nf90_get_var( ncid, varID, temp_ref_t) + status = nf90_inq_varid(ncid, 'press_ref_trop', varID) + status = nf90_get_var( ncid, varID, press_ref_trop) + status = nf90_inq_varid(ncid, 'kminor_lower', varID) + status = nf90_get_var( ncid, varID, kminor_lower) + status = nf90_inq_varid(ncid, 'kminor_upper', varID) + status = nf90_get_var( ncid, varID, kminor_upper) + status = nf90_inq_varid(ncid, 'vmr_ref', varID) + status = nf90_get_var( ncid, varID, vmr_ref) + status = nf90_inq_varid(ncid, 'kmajor', varID) + status = nf90_get_var( ncid, varID, kmajor) + status = nf90_inq_varid(ncid, 'kminor_start_lower', varID) + status = nf90_get_var( ncid, varID, kminor_start_lower) + status = nf90_inq_varid(ncid, 'kminor_start_upper', varID) + status = nf90_get_var( ncid, varID, kminor_start_upper) + status = nf90_inq_varid(ncid, 'totplnk', varID) + status = nf90_get_var( ncid, varID, totplnk) + status = nf90_inq_varid(ncid, 'plank_fraction', varID) + status = nf90_get_var( ncid, varID, planck_frac) + + ! Logical fields are read in as integers and then converted to logicals. + status = nf90_inq_varid(ncid, 'minor_scales_with_density_lower', varID) + status = nf90_get_var( ncid, varID,temp1) + minor_scales_with_density_lower(:) = .false. + where(temp1 .eq. 1) minor_scales_with_density_lower(:) = .true. + status = nf90_inq_varid(ncid, 'minor_scales_with_density_upper', varID) + status = nf90_get_var( ncid, varID,temp2) + minor_scales_with_density_upper(:) = .false. + where(temp2 .eq. 1) minor_scales_with_density_upper(:) = .true. + status = nf90_inq_varid(ncid, 'scale_by_complement_lower', varID) + status = nf90_get_var( ncid, varID,temp3) + scale_by_complement_lower(:) = .false. + where(temp3 .eq. 1) scale_by_complement_lower(:) = .true. + status = nf90_inq_varid(ncid, 'scale_by_complement_upper', varID) + status = nf90_get_var( ncid, varID,temp4) + scale_by_complement_upper(:) = .false. + where(temp4 .eq. 1) scale_by_complement_upper(:) = .true. + + ! Close file + status = nf90_close(ncid) +! endif + + ! Initialize gas concentrations and gas optics class + call check_error_msg('lw_gas_optics_init',gas_concentrations%init(active_gases_array)) + call check_error_msg('lw_gas_optics_init',lw_gas_props%load(gas_concentrations, gas_names, & + key_species, band2gpt, band_lims, press_ref, press_ref_trop, temp_ref, temp_ref_p, & + temp_ref_t, vmr_ref, kmajor, kminor_lower, kminor_upper, gas_minor, identifier_minor, & + minor_gases_lower, minor_gases_upper, minor_limits_gpt_lower, minor_limits_gpt_upper, & + minor_scales_with_density_lower, minor_scales_with_density_upper, scaling_gas_lower, & + scaling_gas_upper, scale_by_complement_lower, scale_by_complement_upper, & + kminor_start_lower, kminor_start_upper, totplnk, planck_frac, rayl_lower, rayl_upper)) + + end subroutine rrtmgp_lw_gas_optics_init + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_gas_optics_run + ! ######################################################################################### +!! \section arg_table_rrtmgp_lw_gas_optics_run +!! \htmlinclude rrtmgp_lw_gas_optics_run.html +!! + subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, lw_gas_props, p_lay, p_lev, t_lay,& + t_lev, skt, gas_concentrations, lw_optical_props_clrsky, sources, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + doLWrad ! Flag to calculate LW irradiances + integer,intent(in) :: & + ncol, & ! Number of horizontal points + nLev ! Number of vertical levels + type(ty_gas_optics_rrtmgp),intent(in) :: & + lw_gas_props ! RRTMGP DDT: + real(kind_phys), dimension(ncol,nLev), intent(in) :: & + p_lay, & ! Pressure @ model layer-centers (hPa) + t_lay ! Temperature (K) + real(kind_phys), dimension(ncol,nLev+1), intent(in) :: & + p_lev, & ! Pressure @ model layer-interfaces (hPa) + t_lev ! Temperature @ model levels + real(kind_phys), dimension(ncol), intent(in) :: & + skt ! Surface(skin) temperature (K) + type(ty_gas_concs),intent(in) :: & + gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) + + ! Output + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error code + type(ty_optical_props_1scl),intent(out) :: & + lw_optical_props_clrsky ! RRTMGP DDT: longwave clear-sky radiative properties + type(ty_source_func_lw),intent(out) :: & + sources ! RRTMGP DDT: longwave source functions + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doLWrad) return + + ! Allocate and initialize + call check_error_msg('rrtmgp_lw_gas_optics_run',lw_optical_props_clrsky%alloc_1scl(ncol, nLev, lw_gas_props)) + call check_error_msg('rrtmgp_lw_gas_optics_run',sources%alloc(ncol, nLev, lw_gas_props)) + + ! Gas-optics + call check_error_msg('rrtmgp_lw_gas_optics_run',lw_gas_props%gas_optics(& + p_lay, & ! IN - Pressure @ layer-centers (Pa) + p_lev, & ! IN - Pressure @ layer-interfaces (Pa) + t_lay, & ! IN - Temperature @ layer-centers (K) + skt, & ! IN - Skin-temperature (K) + gas_concentrations, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios + lw_optical_props_clrsky, & ! OUT - RRTMGP DDT: longwave optical properties + sources, & ! OUT - RRTMGP DDT: source functions + tlev=t_lev)) ! IN - Temperature @ layer-interfaces (K) (optional) + + end subroutine rrtmgp_lw_gas_optics_run + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_gas_optics_finalize + ! ######################################################################################### + subroutine rrtmgp_lw_gas_optics_finalize() + end subroutine rrtmgp_lw_gas_optics_finalize + +end module rrtmgp_lw_gas_optics diff --git a/physics/rrtmgp_lw_gas_optics.meta b/physics/rrtmgp_lw_gas_optics.meta new file mode 100644 index 000000000..36b8067dd --- /dev/null +++ b/physics/rrtmgp_lw_gas_optics.meta @@ -0,0 +1,210 @@ +[ccpp-arg-table] + name = rrtmgp_lw_gas_optics_init + type = scheme +[rrtmgp_root_dir] + standard_name = directory_for_rte_rrtmgp_source_code + long_name = directory for rte+rrtmgp source code + units = none + dimensions = () + type = character + intent = in + optional = F + kind = len=128 +[rrtmgp_lw_file_gas] + standard_name = rrtmgp_kdistribution_lw + long_name = file containing RRTMGP LW k-distribution + units = none + dimensions = () + type = character + intent = in + optional = F + kind = len=128 +[rrtmgp_nGases] + standard_name = number_of_active_gases_used_by_RRTMGP + long_name = number of gases available used by RRTMGP + units = count + dimensions = () + type = integer + intent = in + optional = F +[active_gases_array] + standard_name = list_of_active_gases_used_by_RRTMGP + long_name = list of active gases used by RRTMGP + units = none + dimensions = (number_of_active_gases_used_by_RRTMGP) + type = character + kind = len=* + intent = in + optional = F +[mpirank] + standard_name = mpi_rank + long_name = current MPI rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpiroot] + standard_name = mpi_root + long_name = master MPI rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpicomm] + standard_name = mpi_comm + long_name = MPI communicator + units = index + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F +[lw_gas_props] + standard_name = coefficients_for_lw_gas_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = rrtmgp_lw_gas_optics_run + type = scheme +[doLWrad] + standard_name = flag_to_calc_lw + long_name = flag to calculate LW irradiances + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[lw_gas_props] + standard_name = coefficients_for_lw_gas_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure layer + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure level + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[t_lay] + standard_name = air_temperature_at_layer_for_RRTMGP + long_name = air temperature layer + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t_lev] + standard_name = air_temperature_at_interface_for_RRTMGP + long_name = air temperature level + units = K + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[skt] + standard_name = surface_ground_temperature_for_radiation + long_name = surface ground temperature for radiation + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[gas_concentrations] + standard_name = Gas_concentrations_for_RRTMGP_suite + long_name = DDT containing gas concentrations for RRTMGP radiation scheme + units = DDT + dimensions = () + type = ty_gas_concs + intent = in + optional = F +[lw_optical_props_clrsky] + standard_name = longwave_optical_properties_for_clear_sky + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_1scl + intent = out + optional = F +[sources] + standard_name = longwave_source_function + long_name = Fortran DDT containing RRTMGP source functions + units = DDT + dimensions = () + type = ty_source_func_lw + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/rrtmgp_lw_pre.F90 b/physics/rrtmgp_lw_pre.F90 new file mode 100644 index 000000000..1148c6705 --- /dev/null +++ b/physics/rrtmgp_lw_pre.F90 @@ -0,0 +1,91 @@ +module rrtmgp_lw_pre + use physparam + use machine, only: & + kind_phys ! Working type + use GFS_typedefs, only: & + GFS_control_type, & ! + GFS_sfcprop_type, & ! Surface fields + GFS_grid_type, & ! Grid and interpolation related data + GFS_statein_type, & ! + GFS_radtend_type ! Radiation tendencies needed in physics + use module_radiation_surface, only: & + setemis ! Routine to compute surface-emissivity + use mo_gas_optics_rrtmgp, only: & + ty_gas_optics_rrtmgp + + implicit none + + public rrtmgp_lw_pre_run,rrtmgp_lw_pre_init,rrtmgp_lw_pre_finalize + +contains + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_pre_init + ! ######################################################################################### + subroutine rrtmgp_lw_pre_init () + end subroutine rrtmgp_lw_pre_init + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_pre_run + ! ######################################################################################### +!> \section arg_table_rrtmgp_lw_pre_run +!! \htmlinclude rrtmgp_lw_pre_run.html +!! + subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, sncovr, tsfc, & + hprime, lw_gas_props, sfc_emiss_byband, semis, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + doLWrad ! Logical flag for longwave radiation call + integer, intent(in) :: & + nCol ! Number of horizontal grid points + real(kind_phys), dimension(nCol), intent(in) :: & + xlon, & ! Longitude + xlat, & ! Latitude + slmsk, & ! Land/sea/sea-ice mask + zorl, & ! Surface roughness length (cm) + snowd, & ! water equivalent snow depth (mm) + sncovr, & ! Surface snow are fraction (1) + tsfc, & ! Surface skin temperature (K) + hprime ! Standard deviation of subgrid orography + type(ty_gas_optics_rrtmgp),intent(in) :: & + lw_gas_props ! RRTMGP DDT: spectral information for LW calculation + + ! Outputs + real(kind_phys), dimension(lw_gas_props%get_nband(),ncol), intent(out) :: & + sfc_emiss_byband ! Surface emissivity in each band + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error flag + real(kind_phys), dimension(nCol), intent(out) :: & + semis + + ! Local variables + integer :: iBand + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doLWrad) return + + ! ####################################################################################### + ! Call module_radiation_surface::setemis(),to setup surface emissivity for LW radiation. + ! ####################################################################################### + call setemis (xlon, xlat, slmsk, snowd, sncovr, zorl, tsfc, tsfc, hprime, nCol, semis) + + ! Assign same emissivity to all bands + do iBand=1,lw_gas_props%get_nband() + sfc_emiss_byband(iBand,:) = semis + enddo + + end subroutine rrtmgp_lw_pre_run + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_pre_finalize + ! ######################################################################################### + subroutine rrtmgp_lw_pre_finalize () + end subroutine rrtmgp_lw_pre_finalize + +end module rrtmgp_lw_pre diff --git a/physics/rrtmgp_lw_pre.meta b/physics/rrtmgp_lw_pre.meta new file mode 100644 index 000000000..5d1c518b6 --- /dev/null +++ b/physics/rrtmgp_lw_pre.meta @@ -0,0 +1,134 @@ +[ccpp-arg-table] + name = rrtmgp_lw_pre_run + type = scheme +[doLWrad] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[nCol] + standard_name = horizontal_loop_extent + long_name = horizontal loop extent + units = count + dimensions = () + type = integer + intent = in + optional = F +[xlon] + standard_name = longitude + long_name = longitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[xlat] + standard_name = latitude + long_name = latitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[slmsk] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[zorl] + standard_name = surface_roughness_length + long_name = surface roughness length + units = cm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[snowd] + standard_name = surface_snow_thickness_water_equivalent + long_name = water equivalent snow depth + units = mm + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sncovr] + standard_name = surface_snow_area_fraction_over_land + long_name = surface snow area fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tsfc] + standard_name = surface_skin_temperature + long_name = surface skin temperature + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[hprime] + standard_name = standard_deviation_of_subgrid_orography + long_name = standard deviation of subgrid orography + units = m + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lw_gas_props] + standard_name = coefficients_for_lw_gas_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[semis] + standard_name = surface_longwave_emissivity + long_name = surface lw emissivity in fraction + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[sfc_emiss_byband] + standard_name = surface_emissivity_in_each_RRTMGP_LW_band + long_name = surface emissivity in each RRTMGP LW band + units = none + dimensions = (number_of_lw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 new file mode 100644 index 000000000..583fa9ee2 --- /dev/null +++ b/physics/rrtmgp_lw_rte.F90 @@ -0,0 +1,170 @@ +! ########################################################################################### +! ########################################################################################### +module rrtmgp_lw_rte + use machine, only: kind_phys + use mo_rte_kind, only: wl + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_cloud_optics, only: ty_cloud_optics + use mo_optical_props, only: ty_optical_props_1scl + use mo_rte_lw, only: rte_lw + use mo_fluxes_byband, only: ty_fluxes_byband + use mo_source_functions, only: ty_source_func_lw + use rrtmgp_aux, only: check_error_msg + + implicit none + + public rrtmgp_lw_rte_init, rrtmgp_lw_rte_run, rrtmgp_lw_rte_finalize + +contains + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_rte_init + ! ######################################################################################### + subroutine rrtmgp_lw_rte_init() + end subroutine rrtmgp_lw_rte_init + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_rte_run + ! ######################################################################################### +!! \section arg_table_rrtmgp_lw_rte_run +!! \htmlinclude rrtmgp_lw_rte_run.html +!! + subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_gas_props, & + sfc_emiss_byband, sources, lw_optical_props_clrsky, lw_optical_props_clouds, & + lw_optical_props_aerosol, secdiff, nGauss_angles, fluxlwUP_allsky, fluxlwDOWN_allsky,& + fluxlwUP_clrsky, fluxlwDOWN_clrsky, hlwb, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + doLWrad ! Logical flag for longwave radiation call + integer, intent(in) :: & + nCol, & ! Number of horizontal gridpoints + nLev, & ! Number of vertical levels + nGauss_angles ! Number of angles used in Gaussian quadrature + real(kind_phys), dimension(ncol,nLev), intent(in) :: & + p_lay, & ! Pressure @ model layer-centers (hPa) + t_lay ! Temperature (K) + real(kind_phys), dimension(ncol,nLev+1), intent(in) :: & + p_lev ! Pressure @ model layer-interfaces (hPa) + real(kind_phys), dimension(ncol), intent(in) :: & + skt ! Surface(skin) temperature (K) + type(ty_gas_optics_rrtmgp),intent(in) :: & + lw_gas_props ! RRTMGP DDT: longwave spectral information + real(kind_phys), dimension(lw_gas_props%get_nband(),ncol), intent(in) :: & + sfc_emiss_byband ! Surface emissivity in each band + type(ty_source_func_lw),intent(in) :: & + sources ! RRTMGP DDT: longwave source functions + type(ty_optical_props_1scl),intent(inout) :: & + lw_optical_props_clrsky ! RRTMGP DDT: longwave clear-sky radiative properties + type(ty_optical_props_1scl),intent(in) :: & + lw_optical_props_clouds, & ! RRTMGP DDT: longwave cloud radiative properties + lw_optical_props_aerosol ! RRTMGP DDT: longwave aerosol radiative properties + real(kind_phys), dimension(lw_gas_props%get_nband(),ncol),intent(in) :: & + secdiff + ! Outputs + real(kind_phys), dimension(ncol,nLev+1), intent(out) :: & + fluxlwUP_allsky, & ! All-sky flux (W/m2) + fluxlwDOWN_allsky, & ! All-sky flux (W/m2) + fluxlwUP_clrsky, & ! Clear-sky flux (W/m2) + fluxlwDOWN_clrsky ! All-sky flux (W/m2) + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error flag + + ! Outputs (optional) + real(kind_phys), dimension(ncol,nLev,lw_gas_props%get_nband()), optional, intent(inout) :: & + hlwb ! All-sky heating rate, by band (K/sec) + + ! Local variables + integer :: & + iCol, iBand, iLay + type(ty_fluxes_byband) :: & + flux_allsky, flux_clrsky + real(kind_phys), dimension(ncol,nLev+1,lw_gas_props%get_nband()),target :: & + fluxLW_up_allsky, fluxLW_up_clrsky, fluxLW_dn_allsky, fluxLW_dn_clrsky + logical :: & + l_AllSky_HR_byband, top_at_1 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doLWrad) return + + ! Vertical ordering? + top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) + + ! Are any optional outputs requested? Need to know now to compute correct fluxes. + l_AllSky_HR_byband = present(hlwb) + + ! Initialize RRTMGP DDT containing 2D(3D) fluxes + flux_allsky%bnd_flux_up => fluxLW_up_allsky + flux_allsky%bnd_flux_dn => fluxLW_dn_allsky + flux_clrsky%bnd_flux_up => fluxLW_up_clrsky + flux_clrsky%bnd_flux_dn => fluxLW_dn_clrsky + + ! + ! Compute clear-sky fluxes (if requested) + ! + ! Add aerosol optics to gas optics + call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_aerosol%increment(lw_optical_props_clrsky)) + + ! Apply diffusivity angle adjustment (RRTMG legacy) + do iCol=1,nCol + do iBand=1,lw_gas_props%get_nband() + lw_optical_props_clrsky%tau(iCol,1:nLev,iBand) = lw_optical_props_clrsky%tau(iCol,1:nLev,iBand)*secdiff(iBand,iCol) + enddo + enddo + + ! Call RTE solver + call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & + lw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_clrsky, & ! OUT - Fluxes + n_gauss_angles = nGauss_angles)) + ! Store fluxes + fluxlwUP_clrsky = sum(flux_clrsky%bnd_flux_up,dim=3) + fluxlwDOWN_clrsky = sum(flux_clrsky%bnd_flux_dn,dim=3) + + ! + ! All-sky fluxes + ! + + ! Apply diffusivity angle adjustment (RRTMG legacy) + !do iCol=1,nCol + ! do iBand=1,lw_gas_props%get_nband() + ! lw_optical_props_clouds%tau(iCol,1:nLev,iBand) = lw_optical_props_clouds%tau(iCol,1:nLev,iBand)*secdiff(iBand,iCol) + ! enddo + !enddo + ! Add cloud optics to clear-sky optics + call check_error_msg('rrtmgp_lw_rte_run',lw_optical_props_clouds%increment(lw_optical_props_clrsky)) + + ! Call RTE solver + call check_error_msg('rrtmgp_lw_rte_run',rte_lw( & + lw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + sources, & ! IN - source function + sfc_emiss_byband, & ! IN - surface emissivity in each LW band + flux_allsky, & ! OUT - Flxues + n_gauss_angles = nGauss_angles)) + ! Store fluxes + fluxlwUP_allsky = sum(flux_allsky%bnd_flux_up,dim=3) + fluxlwDOWN_allsky = sum(flux_allsky%bnd_flux_dn,dim=3) + + ! Only output fluxes by-band when heating-rate profiles by band are requested. + !if (l_AllSky_HR_byband) then + !endif + + end subroutine rrtmgp_lw_rte_run + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_lw_rte_finalize + ! ######################################################################################### + subroutine rrtmgp_lw_rte_finalize() + end subroutine rrtmgp_lw_rte_finalize + + +end module rrtmgp_lw_rte diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta new file mode 100644 index 000000000..a8426bc15 --- /dev/null +++ b/physics/rrtmgp_lw_rte.meta @@ -0,0 +1,191 @@ +[ccpp-arg-table] + name = rrtmgp_lw_rte_run + type = scheme +[doLWrad] + standard_name = flag_to_calc_lw + long_name = logical flags for lw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[nGauss_angles] + standard_name = number_of_angles_used_in_gaussian_quadrature + long_name = Number of angles used in Gaussian quadrature + units = count + dimensions = () + type = integer + intent = in + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure layer + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure level + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[t_lay] + standard_name = air_temperature_at_layer_for_RRTMGP + long_name = air temperature layer + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[skt] + standard_name = surface_ground_temperature_for_radiation + long_name = surface ground temperature for radiation + units = K + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfc_emiss_byband] + standard_name = surface_emissivity_in_each_RRTMGP_LW_band + long_name = surface emissivity in each RRTMGP LW band + units = none + dimensions = (number_of_lw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lw_gas_props] + standard_name = coefficients_for_lw_gas_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[lw_optical_props_clrsky] + standard_name = longwave_optical_properties_for_clear_sky + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_1scl + intent = inout + optional = F +[lw_optical_props_clouds] + standard_name = longwave_optical_properties_for_cloudy_atmosphere + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_1scl + intent = in + optional = F +[lw_optical_props_aerosol] + standard_name = longwave_optical_properties_for_aerosols + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_1scl + intent = in + optional = F +[sources] + standard_name = longwave_source_function + long_name = Fortran DDT containing RRTMGP source functions + units = DDT + dimensions = () + type = ty_source_func_lw + intent = in + optional = F +[hlwb] + standard_name = RRTMGP_lw_heating_rate_spectral + long_name = RRTMGP longwave total sky heating rate (spectral) + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_lw_spectral_points_rrtmgp) + type = real + kind = kind_phys + intent = in + optional = T +[secdiff] + standard_name = secant_of_diffusivity_angle_each_RRTMGP_LW_band + long_name = secant of diffusivity angle in each RRTMGP LW band + units = none + dimensions = (number_of_lw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[fluxlwUP_allsky] + standard_name = RRTMGP_lw_flux_profile_upward_allsky + long_name = RRTMGP upward longwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = out + optional = F +[fluxlwDOWN_allsky] + standard_name = RRTMGP_lw_flux_profile_downward_allsky + long_name = RRTMGP downward longwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = out + optional = F +[fluxlwUP_clrsky] + standard_name = RRTMGP_lw_flux_profile_upward_clrsky + long_name = RRTMGP upward longwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = out + optional = F +[fluxlwDOWN_clrsky] + standard_name = RRTMGP_lw_flux_profile_downward_clrsky + long_name = RRTMGP downward longwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/rrtmgp_sw_aerosol_optics.F90 b/physics/rrtmgp_sw_aerosol_optics.F90 new file mode 100644 index 000000000..4bb034279 --- /dev/null +++ b/physics/rrtmgp_sw_aerosol_optics.F90 @@ -0,0 +1,121 @@ +module rrtmgp_sw_aerosol_optics + use machine, only: kind_phys + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_optical_props, only: ty_optical_props_2str + use rrtmgp_aux, only: check_error_msg + use module_radiation_aerosols, only: & + NF_AESW, & ! Number of optical-fields in SW output (3=tau+g+omega) + NF_AELW, & ! Number of optical-fields in LW output (3=tau+g+omega) + setaer, & ! Routine to compute aerosol radiative properties (tau,g,omega) + NSPC1 ! Number of species for vertically integrated aerosol optical-depth + use netcdf + + implicit none + + public rrtmgp_sw_aerosol_optics_init, rrtmgp_sw_aerosol_optics_run, rrtmgp_sw_aerosol_optics_finalize + +contains + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_aerosol_optics_init() + ! ######################################################################################### + subroutine rrtmgp_sw_aerosol_optics_init() + end subroutine rrtmgp_sw_aerosol_optics_init + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_aerosol_optics_run() + ! ######################################################################################### +!! \section arg_table_rrtmgp_sw_aerosol_optics_run +!! \htmlinclude rrtmgp_sw_aerosol_optics_run.html +!! + subroutine rrtmgp_sw_aerosol_optics_run(doSWrad, nCol, nLev, nTracer, nTracerAer, nDay, & + idxday, p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, & + lw_gas_props, sw_gas_props, aerodp, sw_optical_props_aerosol, errmsg, errflg ) + + ! Inputs + logical, intent(in) :: & + doSWrad ! Logical flag for shortwave radiation call + integer, intent(in) :: & + nCol, & ! Number of horizontal grid points + nDay, & ! Number of daylit points + nLev, & ! Number of vertical layers + nTracer, & ! Number of tracers + nTracerAer ! Number of aerosol tracers + integer,intent(in),dimension(nCol) :: & + idxday ! Indices for daylit points. + real(kind_phys), dimension(nCol), intent(in) :: & + lon, & ! Longitude + lat, & ! Latitude + lsmask ! Land/sea/sea-ice mask + real(kind_phys), dimension(nCol,Nlev),intent(in) :: & + p_lay, & ! Pressure @ layer-centers (Pa) + tv_lay, & ! Virtual-temperature @ layer-centers (K) + relhum, & ! Relative-humidity @ layer-centers + p_lk ! Exner function @ layer-centers (1) + real(kind_phys), dimension(nCol, nLev, nTracer),intent(in) :: & + tracer ! trace gas concentrations + real(kind_phys), dimension(nCol, nLev, nTracerAer),intent(in) :: & + aerfld ! aerosol input concentrations + real(kind_phys), dimension(nCol,nLev+1),intent(in) :: & + p_lev ! Pressure @ layer-interfaces (Pa) + type(ty_gas_optics_rrtmgp),intent(in) :: & + sw_gas_props ! RRTMGP DDT: spectral information for SW calculation + type(ty_gas_optics_rrtmgp),intent(in) :: & + lw_gas_props ! RRTMGP DDT: spectral information for LW calculation + + ! Outputs + real(kind_phys), dimension(nCol,NSPC1), intent(inout) :: & + aerodp ! Vertical integrated optical depth for various aerosol species + type(ty_optical_props_2str),intent(out) :: & + sw_optical_props_aerosol ! RRTMGP DDT: Longwave aerosol optical properties (tau) + integer, intent(out) :: & + errflg ! CCPP error flag + character(len=*), intent(out) :: & + errmsg ! CCPP error message + + ! Local variables + real(kind_phys), dimension(nCol, nLev, lw_gas_props%get_nband(), NF_AELW) :: & + aerosolslw ! + real(kind_phys), dimension(nCol, nLev, sw_gas_props%get_nband(), NF_AESW) :: & + aerosolssw, aerosolssw2 + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doSWrad) return + if (nDay .gt. 0) then + + ! Call module_radiation_aerosols::setaer(),to setup aerosols property profile + call setaer(p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, nCol, nLev, & + nLev+1, .true., .true., aerosolssw2, aerosolslw, aerodp) + + ! Store aerosol optical properties + ! SW. + ! For RRTMGP SW the bands are now ordered from [IR(band) -> nIR -> UV], in RRTMG the + ! band ordering was [nIR -> UV -> IR(band)] + aerosolssw(1:nCol,:,1,1) = aerosolssw2(1:nCol,:,sw_gas_props%get_nband(),1) + aerosolssw(1:nCol,:,1,2) = aerosolssw2(1:nCol,:,sw_gas_props%get_nband(),2) + aerosolssw(1:nCol,:,1,3) = aerosolssw2(1:nCol,:,sw_gas_props%get_nband(),3) + aerosolssw(1:nCol,:,2:sw_gas_props%get_nband(),1) = aerosolssw2(1:nCol,:,1:sw_gas_props%get_nband()-1,1) + aerosolssw(1:nCol,:,2:sw_gas_props%get_nband(),2) = aerosolssw2(1:nCol,:,1:sw_gas_props%get_nband()-1,2) + aerosolssw(1:nCol,:,2:sw_gas_props%get_nband(),3) = aerosolssw2(1:nCol,:,1:sw_gas_props%get_nband()-1,3) + + ! Allocate RRTMGP DDT: Aerosol optics [nCol,nlev,nBands] + call check_error_msg('rrtmgp_sw_aerosol_optics_run',sw_optical_props_aerosol%alloc_2str( & + nDay, nlev, sw_gas_props%get_band_lims_wavenumber())) + + ! Copy aerosol optical information to RRTMGP DDT + sw_optical_props_aerosol%tau = aerosolssw(idxday(1:nday),:,:,1) + sw_optical_props_aerosol%ssa = aerosolssw(idxday(1:nday),:,:,2) + sw_optical_props_aerosol%g = aerosolssw(idxday(1:nday),:,:,3) + endif + + end subroutine rrtmgp_sw_aerosol_optics_run + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_aerosol_optics_finalize() + ! ######################################################################################### + subroutine rrtmgp_sw_aerosol_optics_finalize() + end subroutine rrtmgp_sw_aerosol_optics_finalize +end module rrtmgp_sw_aerosol_optics diff --git a/physics/rrtmgp_sw_aerosol_optics.meta b/physics/rrtmgp_sw_aerosol_optics.meta new file mode 100644 index 000000000..1aaabf4f1 --- /dev/null +++ b/physics/rrtmgp_sw_aerosol_optics.meta @@ -0,0 +1,199 @@ +[ccpp-arg-table] + name = rrtmgp_sw_aerosol_optics_run + type = scheme +[doSWrad] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[nTracer] + standard_name = number_of_tracers + long_name = number of tracers + units = count + dimensions = () + type = integer + intent = in + optional = F +[nTracerAer] + standard_name = number_of_aerosol_tracers_MG + long_name = number of aerosol tracers for Morrison Gettelman MP + units = count + dimensions = () + type = integer + intent = in + optional = F +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[idxday] + standard_name = daytime_points + long_name = daytime points + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure at vertical interface for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure at vertical layer for radiation calculation + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p_lk] + standard_name = dimensionless_exner_function_at_model_layers + long_name = dimensionless Exner function at model layer centers + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tv_lay] + standard_name = virtual_temperature + long_name = layer virtual temperature + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[relhum] + standard_name = relative_humidity + long_name = layer relative humidity + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lsmask] + standard_name = sea_land_ice_mask_real + long_name = landmask: sea/land/ice=0/1/2 + units = flag + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[tracer] + standard_name = chemical_tracers + long_name = chemical tracers + units = g g-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_tracers) + type = real + kind = kind_phys + intent = in + optional = F +[aerfld] + standard_name = aerosol_number_concentration_from_gocart_aerosol_climatology + long_name = GOCART aerosol climatology number concentration + units = kg-1? + dimensions = (horizontal_dimension,vertical_dimension,number_of_aerosol_tracers_MG) + type = real + kind = kind_phys + intent = in + optional = F +[lon] + standard_name = longitude + long_name = longitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lat] + standard_name = latitude + long_name = latitude + units = radians + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[lw_gas_props] + standard_name = coefficients_for_lw_gas_optics + long_name = DDT containing spectral information for RRTMGP LW radiation scheme + units = DDT + dimensions = () + intent = in + type = ty_gas_optics_rrtmgp + optional = F +[sw_gas_props] + standard_name = coefficients_for_sw_gas_optics + long_name = DDT containing spectral information for RRTMGP SW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[aerodp] + standard_name = atmosphere_optical_thickness_due_to_ambient_aerosol_particles + long_name = vertical integrated optical depth for various aerosol species + units = none + dimensions = (horizontal_dimension,number_of_species_for_aerosol_optical_depth) + type = real + kind = kind_phys + intent = inout + optional = F +[sw_optical_props_aerosol] + standard_name = shortwave_optical_properties_for_aerosols + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 new file mode 100644 index 000000000..79e439030 --- /dev/null +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -0,0 +1,370 @@ +module rrtmgp_sw_cloud_optics + use machine, only: kind_phys + use mo_rte_kind, only: wl + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_cloud_optics, only: ty_cloud_optics + use physparam, only: isubcsw, iovrsw + use mo_optical_props, only: ty_optical_props_2str + use mo_rrtmg_sw_cloud_optics, only: rrtmg_sw_cloud_optics + use rrtmgp_aux, only: check_error_msg + use netcdf + + implicit none + + public rrtmgp_sw_cloud_optics_init, rrtmgp_sw_cloud_optics_run, rrtmgp_sw_cloud_optics_finalize + +contains + ! ######################################################################################### + ! SUBROUTINE sw_cloud_optics_init + ! ######################################################################################### +!! \section arg_table_rrtmgp_sw_cloud_optics_init +!! \htmlinclude rrtmgp_lw_cloud_optics.html +!! + subroutine rrtmgp_sw_cloud_optics_init(cld_optics_scheme, nrghice, rrtmgp_root_dir, & + rrtmgp_sw_file_clouds, mpicomm, mpirank, mpiroot, sw_cloud_props, errmsg, errflg) + + ! Inputs + integer, intent(inout) :: & + nrghice ! Number of ice-roughness categories + integer, intent(in) :: & + cld_optics_scheme, & ! Cloud-optics scheme + mpicomm, & ! MPI communicator + mpirank, & ! Current MPI rank + mpiroot ! Master MPI rank + character(len=128),intent(in) :: & + rrtmgp_root_dir, & ! RTE-RRTMGP root directory + rrtmgp_sw_file_clouds ! RRTMGP file containing coefficients used to compute clouds optical properties + + ! Outputs + type(ty_cloud_optics),intent(out) :: & + sw_cloud_props ! RRTMGP DDT: shortwave spectral information + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error code + + ! Variables that will be passed to cloud_optics%load() + ! cld_optics_scheme = 1 + real(kind_phys) :: & + radliq_lwr, & ! Liquid particle size lower bound for LUT interpolation + radliq_upr, & ! Liquid particle size upper bound for LUT interpolation + radliq_fac, & ! Factor for calculating LUT interpolation indices for liquid + radice_lwr, & ! Ice particle size upper bound for LUT interpolation + radice_upr, & ! Ice particle size lower bound for LUT interpolation + radice_fac ! Factor for calculating LUT interpolation indices for ice + real(kind_phys), dimension(:,:), allocatable :: & + lut_extliq, & ! LUT shortwave liquid extinction coefficient + lut_ssaliq, & ! LUT shortwave liquid single scattering albedo + lut_asyliq, & ! LUT shortwave liquid asymmetry parameter + band_lims ! Beginning and ending wavenumber [cm -1] for each band + real(kind_phys), dimension(:,:,:), allocatable :: & + lut_extice, & ! LUT shortwave ice extinction coefficient + lut_ssaice, & ! LUT shortwave ice single scattering albedo + lut_asyice ! LUT shortwave ice asymmetry parameter + ! cld_optics_scheme = 2 + real(kind_phys), dimension(:), allocatable :: & + pade_sizereg_extliq, & ! Particle size regime boundaries for shortwave liquid extinction + ! coefficient for Pade interpolation + pade_sizereg_ssaliq, & ! Particle size regime boundaries for shortwave liquid single + ! scattering albedo for Pade interpolation + pade_sizereg_asyliq, & ! Particle size regime boundaries for shortwave liquid asymmetry + ! parameter for Pade interpolation + pade_sizereg_extice, & ! Particle size regime boundaries for shortwave ice extinction + ! coefficient for Pade interpolation + pade_sizereg_ssaice, & ! Particle size regime boundaries for shortwave ice single + ! scattering albedo for Pade interpolation + pade_sizereg_asyice ! Particle size regime boundaries for shortwave ice asymmetry + ! parameter for Pade interpolation + real(kind_phys), dimension(:,:,:), allocatable :: & + pade_extliq, & ! PADE coefficients for shortwave liquid extinction + pade_ssaliq, & ! PADE coefficients for shortwave liquid single scattering albedo + pade_asyliq ! PADE coefficients for shortwave liquid asymmetry parameter + real(kind_phys), dimension(:,:,:,:), allocatable :: & + pade_extice, & ! PADE coefficients for shortwave ice extinction + pade_ssaice, & ! PADE coefficients for shortwave ice single scattering albedo + pade_asyice ! PADE coefficients for shortwave ice asymmetry parameter + ! Dimensions + integer :: & + nrghice_fromfile, nBand, nSize_liq, nSize_ice, nSizereg,& + nCoeff_ext, nCoeff_ssa_g, nBound, nPairs + + ! Local variables + integer :: status,ncid,dimid,varID + character(len=264) :: sw_cloud_props_file + integer,parameter :: nrghice_default=2 + + ! Initialize + errmsg = '' + errflg = 0 + + if (cld_optics_scheme .eq. 0) return + + ! Filenames are set in the physics_nml + sw_cloud_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_sw_file_clouds) + + ! On master processor only... +! if (mpirank .eq. mpiroot) then + ! Open file + status = nf90_open(trim(sw_cloud_props_file), NF90_WRITE, ncid) + + ! Read dimensions + status = nf90_inq_dimid(ncid, 'nband', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nBand) + status = nf90_inq_dimid(ncid, 'nrghice', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nrghice_fromfile) + status = nf90_inq_dimid(ncid, 'nsize_liq', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nSize_liq) + status = nf90_inq_dimid(ncid, 'nsize_ice', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nSize_ice) + status = nf90_inq_dimid(ncid, 'nsizereg', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nSizereg) + status = nf90_inq_dimid(ncid, 'ncoeff_ext', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nCoeff_ext) + status = nf90_inq_dimid(ncid, 'ncoeff_ssa_g', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nCoeff_ssa_g) + status = nf90_inq_dimid(ncid, 'nbound', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nBound) + status = nf90_inq_dimid(ncid, 'pair', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nPairs) + + ! Has the number of ice-roughnesses to use been provided from the namelist? + ! If not provided, use default number of ice-roughness categories + if (nrghice .eq. 0) then + nrghice = nrghice_default + else + nrghice = nrghice_fromfile + ! If provided in the namelist, check to ensure that number of ice-roughness categories is feasible. + if (nrghice .gt. nrghice_fromfile) then + errmsg = 'Number of RRTMGP ice-roughness categories requested in namelist file is not allowed. Using default number of categories.' + nrghice = nrghice_default + endif + endif + + ! Allocate space for arrays + if (cld_optics_scheme .eq. 1) then + allocate(lut_extliq(nSize_liq, nBand)) + allocate(lut_ssaliq(nSize_liq, nBand)) + allocate(lut_asyliq(nSize_liq, nBand)) + allocate(lut_extice(nSize_ice, nBand, nrghice_fromfile)) + allocate(lut_ssaice(nSize_ice, nBand, nrghice_fromfile)) + allocate(lut_asyice(nSize_ice, nBand, nrghice_fromfile)) + endif + if (cld_optics_scheme .eq. 2) then + allocate(pade_extliq(nBand, nSizeReg, nCoeff_ext )) + allocate(pade_ssaliq(nBand, nSizeReg, nCoeff_ssa_g)) + allocate(pade_asyliq(nBand, nSizeReg, nCoeff_ssa_g)) + allocate(pade_extice(nBand, nSizeReg, nCoeff_ext, nrghice_fromfile)) + allocate(pade_ssaice(nBand, nSizeReg, nCoeff_ssa_g, nrghice_fromfile)) + allocate(pade_asyice(nBand, nSizeReg, nCoeff_ssa_g, nrghice_fromfile)) + allocate(pade_sizereg_extliq(nBound)) + allocate(pade_sizereg_ssaliq(nBound)) + allocate(pade_sizereg_asyliq(nBound)) + allocate(pade_sizereg_extice(nBound)) + allocate(pade_sizereg_ssaice(nBound)) + allocate(pade_sizereg_asyice(nBound)) + endif + allocate(band_lims(2,nBand)) + + ! Read in fields from file + if (cld_optics_scheme .eq. 1) then + write (*,*) 'Reading RRTMGP shortwave cloud data (LUT) ... ' + status = nf90_inq_varid(ncid,'radliq_lwr',varID) + status = nf90_get_var(ncid,varID,radliq_lwr) + status = nf90_inq_varid(ncid,'radliq_upr',varID) + status = nf90_get_var(ncid,varID,radliq_upr) + status = nf90_inq_varid(ncid,'radliq_fac',varID) + status = nf90_get_var(ncid,varID,radliq_fac) + status = nf90_inq_varid(ncid,'radice_lwr',varID) + status = nf90_get_var(ncid,varID,radice_lwr) + status = nf90_inq_varid(ncid,'radice_upr',varID) + status = nf90_get_var(ncid,varID,radice_upr) + status = nf90_inq_varid(ncid,'radice_fac',varID) + status = nf90_get_var(ncid,varID,radice_fac) + status = nf90_inq_varid(ncid,'lut_extliq',varID) + status = nf90_get_var(ncid,varID,lut_extliq) + status = nf90_inq_varid(ncid,'lut_ssaliq',varID) + status = nf90_get_var(ncid,varID,lut_ssaliq) + status = nf90_inq_varid(ncid,'lut_asyliq',varID) + status = nf90_get_var(ncid,varID,lut_asyliq) + status = nf90_inq_varid(ncid,'lut_extice',varID) + status = nf90_get_var(ncid,varID,lut_extice) + status = nf90_inq_varid(ncid,'lut_ssaice',varID) + status = nf90_get_var(ncid,varID,lut_ssaice) + status = nf90_inq_varid(ncid,'lut_asyice',varID) + status = nf90_get_var(ncid,varID,lut_asyice) + status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) + status = nf90_get_var(ncid,varID,band_lims) + endif + if (cld_optics_scheme .eq. 2) then + write (*,*) 'Reading RRTMGP shortwave cloud data (PADE) ... ' + status = nf90_inq_varid(ncid,'radliq_lwr',varID) + status = nf90_get_var(ncid,varID,radliq_lwr) + status = nf90_inq_varid(ncid,'radliq_upr',varID) + status = nf90_get_var(ncid,varID,radliq_upr) + status = nf90_inq_varid(ncid,'radliq_fac',varID) + status = nf90_get_var(ncid,varID,radliq_fac) + status = nf90_inq_varid(ncid,'radice_lwr',varID) + status = nf90_get_var(ncid,varID,radice_lwr) + status = nf90_inq_varid(ncid,'radice_upr',varID) + status = nf90_get_var(ncid,varID,radice_upr) + status = nf90_inq_varid(ncid,'radice_fac',varID) + status = nf90_get_var(ncid,varID,radice_fac) + status = nf90_inq_varid(ncid,'pade_extliq',varID) + status = nf90_get_var(ncid,varID,pade_extliq) + status = nf90_inq_varid(ncid,'pade_ssaliq',varID) + status = nf90_get_var(ncid,varID,pade_ssaliq) + status = nf90_inq_varid(ncid,'pade_asyliq',varID) + status = nf90_get_var(ncid,varID,pade_asyliq) + status = nf90_inq_varid(ncid,'pade_extice',varID) + status = nf90_get_var(ncid,varID,pade_extice) + status = nf90_inq_varid(ncid,'pade_ssaice',varID) + status = nf90_get_var(ncid,varID,pade_ssaice) + status = nf90_inq_varid(ncid,'pade_asyice',varID) + status = nf90_get_var(ncid,varID,pade_asyice) + status = nf90_inq_varid(ncid,'pade_sizreg_extliq',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_extliq) + status = nf90_inq_varid(ncid,'pade_sizreg_ssaliq',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_ssaliq) + status = nf90_inq_varid(ncid,'pade_sizreg_asyliq',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_asyliq) + status = nf90_inq_varid(ncid,'pade_sizreg_extice',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_extice) + status = nf90_inq_varid(ncid,'pade_sizreg_ssaice',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_ssaice) + status = nf90_inq_varid(ncid,'pade_sizreg_asyice',varID) + status = nf90_get_var(ncid,varID,pade_sizereg_asyice) + status = nf90_inq_varid(ncid,'bnd_limits_wavenumber',varID) + status = nf90_get_var(ncid,varID,band_lims) + endif + + ! Close file + status = nf90_close(ncid) +! endif + + ! Load tables data for RRTMGP cloud-optics + if (cld_optics_scheme .eq. 1) then + call check_error_msg('sw_cloud_optics_init',sw_cloud_props%load(band_lims, & + radliq_lwr, radliq_upr, radliq_fac, radice_lwr, radice_upr, radice_fac, & + lut_extliq, lut_ssaliq, lut_asyliq, lut_extice, lut_ssaice, lut_asyice)) + endif + if (cld_optics_scheme .eq. 2) then + call check_error_msg('sw_cloud_optics_init', sw_cloud_props%load(band_lims, & + pade_extliq, pade_ssaliq, pade_asyliq, pade_extice, pade_ssaice, pade_asyice,& + pade_sizereg_extliq, pade_sizereg_ssaliq, pade_sizereg_asyliq, & + pade_sizereg_extice, pade_sizereg_ssaice, pade_sizereg_asyice)) + endif + call check_error_msg('sw_cloud_optics_init',sw_cloud_props%set_ice_roughness(nrghice)) + end subroutine rrtmgp_sw_cloud_optics_init + + ! ######################################################################################### + ! SUBROTUINE rrtmgp_sw_cloud_optics_run() + ! ######################################################################################### +!! \section arg_table_rrtmgp_sw_cloud_optics_run +!! \htmlinclude rrtmgp_sw_cloud_optics.html +!! + subroutine rrtmgp_sw_cloud_optics_run(doSWrad, nCol, nLev, nDay, idxday, nrghice, & + cld_optics_scheme, cld_frac, cld_lwp, cld_reliq, cld_iwp, cld_reice, cld_swp, & + cld_resnow, cld_rwp, cld_rerain, sw_cloud_props, sw_gas_props, & + sw_optical_props_cloudsByBand, cldtausw, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + doSWrad ! Logical flag for shortwave radiation call + integer, intent(in) :: & + nCol, & ! Number of horizontal gridpoints + nLev, & ! Number of vertical levels + nday, & ! Number of daylit points. + nrghice, & ! Number of ice-roughness categories + cld_optics_scheme ! Cloud-optics scheme + integer,intent(in),dimension(ncol) :: & + idxday ! Indices for daylit points. + real(kind_phys), dimension(ncol,nLev),intent(in) :: & + cld_frac, & ! Total cloud fraction by layer + cld_lwp, & ! Cloud liquid water path + cld_reliq, & ! Cloud liquid effective radius + cld_iwp, & ! Cloud ice water path + cld_reice, & ! Cloud ice effective radius + cld_swp, & ! Cloud snow water path + cld_resnow, & ! Cloud snow effective radius + cld_rwp, & ! Cloud rain water path + cld_rerain ! Cloud rain effective radius + type(ty_cloud_optics),intent(in) :: & + sw_cloud_props ! RRTMGP DDT: shortwave cloud properties + type(ty_gas_optics_rrtmgp),intent(in) :: & + sw_gas_props ! RRTMGP DDT: shortwave K-distribution data + + ! Outputs + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error code + type(ty_optical_props_2str),intent(out) :: & + sw_optical_props_cloudsByBand ! RRTMGP DDT: Shortwave optical properties (cloudy atmosphere) + real(kind_phys), dimension(ncol,NLev), intent(out) :: & + cldtausw ! approx 10.mu band layer cloud optical depth + + ! Local variables + logical,dimension(nday,nLev) :: liqmask, icemask + real(kind_phys), dimension(nday,nLev,sw_gas_props%get_nband()) :: & + tau_cld, ssa_cld, asy_cld + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doSWrad) return + if (nDay .gt. 0) then + + ! Compute ice/liquid cloud masks, needed by rrtmgp_cloud_optics + liqmask = (cld_frac(idxday(1:nday),:) .gt. 0 .and. cld_lwp(idxday(1:nday),:) .gt. 0) + icemask = (cld_frac(idxday(1:nday),:) .gt. 0 .and. cld_iwp(idxday(1:nday),:) .gt. 0) + + ! Allocate space for RRTMGP DDTs containing cloud radiative properties + ! Cloud optics [nday,nLev,nBands] + call check_error_msg('rrtmgp_sw_cloud_optics_run',sw_optical_props_cloudsByBand%alloc_2str(& + nday, nLev, sw_gas_props%get_band_lims_wavenumber())) + sw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys + sw_optical_props_cloudsByBand%ssa(:,:,:) = 0._kind_phys + sw_optical_props_cloudsByBand%g(:,:,:) = 0._kind_phys + + ! Compute cloud-optics for RTE. + if (cld_optics_scheme .gt. 0) then + ! RRTMGP cloud-optics. + call check_error_msg('rrtmgp_sw_cloud_optics_run',sw_cloud_props%cloud_optics(& + cld_lwp(idxday(1:nday),:), & ! IN - Cloud liquid water path + cld_iwp(idxday(1:nday),:), & ! IN - Cloud ice water path + cld_reliq(idxday(1:nday),:), & ! IN - Cloud liquid effective radius + cld_reice(idxday(1:nday),:), & ! IN - Cloud ice effective radius + sw_optical_props_cloudsByBand)) ! OUT - RRTMGP DDT: Shortwave optical properties, + ! in each band (tau,ssa,g) + else + ! RRTMG cloud-optics + tau_cld(:,:,:) = 0._kind_phys + ssa_cld(:,:,:) = 0._kind_phys + asy_cld(:,:,:) = 0._kind_phys + if (any(cld_frac .gt. 0)) then + call rrtmg_sw_cloud_optics(nday, nLev, sw_gas_props%get_nband(), & + cld_lwp(idxday(1:nday),:), cld_reliq(idxday(1:nday),:), & + cld_iwp(idxday(1:nday),:), cld_reice(idxday(1:nday),:), & + cld_rwp(idxday(1:nday),:), cld_rerain(idxday(1:nday),:), & + cld_swp(idxday(1:nday),:), cld_resnow(idxday(1:nday),:), & + cld_frac(idxday(1:nday),:), tau_cld, ssa_cld, asy_cld) + endif + sw_optical_props_cloudsByBand%tau(:,:,:) = tau_cld + sw_optical_props_cloudsByBand%ssa(:,:,:) = ssa_cld + sw_optical_props_cloudsByBand%g(:,:,:) = asy_cld + endif + + ! All-sky SW optical depth ~0.55microns + cldtausw(idxday(1:nDay),:) = sw_optical_props_cloudsByBand%tau(:,:,11) + endif + + end subroutine rrtmgp_sw_cloud_optics_run + + ! ######################################################################################### + ! SUBROTUINE rrtmgp_sw_cloud_optics_finalize() + ! ######################################################################################### + subroutine rrtmgp_sw_cloud_optics_finalize() + end subroutine rrtmgp_sw_cloud_optics_finalize + +end module rrtmgp_sw_cloud_optics diff --git a/physics/rrtmgp_sw_cloud_optics.meta b/physics/rrtmgp_sw_cloud_optics.meta new file mode 100644 index 000000000..c60ae90d6 --- /dev/null +++ b/physics/rrtmgp_sw_cloud_optics.meta @@ -0,0 +1,278 @@ +[ccpp-arg-table] + name = rrtmgp_sw_cloud_optics_init + type = scheme +[cld_optics_scheme] + standard_name = rrtmgp_cloud_optics_flag + long_name = Flag to control which RRTMGP cloud-optics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[nrghice] + standard_name = number_of_rrtmgp_ice_roughness + long_name = number of ice-roughness categories in RRTMGP calculation + units = count + dimensions = () + type = integer + intent = inout + optional = F +[rrtmgp_root_dir] + standard_name = directory_for_rte_rrtmgp_source_code + long_name = directory for rte+rrtmgp source code + units = none + dimensions = () + type = character + intent = in + optional = F + kind = len=128 +[rrtmgp_sw_file_clouds] + standard_name = rrtmgp_coeff_sw_cloud_optics + long_name = file containing coefficients for RRTMGP SW cloud optics + units = none + dimensions = () + type = character + intent = in + optional = F + kind = len=128 +[mpirank] + standard_name = mpi_rank + long_name = current MPI rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpiroot] + standard_name = mpi_root + long_name = master MPI rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpicomm] + standard_name = mpi_comm + long_name = MPI communicator + units = index + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F +[sw_cloud_props] + standard_name = coefficients_for_sw_cloud_optics + long_name = DDT containing spectral information for RRTMGP SW radiation scheme + units = DDT + dimensions = () + type = ty_cloud_optics + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = rrtmgp_sw_cloud_optics_run + type = scheme +[doSWrad] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[cld_optics_scheme] + standard_name = rrtmgp_cloud_optics_flag + long_name = Flag to control which RRTMGP cloud-optics scheme + units = flag + dimensions = () + type = integer + intent = in + optional = F +[nrghice] + standard_name = number_of_rrtmgp_ice_roughness + long_name = number of ice-roughness categories in RRTMGP calculation + units = count + dimensions = () + type = integer + intent = in + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cld_lwp] + standard_name = cloud_liquid_water_path + long_name = layer cloud liquid water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cld_reliq] + standard_name = mean_effective_radius_for_liquid_cloud + long_name = mean effective radius for liquid cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cld_iwp] + standard_name = cloud_ice_water_path + long_name = layer cloud ice water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cld_reice] + standard_name = mean_effective_radius_for_ice_cloud + long_name = mean effective radius for ice cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cld_swp] + standard_name = cloud_snow_water_path + long_name = layer cloud snow water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cld_resnow] + standard_name = mean_effective_radius_for_snow_flake + long_name = mean effective radius for snow cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cld_rwp] + standard_name = cloud_rain_water_path + long_name = layer cloud rain water path + units = g m-2 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[cld_rerain] + standard_name = mean_effective_radius_for_rain_drop + long_name = mean effective radius for rain cloud + units = micron + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sw_cloud_props] + standard_name = coefficients_for_sw_cloud_optics + long_name = DDT containing spectral information for cloudy RRTMGP SW radiation scheme + units = DDT + dimensions = () + type = ty_cloud_optics + intent = in + optional = F +[sw_gas_props] + standard_name = coefficients_for_sw_gas_optics + long_name = DDT containing spectral information for RRTMGP SW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[idxday] + standard_name = daytime_points + long_name = daytime points + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[sw_optical_props_cloudsByBand] + standard_name = shortwave_optical_properties_for_cloudy_atmosphere_by_band + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + intent = out + optional = F +[cldtausw] + standard_name = RRTMGP_cloud_optical_depth_layers_at_0_55mu_band + long_name = approx .55mu band layer cloud optical depth + units = none + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 new file mode 100644 index 000000000..0c839afb2 --- /dev/null +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -0,0 +1,135 @@ +module rrtmgp_sw_cloud_sampling + use machine, only: kind_phys + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use physparam, only: isubcsw, iovrsw + use mo_optical_props, only: ty_optical_props_2str + use mo_cloud_sampling, only: sampled_mask_max_ran, sampled_mask_exp_ran, draw_samples + use mersenne_twister, only: random_setseed, random_number, random_stat + use rrtmgp_aux, only: check_error_msg + use netcdf + + implicit none + +contains + + ! ######################################################################################### + ! SUBROUTINE mcica_init + ! ######################################################################################### +!! \section arg_table_rrtmgp_sw_cloud_sampling_init +!! \htmlinclude rrtmgp_sw_cloud_sampling.html +!! + subroutine rrtmgp_sw_cloud_sampling_init(sw_gas_props, ipsdsw0) + ! Inputs + type(ty_gas_optics_rrtmgp),intent(in) :: & + sw_gas_props ! RRTMGP DDT: K-distribution data + ! Outputs + integer, intent(out) :: & + ipsdsw0 ! Initial permutation seed for McICA + + ! Set initial permutation seed for McICA, initially set to number of G-points + ipsdsw0 = sw_gas_props%get_ngpt() + + end subroutine rrtmgp_sw_cloud_sampling_init + + ! ######################################################################################### + ! SUBROTUINE rrtmgp_sw_cloud_sampling_run() + ! ######################################################################################### +!! \section arg_table_rrtmgp_sw_cloud_sampling_run +!! \htmlinclude rrtmgp_sw_cloud_sampling.html +!! + subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, ipsdsw0, idxday, & + icseed_sw, cld_frac, sw_gas_props, sw_optical_props_cloudsByBand, & + sw_optical_props_clouds, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + doSWrad ! Logical flag for shortwave radiation call + integer, intent(in) :: & + nCol, & ! Number of horizontal gridpoints + nDay, & ! Number of daylit points. + nLev, & ! Number of vertical layers + ipsdsw0 ! Initial permutation seed for McICA + integer,intent(in),dimension(ncol) :: & + idxday ! Indices for daylit points. + integer,intent(in),dimension(ncol) :: & + icseed_sw ! auxiliary special cloud related array when module + ! variable isubcsw=2, it provides permutation seed + ! for each column profile that are used for generating + ! random numbers. when isubcsw /=2, it will not be used. + real(kind_phys), dimension(ncol,nLev),intent(in) :: & + cld_frac ! Total cloud fraction by layer + type(ty_gas_optics_rrtmgp),intent(in) :: & + sw_gas_props ! RRTMGP DDT: K-distribution data + type(ty_optical_props_2str),intent(in) :: & + sw_optical_props_cloudsByBand ! RRTMGP DDT: Shortwave optical properties (cloudy atmosphere) + + ! Outputs + character(len=*), intent(out) :: & + errmsg ! Error message + integer, intent(out) :: & + errflg ! Error code + type(ty_optical_props_2str),intent(out) :: & + sw_optical_props_clouds ! RRTMGP DDT: Shortwave optical properties (cloudy atmosphere) + + ! Local variables + integer :: iCol + integer,dimension(ncol) :: ipseed_sw + type(random_stat) :: rng_stat + real(kind_phys), dimension(sw_gas_props%get_ngpt(),nLev,ncol) :: rng3D + real(kind_phys), dimension(sw_gas_props%get_ngpt()*nLev) :: rng1D + logical, dimension(ncol,nLev,sw_gas_props%get_ngpt()) :: cldfracMCICA + real(kind_phys), dimension(ncol,nLev) :: cld_frac_noSamp + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doSWrad) return + if (nDay .gt. 0) then + + ! Allocate space RRTMGP DDTs [nday,nLev,nGpt] + call check_error_msg('rrtmgp_sw_cloud_sampling_run',sw_optical_props_clouds%alloc_2str( & + nday, nLev, sw_gas_props)) + + ! Change random number seed value for each radiation invocation (isubcsw =1 or 2). + if(isubcsw == 1) then ! advance prescribed permutation seed + do iCol = 1, ncol + ipseed_sw(iCol) = ipsdsw0 + iCol + enddo + elseif (isubcsw == 2) then ! use input array of permutaion seeds + do iCol = 1, ncol + ipseed_sw(iCol) = icseed_sw(iCol) + enddo + endif + + ! Call McICA to generate subcolumns. + ! Call RNG. Mersennse Twister accepts 1D array, so loop over columns and collapse along G-points + ! and layers. ([nGpts,nLev,nColumn]-> [nGpts*nLev]*nColumn) + do iCol=1,ncol + call random_setseed(ipseed_sw(icol),rng_stat) + call random_number(rng1D,rng_stat) + rng3D(:,:,iCol) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) + enddo + + ! Call McICA + select case ( iovrsw ) + ! Maximumn-random + case(1) + call check_error_msg('rrtmgp_sw_cloud_sampling_run',sampled_mask_max_ran(rng3D,cld_frac,cldfracMCICA)) + end select + + ! Map band optical depth to each g-point using McICA + call check_error_msg('rrtmgp_sw_cloud_sampling_run',draw_samples(& + cldfracMCICA(idxday(1:nDay),:,:),sw_optical_props_cloudsByBand,sw_optical_props_clouds)) + + endif + + end subroutine rrtmgp_sw_cloud_sampling_run + + ! ######################################################################################### + ! SUBROTUINE rrtmgp_sw_cloud_sampling_finalize() + ! ######################################################################################### + subroutine rrtmgp_sw_cloud_sampling_finalize() + end subroutine rrtmgp_sw_cloud_sampling_finalize + +end module rrtmgp_sw_cloud_sampling diff --git a/physics/rrtmgp_sw_cloud_sampling.meta b/physics/rrtmgp_sw_cloud_sampling.meta new file mode 100644 index 000000000..3ad9073d5 --- /dev/null +++ b/physics/rrtmgp_sw_cloud_sampling.meta @@ -0,0 +1,130 @@ +[ccpp-arg-table] + name = rrtmgp_sw_cloud_sampling_init + type = scheme +[sw_gas_props] + standard_name = coefficients_for_sw_gas_optics + long_name = DDT containing spectral information for RRTMGP SW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[ipsdsw0] + standard_name = initial_permutation_seed_sw + long_name = initial seed for McICA SW + units = none + dimensions = () + type = integer + intent = out + optional = F + +###################################################### +[ccpp-arg-table] + name = rrtmgp_sw_cloud_sampling_run + type = scheme +[doSWrad] + standard_name = flag_to_calc_sw + long_name = logical flags for sw radiation calls + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[ipsdsw0] + standard_name = initial_permutation_seed_sw + long_name = initial seed for McICA SW + units = none + dimensions = () + type = integer + intent = in + optional = F +[idxday] + standard_name = daytime_points + long_name = daytime points + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[icseed_sw] + standard_name = seed_random_numbers_sw + long_name = seed for random number generation for shortwave radiation + units = none + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[cld_frac] + standard_name = total_cloud_fraction + long_name = layer total cloud fraction + units = frac + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sw_gas_props] + standard_name = coefficients_for_sw_gas_optics + long_name = DDT containing spectral information for RRTMGP SW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[sw_optical_props_cloudsByBand] + standard_name = shortwave_optical_properties_for_cloudy_atmosphere_by_band + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + intent = in + optional = F +[sw_optical_props_clouds] + standard_name = shortwave_optical_properties_for_cloudy_atmosphere + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + intent = out + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F \ No newline at end of file diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 new file mode 100644 index 000000000..7945f43fe --- /dev/null +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -0,0 +1,371 @@ +module rrtmgp_sw_gas_optics + use machine, only: kind_phys + use module_radiation_gases, only: NF_VGAS + use mo_rte_kind, only: wl + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_gas_concentrations, only: ty_gas_concs + use rrtmgp_aux, only: check_error_msg + use mo_optical_props, only: ty_optical_props_2str + use mo_compute_bc, only: compute_bc + use netcdf + + implicit none + +contains + + ! ######################################################################################### + ! SUBROUTINE sw_gas_optics_init + ! ######################################################################################### +!! \section arg_table_rrtmgp_sw_gas_optics_init +!! \htmlinclude rrtmgp_sw_gas_optics.html +!! + subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp_nGases, & + active_gases_array, mpicomm, mpirank, mpiroot, sw_gas_props, errmsg, errflg) + + ! Inputs + character(len=128),intent(in) :: & + rrtmgp_root_dir, & ! RTE-RRTMGP root directory + rrtmgp_sw_file_gas ! RRTMGP file containing coefficients used to compute gaseous optical properties + integer, intent(in) :: & + rrtmgp_nGases ! Number of trace gases active in RRTMGP + character(len=*),dimension(rrtmgp_nGases), intent(in) :: & + active_gases_array ! Character array containing trace gases to include in RRTMGP + integer,intent(in) :: & + mpicomm, & ! MPI communicator + mpirank, & ! Current MPI rank + mpiroot ! Master MPI rank + + ! Outputs + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error code + type(ty_gas_optics_rrtmgp),intent(out) :: & + sw_gas_props ! RRTMGP DDT: shortwave spectral information + + ! Variables that will be passed to gas_optics%load() + type(ty_gas_concs) :: & + gas_concentrations + integer, dimension(:), allocatable :: & + kminor_start_lower, & ! Starting index in the [1, nContributors] vector for a contributor + ! given by \"minor_gases_lower\" (lower atmosphere) + kminor_start_upper ! Starting index in the [1, nContributors] vector for a contributor + ! given by \"minor_gases_upper\" (upper atmosphere) + integer, dimension(:,:), allocatable :: & + band2gpt, & ! Beginning and ending gpoint for each band + minor_limits_gpt_lower, & ! Beginning and ending gpoint for each minor interval in lower atmosphere + minor_limits_gpt_upper ! Beginning and ending gpoint for each minor interval in upper atmosphere + integer, dimension(:,:,:), allocatable :: & + key_species ! Key species pair for each band + real(kind_phys) :: & + press_ref_trop, & ! Reference pressure separating the lower and upper atmosphere [Pa] + temp_ref_p, & ! Standard spectroscopic reference pressure [Pa] + temp_ref_t ! Standard spectroscopic reference temperature [K] + real(kind_phys), dimension(:), allocatable :: & + press_ref, & ! Pressures for reference atmosphere; press_ref(# reference layers) [Pa] + temp_ref, & ! Temperatures for reference atmosphere; temp_ref(# reference layers) [K] + solar_source ! Stored solar source function from original RRTM + real(kind_phys), dimension(:,:), allocatable :: & + band_lims ! Beginning and ending wavenumber [cm -1] for each band + + real(kind_phys), dimension(:,:,:), allocatable :: & + vmr_ref, & ! Volume mixing ratios for reference atmosphere + kminor_lower, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to + ! [nTemp x nEta x nContributors] array) + kminor_upper, & ! (transformed from [nTemp x nEta x nGpt x nAbsorbers] array to + ! [nTemp x nEta x nContributors] array) + rayl_lower, & ! Stored coefficients due to rayleigh scattering contribution + rayl_upper ! Stored coefficients due to rayleigh scattering contribution + real(kind_phys), dimension(:,:,:,:), allocatable :: & + kmajor ! Stored absorption coefficients due to major absorbing gases + character(len=32), dimension(:), allocatable :: & + gas_names, & ! Names of absorbing gases + gas_minor, & ! Name of absorbing minor gas + identifier_minor, & ! Unique string identifying minor gas + minor_gases_lower, & ! Names of minor absorbing gases in lower atmosphere + minor_gases_upper, & ! Names of minor absorbing gases in upper atmosphere + scaling_gas_lower, & ! Absorption also depends on the concentration of this gas + scaling_gas_upper ! Absorption also depends on the concentration of this gas + logical(wl), dimension(:), allocatable :: & + minor_scales_with_density_lower, & ! Density scaling is applied to minor absorption coefficients + minor_scales_with_density_upper, & ! Density scaling is applied to minor absorption coefficients + scale_by_complement_lower, & ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) + scale_by_complement_upper ! Absorption is scaled by concentration of scaling_gas (F) or its complement (T) + ! Dimensions + integer :: & + ntemps, npress, ngpts, nabsorbers, nextrabsorbers, & + nminorabsorbers, nmixingfracs, nlayers, nbnds, npairs, & + nminor_absorber_intervals_lower, nminor_absorber_intervals_upper, & + ncontributors_lower, ncontributors_upper + + ! Local variables + integer :: status, ncid, dimid, varID, iGas + integer,dimension(:),allocatable :: temp1, temp2, temp3, temp4 + character(len=264) :: sw_gas_props_file + + ! Initialize + errmsg = '' + errflg = 0 + + ! Filenames are set in the gphysics_nml + sw_gas_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_sw_file_gas) + + ! Read dimensions for k-distribution fields (only on master processor(0)) +! if (mpirank .eq. mpiroot) then + ! Open file + status = nf90_open(trim(sw_gas_props_file), NF90_WRITE, ncid) + + ! Read dimensions for k-distribution fields + status = nf90_inq_dimid(ncid, 'temperature', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=ntemps) + status = nf90_inq_dimid(ncid, 'pressure', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=npress) + status = nf90_inq_dimid(ncid, 'absorber', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nabsorbers) + status = nf90_inq_dimid(ncid, 'minor_absorber',dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nminorabsorbers) + status = nf90_inq_dimid(ncid, 'absorber_ext', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nextrabsorbers) + status = nf90_inq_dimid(ncid, 'mixing_fraction', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nmixingfracs) + status = nf90_inq_dimid(ncid, 'atmos_layer', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nlayers) + status = nf90_inq_dimid(ncid, 'bnd', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nbnds) + status = nf90_inq_dimid(ncid, 'gpt', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=ngpts) + status = nf90_inq_dimid(ncid, 'pair', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=npairs) + status = nf90_inq_dimid(ncid, 'contributors_lower',dimid) + status = nf90_inquire_dimension(ncid, dimid, len=ncontributors_lower) + status = nf90_inq_dimid(ncid, 'contributors_upper', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=ncontributors_upper) + status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_lower', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nminor_absorber_intervals_lower) + status = nf90_inq_dimid(ncid, 'minor_absorber_intervals_upper', dimid) + status = nf90_inquire_dimension(ncid, dimid, len=nminor_absorber_intervals_upper) + + ! Allocate space for arrays + allocate(gas_names(nabsorbers)) + allocate(scaling_gas_lower(nminor_absorber_intervals_lower)) + allocate(scaling_gas_upper(nminor_absorber_intervals_upper)) + allocate(gas_minor(nminorabsorbers)) + allocate(identifier_minor(nminorabsorbers)) + allocate(minor_gases_lower(nminor_absorber_intervals_lower)) + allocate(minor_gases_upper(nminor_absorber_intervals_upper)) + allocate(minor_limits_gpt_lower(npairs,nminor_absorber_intervals_lower)) + allocate(minor_limits_gpt_upper(npairs,nminor_absorber_intervals_upper)) + allocate(band2gpt(2,nbnds)) + allocate(key_species(2,nlayers,nbnds)) + allocate(band_lims(2,nbnds)) + allocate(press_ref(npress)) + allocate(temp_ref(ntemps)) + allocate(vmr_ref(nlayers, nextrabsorbers, ntemps)) + allocate(kminor_lower(ncontributors_lower, nmixingfracs, ntemps)) + allocate(kmajor(ngpts, nmixingfracs, npress+1, ntemps)) + allocate(kminor_start_lower(nminor_absorber_intervals_lower)) + allocate(kminor_upper(ncontributors_upper, nmixingfracs, ntemps)) + allocate(kminor_start_upper(nminor_absorber_intervals_upper)) + allocate(minor_scales_with_density_lower(nminor_absorber_intervals_lower)) + allocate(minor_scales_with_density_upper(nminor_absorber_intervals_upper)) + allocate(scale_by_complement_lower(nminor_absorber_intervals_lower)) + allocate(scale_by_complement_upper(nminor_absorber_intervals_upper)) + allocate(rayl_upper(ngpts, nmixingfracs, ntemps)) + allocate(rayl_lower(ngpts, nmixingfracs, ntemps)) + allocate(solar_source(ngpts)) + allocate(temp1(nminor_absorber_intervals_lower)) + allocate(temp2(nminor_absorber_intervals_upper)) + allocate(temp3(nminor_absorber_intervals_lower)) + allocate(temp4(nminor_absorber_intervals_upper)) + + ! Read in fields from file + if (mpirank==mpiroot) write (*,*) 'Reading RRTMGP shortwave k-distribution data ... ' + status = nf90_inq_varid(ncid, 'gas_names', varID) + status = nf90_get_var( ncid, varID, gas_names) + status = nf90_inq_varid(ncid, 'scaling_gas_lower', varID) + status = nf90_get_var( ncid, varID, scaling_gas_lower) + status = nf90_inq_varid(ncid, 'scaling_gas_upper', varID) + status = nf90_get_var( ncid, varID, scaling_gas_upper) + status = nf90_inq_varid(ncid, 'gas_minor', varID) + status = nf90_get_var( ncid, varID, gas_minor) + status = nf90_inq_varid(ncid, 'identifier_minor', varID) + status = nf90_get_var( ncid, varID, identifier_minor) + status = nf90_inq_varid(ncid, 'minor_gases_lower', varID) + status = nf90_get_var( ncid, varID, minor_gases_lower) + status = nf90_inq_varid(ncid, 'minor_gases_upper', varID) + status = nf90_get_var( ncid, varID, minor_gases_upper) + status = nf90_inq_varid(ncid, 'minor_limits_gpt_lower', varID) + status = nf90_get_var( ncid, varID, minor_limits_gpt_lower) + status = nf90_inq_varid(ncid, 'minor_limits_gpt_upper', varID) + status = nf90_get_var( ncid, varID, minor_limits_gpt_upper) + status = nf90_inq_varid(ncid, 'bnd_limits_gpt', varID) + status = nf90_get_var( ncid, varID, band2gpt) + status = nf90_inq_varid(ncid, 'key_species', varID) + status = nf90_get_var( ncid, varID, key_species) + status = nf90_inq_varid(ncid,'bnd_limits_wavenumber', varID) + status = nf90_get_var( ncid, varID, band_lims) + status = nf90_inq_varid(ncid, 'press_ref', varID) + status = nf90_get_var( ncid, varID, press_ref) + status = nf90_inq_varid(ncid, 'temp_ref', varID) + status = nf90_get_var( ncid, varID, temp_ref) + status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_P', varID) + status = nf90_get_var( ncid, varID, temp_ref_p) + status = nf90_inq_varid(ncid, 'absorption_coefficient_ref_T', varID) + status = nf90_get_var( ncid, varID, temp_ref_t) + status = nf90_inq_varid(ncid, 'press_ref_trop', varID) + status = nf90_get_var( ncid, varID, press_ref_trop) + status = nf90_inq_varid(ncid, 'kminor_lower', varID) + status = nf90_get_var( ncid, varID, kminor_lower) + status = nf90_inq_varid(ncid, 'kminor_upper', varID) + status = nf90_get_var( ncid, varID, kminor_upper) + status = nf90_inq_varid(ncid, 'vmr_ref', varID) + status = nf90_get_var( ncid, varID, vmr_ref) + status = nf90_inq_varid(ncid, 'kmajor', varID) + status = nf90_get_var( ncid, varID, kmajor) + status = nf90_inq_varid(ncid, 'kminor_start_lower', varID) + status = nf90_get_var( ncid, varID, kminor_start_lower) + status = nf90_inq_varid(ncid, 'kminor_start_upper', varID) + status = nf90_get_var( ncid, varID, kminor_start_upper) + status = nf90_inq_varid(ncid, 'solar_source', varID) + status = nf90_get_var( ncid, varID, solar_source) + status = nf90_inq_varid(ncid, 'rayl_lower', varID) + status = nf90_get_var( ncid, varID, rayl_lower) + status = nf90_inq_varid(ncid, 'rayl_upper', varID) + status = nf90_get_var( ncid, varID, rayl_upper) + + ! Logical fields are read in as integers and then converted to logicals. + status = nf90_inq_varid(ncid,'minor_scales_with_density_lower', varID) + status = nf90_get_var( ncid, varID,temp1) + minor_scales_with_density_lower(:) = .false. + where(temp1 .eq. 1) minor_scales_with_density_lower(:) = .true. + status = nf90_inq_varid(ncid,'minor_scales_with_density_upper', varID) + status = nf90_get_var( ncid, varID,temp2) + minor_scales_with_density_upper(:) = .false. + where(temp2 .eq. 1) minor_scales_with_density_upper(:) = .true. + status = nf90_inq_varid(ncid,'scale_by_complement_lower', varID) + status = nf90_get_var( ncid, varID,temp3) + scale_by_complement_lower(:) = .false. + where(temp3 .eq. 1) scale_by_complement_lower(:) = .true. + status = nf90_inq_varid(ncid,'scale_by_complement_upper', varID) + status = nf90_get_var( ncid, varID,temp4) + scale_by_complement_upper(:) = .false. + where(temp4 .eq. 1) scale_by_complement_upper(:) = .true. + + ! Close + status = nf90_close(ncid) +! endif + + + ! Initialize gas concentrations and gas optics class + call check_error_msg('sw_gas_optics_init',gas_concentrations%init(active_gases_array)) + call check_error_msg('sw_gas_optics_init',sw_gas_props%load(gas_concentrations, gas_names, & + key_species, band2gpt, band_lims, press_ref, press_ref_trop, temp_ref, temp_ref_p, & + temp_ref_t, vmr_ref, kmajor, kminor_lower, kminor_upper, gas_minor, identifier_minor, & + minor_gases_lower, minor_gases_upper, minor_limits_gpt_lower,minor_limits_gpt_upper, & + minor_scales_with_density_lower, minor_scales_with_density_upper, scaling_gas_lower, & + scaling_gas_upper, scale_by_complement_lower, scale_by_complement_upper, & + kminor_start_lower, kminor_start_upper, solar_source, rayl_lower, rayl_upper)) + + end subroutine rrtmgp_sw_gas_optics_init + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_gas_optics_run + ! ######################################################################################### +!! \section arg_table_rrtmgp_sw_gas_optics_run +!! \htmlinclude rrtmgp_sw_gas_optics.html +!! + subroutine rrtmgp_sw_gas_optics_run(doSWrad, nCol, nLev, nday, idxday, sw_gas_props, p_lay,& + p_lev, toa_src_sw, t_lay, t_lev, gas_concentrations, solcon, rrtmgp_nGases, & + active_gases_array, sw_optical_props_clrsky, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + doSWrad ! Flag to calculate SW irradiances + integer,intent(in) :: & + nDay, & ! Number of daylit points. + nCol, & ! Number of horizontal points + nLev ! Number of vertical levels + integer,intent(in),dimension(ncol) :: & + idxday ! Indices for daylit points. + type(ty_gas_optics_rrtmgp),intent(in) :: & + sw_gas_props ! RRTMGP DDT: spectral information for RRTMGP SW radiation scheme + real(kind_phys), dimension(ncol,nLev), intent(in) :: & + p_lay, & ! Pressure @ model layer-centers (hPa) + t_lay ! Temperature (K) + real(kind_phys), dimension(ncol,nLev+1), intent(in) :: & + p_lev, & ! Pressure @ model layer-interfaces (hPa) + t_lev ! Temperature @ model levels + type(ty_gas_concs),intent(in) :: & + gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) + real(kind_phys), intent(in) :: & + solcon ! Solar constant + integer, intent(in) :: & + rrtmgp_nGases ! Number of trace gases active in RRTMGP + character(len=*),dimension(rrtmgp_nGases), intent(in) :: & + active_gases_array ! Character array containing trace gases to include in RRTMGP + + ! Output + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error code + type(ty_optical_props_2str),intent(out) :: & + sw_optical_props_clrsky ! RRTMGP DDT: clear-sky shortwave optical properties, spectral (tau,ssa,g) + real(kind_phys), dimension(ncol,sw_gas_props%get_ngpt()), intent(out) :: & + toa_src_sw ! TOA incident spectral flux (W/m2) + + ! Local variables + integer :: ij,iGas + real(kind_phys), dimension(ncol,nLev) :: vmrTemp + real(kind_phys), dimension(nday,sw_gas_props%get_ngpt()) :: toa_src_sw_temp + type(ty_gas_concs) :: & + gas_concentrations_daylit ! RRTMGP DDT: trace gas concentrations (vmr) + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doSWrad) return + + if (nDay .gt. 0) then + ! Allocate space + call check_error_msg('rrtmgp_sw_gas_optics_run',sw_optical_props_clrsky%alloc_2str(nday, nLev, sw_gas_props)) + + ! Initialize gas concentrations and gas optics class + call check_error_msg('rrtmgp_sw_rte_run',gas_concentrations_daylit%init(active_gases_array)) + + ! Subset the gas concentrations, only need daylit points. + do iGas=1,rrtmgp_nGases + call check_error_msg('rrtmgp_sw_rte_run',& + gas_concentrations%get_vmr(trim(active_gases_array(iGas)),vmrTemp)) + call check_error_msg('rrtmgp_sw_rte_run',& + gas_concentrations_daylit%set_vmr(trim(active_gases_array(iGas)),vmrTemp(idxday(1:nday),:))) + enddo + + ! Gas-optics + call check_error_msg('rrtmgp_sw_gas_optics_run',sw_gas_props%gas_optics(& + p_lay(idxday(1:nday),:), & ! IN - Pressure @ layer-centers (Pa) + p_lev(idxday(1:nday),:), & ! IN - Pressure @ layer-interfaces (Pa) + t_lay(idxday(1:nday),:), & ! IN - Temperature @ layer-centers (K) + gas_concentrations_daylit, & ! IN - RRTMGP DDT: trace gas volumne mixing-ratios + sw_optical_props_clrsky, & ! OUT - RRTMGP DDT: Shortwave optical properties, by + ! spectral point (tau,ssa,g) + toa_src_sw_temp)) ! OUT - TOA incident shortwave radiation (spectral) + toa_src_sw(idxday(1:nday),:) = toa_src_sw_temp + ! Scale incident flux + do ij=1,nday + toa_src_sw(idxday(ij),:) = toa_src_sw(idxday(ij),:)*solcon/ & + sum(toa_src_sw(idxday(ij),:)) + enddo + endif + + end subroutine rrtmgp_sw_gas_optics_run + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_gas_optics_finalize + ! ######################################################################################### + subroutine rrtmgp_sw_gas_optics_finalize() + end subroutine rrtmgp_sw_gas_optics_finalize + +end module rrtmgp_sw_gas_optics + diff --git a/physics/rrtmgp_sw_gas_optics.meta b/physics/rrtmgp_sw_gas_optics.meta new file mode 100644 index 000000000..fc8e72a9a --- /dev/null +++ b/physics/rrtmgp_sw_gas_optics.meta @@ -0,0 +1,244 @@ +[ccpp-arg-table] + name = rrtmgp_sw_gas_optics_init + type = scheme +[rrtmgp_root_dir] + standard_name = directory_for_rte_rrtmgp_source_code + long_name = directory for rte+rrtmgp source code + units = none + dimensions = () + type = character + intent = in + optional = F + kind = len=128 +[rrtmgp_sw_file_gas] + standard_name = rrtmgp_kdistribution_sw + long_name = file containing RRTMGP SW k-distribution + units = none + dimensions = () + type = character + intent = in + optional = F + kind = len=128 +[rrtmgp_nGases] + standard_name = number_of_active_gases_used_by_RRTMGP + long_name = number of gases available used by RRTMGP + units = count + dimensions = () + type = integer + intent = in + optional = F +[active_gases_array] + standard_name = list_of_active_gases_used_by_RRTMGP + long_name = list of active gases used by RRTMGP + units = none + dimensions = (number_of_active_gases_used_by_RRTMGP) + type = character + kind = len=* + intent = in + optional = F +[mpirank] + standard_name = mpi_rank + long_name = current MPI rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpiroot] + standard_name = mpi_root + long_name = master MPI rank + units = index + dimensions = () + type = integer + intent = in + optional = F +[mpicomm] + standard_name = mpi_comm + long_name = MPI communicator + units = index + dimensions = () + type = integer + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F +[sw_gas_props] + standard_name = coefficients_for_sw_gas_optics + long_name = DDT containing spectral information for RRTMGP SW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = out + optional = F + +######################################################################## +[ccpp-arg-table] + name = rrtmgp_sw_gas_optics_run + type = scheme +[doSWrad] + standard_name = flag_to_calc_sw + long_name = flag to calculate SW irradiances + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[idxday] + standard_name = daytime_points + long_name = daytime points + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[sw_gas_props] + standard_name = coefficients_for_sw_gas_optics + long_name = DDT containing spectral information for RRTMGP SW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure layer + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure level + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[t_lay] + standard_name = air_temperature_at_layer_for_RRTMGP + long_name = air temperature layer + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[t_lev] + standard_name = air_temperature_at_interface_for_RRTMGP + long_name = air temperature level + units = K + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[toa_src_sw] + standard_name = toa_incident_sw_flux_by_spectral_point + long_name = TOA shortwave incident flux at each spectral points + units = W m-2 + dimensions = (horizontal_dimension,number_of_sw_spectral_points_rrtmgp) + type = real + kind = kind_phys + intent = out + optional = F +[gas_concentrations] + standard_name = Gas_concentrations_for_RRTMGP_suite + long_name = DDT containing gas concentrations for RRTMGP radiation scheme + units = DDT + dimensions = () + type = ty_gas_concs + intent = in + optional = F +[solcon] + standard_name = solar_constant + long_name = solar constant + units = W m-2 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F +[rrtmgp_nGases] + standard_name = number_of_active_gases_used_by_RRTMGP + long_name = number of gases available used by RRTMGP + units = count + dimensions = () + type = integer + intent = in + optional = F +[active_gases_array] + standard_name = list_of_active_gases_used_by_RRTMGP + long_name = list of active gases used by RRTMGP + units = none + dimensions = (number_of_active_gases_used_by_RRTMGP) + type = character + kind = len=* + intent = in + optional = F +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F +[sw_optical_props_clrsky] + standard_name = shortwave_optical_properties_for_clear_sky + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + intent = out + optional = F diff --git a/physics/rrtmgp_sw_rte.F90 b/physics/rrtmgp_sw_rte.F90 new file mode 100644 index 000000000..98f95a1bd --- /dev/null +++ b/physics/rrtmgp_sw_rte.F90 @@ -0,0 +1,215 @@ +module rrtmgp_sw_rte + use machine, only: kind_phys + use mo_rte_kind, only: wl + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp + use mo_cloud_optics, only: ty_cloud_optics + use mo_optical_props, only: ty_optical_props_2str + use mo_rte_sw, only: rte_sw + use mo_gas_concentrations, only: ty_gas_concs + use mo_fluxes_byband, only: ty_fluxes_byband + use module_radsw_parameters, only: cmpfsw_type + use rrtmgp_aux, only: check_error_msg + + implicit none + + public rrtmgp_sw_rte_init, rrtmgp_sw_rte_run, rrtmgp_sw_rte_finalize + +contains + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_rte_init + ! ######################################################################################### + subroutine rrtmgp_sw_rte_init() + end subroutine rrtmgp_sw_rte_init + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_rte_run + ! ######################################################################################### +!! \section arg_table_rrtmgp_sw_rte_run +!! \htmlinclude rrtmgp_sw_rte.html +!! + subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t_lay, & + p_lev, sw_gas_props, sw_optical_props_clrsky, sfc_alb_nir_dir, sfc_alb_nir_dif, & + sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, toa_src_sw, sw_optical_props_clouds, & + sw_optical_props_aerosol, rrtmgp_nGases, active_gases_array, scmpsw, fluxswUP_allsky, & + fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, hswb, errmsg, errflg) + + ! Inputs + logical, intent(in) :: & + doSWrad ! Flag to calculate SW irradiances + integer, intent(in) :: & + nCol, & ! Number of horizontal gridpoints + nday, & ! Number of daytime points + nLev ! Number of vertical levels + integer, intent(in), dimension(ncol) :: & + idxday ! Index array for daytime points + real(kind_phys),intent(in), dimension(ncol) :: & + coszen ! Cosize of SZA + real(kind_phys), dimension(ncol,NLev), intent(in) :: & + p_lay, & ! Pressure @ model layer-centers (Pa) + t_lay ! Temperature (K) + real(kind_phys), dimension(ncol,NLev+1), intent(in) :: & + p_lev ! Pressure @ model layer-interfaces (Pa) + type(ty_gas_optics_rrtmgp),intent(in) :: & + sw_gas_props ! RRTMGP DDT: SW spectral information + type(ty_optical_props_2str),intent(inout) :: & + sw_optical_props_clrsky ! RRTMGP DDT: shortwave clear-sky radiative properties + type(ty_optical_props_2str),intent(in) :: & + sw_optical_props_clouds, & ! RRTMGP DDT: shortwave cloud radiative properties + sw_optical_props_aerosol ! RRTMGP DDT: shortwave aerosol radiative properties + real(kind_phys), dimension(sw_gas_props%get_nband(),ncol), intent(in) :: & + sfc_alb_nir_dir, & ! Surface albedo (direct) + sfc_alb_nir_dif, & ! Surface albedo (diffuse) + sfc_alb_uvvis_dir, & ! Surface albedo (direct) + sfc_alb_uvvis_dif ! Surface albedo (diffuse) + real(kind_phys), dimension(ncol,sw_gas_props%get_ngpt()), intent(in) :: & + toa_src_sw ! TOA incident spectral flux (W/m2) + integer, intent(in) :: & + rrtmgp_nGases ! Number of trace gases active in RRTMGP + character(len=*),dimension(rrtmgp_nGases), intent(in) :: & + active_gases_array ! Character array containing trace gases to include in RRTMGP + + ! Inputs (optional) (NOTE. We only need the optional arguments to know what fluxes to output, HR's are computed later) + real(kind_phys), dimension(ncol,NLev,sw_gas_props%get_nband()), intent(inout), optional :: & + hswb ! All-sky heating rate, by band (K/sec) + + ! Outputs + character(len=*), intent(out) :: & + errmsg ! CCPP error message + integer, intent(out) :: & + errflg ! CCPP error flag + real(kind_phys), dimension(ncol,NLev+1), intent(inout) :: & + fluxswUP_allsky, & ! RRTMGP upward all-sky flux profiles (W/m2) + fluxswDOWN_allsky, & ! RRTMGP downward all-sky flux profiles (W/m2) + fluxswUP_clrsky, & ! RRTMGP upward clear-sky flux profiles (W/m2) + fluxswDOWN_clrsky ! RRTMGP downward clear-sky flux profiles (W/m2) + + ! Outputs (optional) + type(cmpfsw_type), dimension(ncol), intent(inout),optional :: & + scmpsw ! 2D surface fluxes, components: + ! uvbfc - total sky downward uv-b flux (W/m2) + ! uvbf0 - clear sky downward uv-b flux (W/m2) + ! nirbm - downward nir direct beam flux (W/m2) + ! nirdf - downward nir diffused flux (W/m2) + ! visbm - downward uv+vis direct beam flux (W/m2) + ! visdf - downward uv+vis diffused flux (W/m2) + + ! Local variables + real(kind_phys), dimension(sw_gas_props%get_nband(),nday) :: & + sfc_alb_dir,sfc_alb_dif + type(ty_fluxes_byband) :: & + flux_allsky, & ! All-sky flux (W/m2) + flux_clrsky ! Clear-sky flux (W/m2) + real(kind_phys), dimension(nday,NLev+1,sw_gas_props%get_nband()),target :: & + fluxSW_up_allsky, fluxSW_up_clrsky, fluxSW_dn_allsky, fluxSW_dn_clrsky, fluxSW_dn_dir_allsky + real(kind_phys), dimension(ncol,NLev) :: vmrTemp + logical :: l_AllSky_HR_byband=.false., l_scmpsw=.false., top_at_1 + integer :: iGas,iSFC,iTOA,iBand + + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 + + if (.not. doSWrad) return + + ! Initialize output fluxes + fluxswUP_allsky(:,:) = 0._kind_phys + fluxswDOWN_allsky(:,:) = 0._kind_phys + fluxswUP_clrsky(:,:) = 0._kind_phys + fluxswDOWN_clrsky(:,:) = 0._kind_phys + + if (nDay .gt. 0) then + + ! Vertical ordering? + top_at_1 = (p_lev(1,1) .lt. p_lev(1, NLev)) + if (top_at_1) then + iSFC = NLev+1 + iTOA = 1 + else + iSFC = 1 + iTOA = NLev+1 + endif + + ! Are any optional outputs requested? Need to know now to compute correct fluxes. + l_AllSky_HR_byband = present(hswb) + l_scmpsw = present(scmpsw) + if ( l_scmpsw ) then + scmpsw = cmpfsw_type (0., 0., 0., 0., 0., 0.) + endif + + ! Initialize RRTMGP DDT containing 2D(3D) fluxes + fluxSW_up_allsky(:,:,:) = 0._kind_phys + fluxSW_dn_allsky(:,:,:) = 0._kind_phys + fluxSW_dn_dir_allsky(:,:,:) = 0._kind_phys + fluxSW_up_clrsky(:,:,:) = 0._kind_phys + fluxSW_dn_clrsky(:,:,:) = 0._kind_phys + flux_allsky%bnd_flux_up => fluxSW_up_allsky + flux_allsky%bnd_flux_dn => fluxSW_dn_allsky + flux_allsky%bnd_flux_dn_dir => fluxSW_dn_dir_allsky + flux_clrsky%bnd_flux_up => fluxSW_up_clrsky + flux_clrsky%bnd_flux_dn => fluxSW_dn_clrsky + + ! *Note* Legacy RRTMG code. May need to revisit + do iBand=1,sw_gas_props%get_nband() + if (iBand .lt. 10) then + sfc_alb_dir(iBand,:) = sfc_alb_nir_dir(iBand,idxday(1:nday)) + sfc_alb_dif(iBand,:) = sfc_alb_nir_dif(iBand,idxday(1:nday)) + endif + if (iBand .eq. 10) then + sfc_alb_dir(iBand,:) = 0.5_kind_phys*(sfc_alb_nir_dir(iBand,idxday(1:nday)) + sfc_alb_uvvis_dir(iBand,idxday(1:nday))) + sfc_alb_dif(iBand,:) = 0.5_kind_phys*(sfc_alb_nir_dif(iBand,idxday(1:nday)) + sfc_alb_uvvis_dif(iBand,idxday(1:nday))) + endif + if (iBand .gt. 10) then + sfc_alb_dir(iBand,:) = sfc_alb_uvvis_dir(iBand,idxday(1:nday)) + sfc_alb_dif(iBand,:) = sfc_alb_uvvis_dif(iBand,idxday(1:nday)) + endif + enddo + + ! Compute clear-sky fluxes (if requested) + ! Clear-sky fluxes (gas+aerosol) + call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_aerosol%increment(sw_optical_props_clrsky)) + ! Delta-scale optical properties + call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_clrsky%delta_scale()) + call check_error_msg('rrtmgp_sw_rte_run',rte_sw( & + sw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + coszen(idxday(1:nday)), & ! IN - Cosine of solar zenith angle + toa_src_sw(idxday(1:nday),:), & ! IN - incident solar flux at TOA + sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) + sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) + flux_clrsky)) ! OUT - Fluxes, clear-sky, 3D (nCol,NLev,nBand) + ! Store fluxes + fluxswUP_clrsky(idxday(1:nday),:) = sum(flux_clrsky%bnd_flux_up,dim=3) + fluxswDOWN_clrsky(idxday(1:nday),:) = sum(flux_clrsky%bnd_flux_dn,dim=3) + + ! Compute all-sky fluxes + ! All-sky fluxes (clear-sky + clouds) + call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_clouds%increment(sw_optical_props_clrsky)) + ! Delta-scale optical properties + call check_error_msg('rrtmgp_sw_rte_run',sw_optical_props_clrsky%delta_scale()) + call check_error_msg('rrtmgp_sw_rte_run',rte_sw( & + sw_optical_props_clrsky, & ! IN - optical-properties + top_at_1, & ! IN - veritcal ordering flag + coszen(idxday(1:nday)), & ! IN - Cosine of solar zenith angle + toa_src_sw(idxday(1:nday),:), & ! IN - incident solar flux at TOA + sfc_alb_dir, & ! IN - Shortwave surface albedo (direct) + sfc_alb_dif, & ! IN - Shortwave surface albedo (diffuse) + flux_allsky)) ! OUT - Fluxes, clear-sky, 3D (nCol,NLev,nBand) + ! Store fluxes + fluxswUP_allsky(idxday(1:nday),:) = sum(flux_allsky%bnd_flux_up,dim=3) + fluxswDOWN_allsky(idxday(1:nday),:) = sum(flux_allsky%bnd_flux_dn,dim=3) + if ( l_scmpsw ) then + scmpsw(idxday(1:nday))%nirbm = sum(flux_allsky%bnd_flux_dn_dir(1:nday,iSFC,:),dim=2) + scmpsw(idxday(1:nday))%nirdf = sum(flux_allsky%bnd_flux_dn(1:nday,iSFC,:),dim=2) - & + sum(flux_allsky%bnd_flux_dn_dir(1:nday,iSFC,:),dim=2) + endif + endif + end subroutine rrtmgp_sw_rte_run + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_rte_finalize + ! ######################################################################################### + subroutine rrtmgp_sw_rte_finalize() + end subroutine rrtmgp_sw_rte_finalize + +end module rrtmgp_sw_rte diff --git a/physics/rrtmgp_sw_rte.meta b/physics/rrtmgp_sw_rte.meta new file mode 100644 index 000000000..629ede530 --- /dev/null +++ b/physics/rrtmgp_sw_rte.meta @@ -0,0 +1,243 @@ +[ccpp-arg-table] + name = rrtmgp_sw_rte_run + type = scheme +[doSWrad] + standard_name = flag_to_calc_sw + long_name = flag to calculate SW irradiances + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ncol] + standard_name = horizontal_loop_extent + long_name = horizontal dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[nLev] + standard_name = vertical_dimension + long_name = number of vertical levels + units = count + dimensions = () + type = integer + intent = in + optional = F +[nday] + standard_name = daytime_points_dimension + long_name = daytime points dimension + units = count + dimensions = () + type = integer + intent = in + optional = F +[idxday] + standard_name = daytime_points + long_name = daytime points + units = index + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F +[coszen] + standard_name = cosine_of_zenith_angle + long_name = mean cos of zenith angle over rad call period + units = none + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p_lay] + standard_name = air_pressure_at_layer_for_RRTMGP_in_hPa + long_name = air pressure layer + units = hPa + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[p_lev] + standard_name = air_pressure_at_interface_for_RRTMGP_in_hPa + long_name = air pressure level + units = hPa + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = in + optional = F +[t_lay] + standard_name = air_temperature_at_layer_for_RRTMGP + long_name = air temperature layer + units = K + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sw_gas_props] + standard_name = coefficients_for_sw_gas_optics + long_name = DDT containing spectral information for RRTMGP SW radiation scheme + units = DDT + dimensions = () + type = ty_gas_optics_rrtmgp + intent = in + optional = F +[sw_optical_props_clrsky] + standard_name = shortwave_optical_properties_for_clear_sky + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + intent = inout + optional = F +[sw_optical_props_clouds] + standard_name = shortwave_optical_properties_for_cloudy_atmosphere + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + intent = in + optional = F +[sw_optical_props_aerosol] + standard_name = shortwave_optical_properties_for_aerosols + long_name = Fortran DDT containing RRTMGP optical properties + units = DDT + dimensions = () + type = ty_optical_props_2str + intent = in + optional = F +[sfc_alb_nir_dir] + standard_name = surface_albedo_nearIR_direct + long_name = near-IR (direct) surface albedo (sfc_alb_nir_dir) + units = none + dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfc_alb_nir_dif] + standard_name = surface_albedo_nearIR_diffuse + long_name = near-IR (diffuse) surface albedo (sfc_alb_nir_dif) + units = none + dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfc_alb_uvvis_dir] + standard_name = surface_albedo_uvvis_dir + long_name = UVVIS (direct) surface albedo (sfc_alb_uvvis_dir) + units = none + dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[sfc_alb_uvvis_dif] + standard_name = surface_albedo_uvvis_dif + long_name = UVVIS (diffuse) surface albedo (sfc_alb_uvvis_dif) + units = none + dimensions = (number_of_sw_bands_rrtmgp,horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F +[toa_src_sw] + standard_name = toa_incident_sw_flux_by_spectral_point + long_name = TOA shortwave incident flux at each spectral points + units = W m-2 + dimensions = (horizontal_dimension,number_of_sw_spectral_points_rrtmgp) + type = real + kind = kind_phys + intent = in + optional = F +[rrtmgp_nGases] + standard_name = number_of_active_gases_used_by_RRTMGP + long_name = number of gases available used by RRTMGP + units = count + dimensions = () + type = integer + intent = in + optional = F +[active_gases_array] + standard_name = list_of_active_gases_used_by_RRTMGP + long_name = list of active gases used by RRTMGP + units = none + dimensions = (number_of_active_gases_used_by_RRTMGP) + type = character + kind = len=* + intent = in + optional = F +[scmpsw] + standard_name = components_of_surface_downward_shortwave_fluxes + long_name = derived type for special components of surface downward shortwave fluxes + units = W m-2 + dimensions = (horizontal_dimension) + type = cmpfsw_type + intent = inout + optional = T +[fluxswUP_allsky] + standard_name = RRTMGP_sw_flux_profile_upward_allsky + long_name = RRTMGP upward shortwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = inout + optional = F +[fluxswDOWN_allsky] + standard_name = RRTMGP_sw_flux_profile_downward_allsky + long_name = RRTMGP downward shortwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = inout + optional = F +[fluxswUP_clrsky] + standard_name = RRTMGP_sw_flux_profile_upward_clrsky + long_name = RRTMGP upward shortwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = inout + optional = F +[fluxswDOWN_clrsky] + standard_name = RRTMGP_sw_flux_profile_downward_clrsky + long_name = RRTMGP downward shortwave clr-sky flux profile + units = W m-2 + dimensions = (horizontal_dimension,vertical_dimension_plus_one) + type = real + kind = kind_phys + intent = inout + optional = F +[hswb] + standard_name = RRTMGP_sw_heating_rate_spectral + long_name = shortwave total sky heating rate (spectral) + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension,number_of_sw_spectral_points_rrtmgp) + type = real + kind = kind_phys + intent = inout + optional = T +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp new file mode 160000 index 000000000..7dfff2025 --- /dev/null +++ b/physics/rte-rrtmgp @@ -0,0 +1 @@ +Subproject commit 7dfff2025cae02c84b12df2402a39d77065f0e62 diff --git a/physics/samfdeepcnv.f b/physics/samfdeepcnv.f index 83e1efb80..03f5f05ef 100644 --- a/physics/samfdeepcnv.f +++ b/physics/samfdeepcnv.f @@ -63,7 +63,7 @@ end subroutine samfdeepcnv_finalize !! + 2) For the "dynamic control", using a reference cloud work function, estimate the change in cloud work function due to the large-scale dynamics. Following the quasi-equilibrium assumption, calculate the cloud base mass flux required to keep the large-scale convective destabilization in balance with the stabilization effect of the convection. !! -# For grid sizes smaller than the threshold value (currently 8 km): !! + 1) compute the cloud base mass flux using the cumulus updraft velocity averaged ove the whole cloud depth. -!! -# For scale awareness, the updraft fraction (sigma) is obtained as a function of cloud base entrainment. Then, the final cloud base mass flux is obtained by the original mass flux multiplied by the (1−sigma) 2 . +!! -# For scale awareness, the updraft fraction (sigma) is obtained as a function of cloud base entrainment. Then, the final cloud base mass flux is obtained by the original mass flux multiplied by the (1-sigma) 2. !! -# For the "feedback control", calculate updated values of the state variables by multiplying the cloud base mass flux and the tendencies calculated per unit cloud base mass flux from the static control. !! !! \section samfdeep_detailed GFS samfdeepcnv Detailed Algorithm @@ -72,11 +72,13 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & & eps,epsm1,fv,grav,hvap,rd,rv, & & t0c,delt,ntk,ntr,delp, & & prslp,psp,phil,qtr,q1,t1,u1,v1,fscav, & - & do_ca,ca_deep,cldwrk,rn,kbot,ktop,kcnv,islimsk,garea, & + & cldwrk,rn,kbot,ktop,kcnv,islimsk,garea, & & dot,ncloud,ud_mf,dd_mf,dt_mf,cnvw,cnvc, & & QLCN, QICN, w_upi, cf_upi, CNV_MFD, & & CNV_DQLDT,CLCN,CNV_FICE,CNV_NDROP,CNV_NICE,mp_phys,mp_phys_mg,& & clam,c0s,c1,betal,betas,evfact,evfactl,pgcon,asolfac, & + & do_ca, ca_closure, ca_entr, ca_trigger, nthresh, ca_deep, & + & rainevap, & & errmsg,errflg) ! use machine , only : kind_phys @@ -92,8 +94,10 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & real(kind=kind_phys), intent(in) :: psp(im), delp(ix,km), & & prslp(ix,km), garea(im), dot(ix,km), phil(ix,km) real(kind=kind_phys), dimension(:), intent(in) :: fscav + real(kind=kind_phys), intent(in) :: nthresh real(kind=kind_phys), intent(in) :: ca_deep(ix) - logical, intent(in) :: do_ca + real(kind=kind_phys), intent(out) :: rainevap(ix) + logical, intent(in) :: do_ca,ca_closure,ca_entr,ca_trigger integer, intent(inout) :: kcnv(im) ! DH* TODO - check dimensions of qtr, ntr+2 correct? *DH @@ -222,6 +226,7 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & parameter(cinacrmx=-120.,cinacrmn=-80.) parameter(bet1=1.875,cd1=.506,f1=2.0,gam1=.5) parameter(betaw=.03,dxcrtas=8.e3,dxcrtuf=15.e3) + ! ! local variables and arrays real(kind=kind_phys) pfld(im,km), to(im,km), qo(im,km), @@ -327,6 +332,7 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & xpwav(i)= 0. xpwev(i)= 0. vshear(i) = 0. + rainevap(i) = 0. gdx(i) = sqrt(garea(i)) enddo ! @@ -655,6 +661,14 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & do i=1,im if(kbcon(i) == kmax(i)) cnvflg(i) = .false. enddo +!! + if(do_ca .and. ca_trigger)then + do i=1,im + if(ca_deep(i) > nthresh) then + cnvflg(i) = .true. + endif + enddo + endif !! totflg = .true. do i=1,im @@ -706,6 +720,14 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & endif endif enddo +!! + if(do_ca .and. ca_trigger)then + do i=1,im + if(ca_deep(i) > nthresh) then + cnvflg(i) = .true. + endif + enddo + endif !! totflg = .true. do i=1,im @@ -755,11 +777,23 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & ! else ! - do i= 1, im - if(cnvflg(i)) then - clamt(i) = clam - endif - enddo + if(do_ca .and. ca_entr)then + do i=1,im + if(cnvflg(i)) then + if(ca_deep(i) > nthresh)then + clamt(i) = clam - clamd + else + clamt(i) = clam + endif + endif + enddo + else + do i=1,im + if(cnvflg(i))then + clamt(i) = clam + endif + enddo + endif ! endif ! @@ -986,6 +1020,14 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & endif endif enddo +!! + if(do_ca .and. ca_trigger)then + do i=1,im + if(ca_deep(i) > nthresh) then + cnvflg(i) = .true. + endif + enddo + endif !! totflg = .true. do i = 1, im @@ -1054,6 +1096,14 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & if(cina(i) < cinacr) cnvflg(i) = .false. endif enddo +!! + if(do_ca .and. ca_trigger)then + do i=1,im + if(ca_deep(i) > nthresh) then + cnvflg(i) = .true. + endif + enddo + endif !! totflg = .true. do i=1,im @@ -1089,6 +1139,14 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & if(tem < cthk) cnvflg(i) = .false. endif enddo +!! + if(do_ca .and. ca_trigger)then + do i=1,im + if(ca_deep(i) > nthresh) then + cnvflg(i) = .true. + endif + enddo + endif !! totflg = .true. do i = 1, im @@ -2370,6 +2428,7 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & endif enddo !! + !> - If the large scale destabilization is less than zero, or the stabilization by the convection is greater than zero, then the scheme returns to the calling routine without modifying the state variables. totflg = .true. do i=1,im @@ -2403,13 +2462,15 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & xmb(i) = min(xmb(i),xmbmax(i)) endif enddo - -!> - If stochastic physics using cellular automata is .true. then perturb the mass-flux here: - - if(do_ca)then - do i=1,im - xmb(i) = xmb(i)*(1.0 + ca_deep(i)*5.) - enddo +! + if (do_ca .and. ca_closure)then + do i = 1, im + if(cnvflg(i)) then + if (ca_deep(i) > nthresh) then + xmb(i) = xmb(i)*1.25 + endif + endif + enddo endif !> - Transport aerosols if present @@ -2589,6 +2650,13 @@ subroutine samfdeepcnv_run (im,ix,km,itc,ntc,cliq,cp,cvap, & endif enddo enddo + +!LB: + if(do_ca)then + do i = 1,im + rainevap(i)=delqev(i) + enddo + endif cj ! do i = 1, im ! if(me == 31 .and. cnvflg(i)) then diff --git a/physics/samfdeepcnv.meta b/physics/samfdeepcnv.meta index 3b54998fc..215026eb2 100644 --- a/physics/samfdeepcnv.meta +++ b/physics/samfdeepcnv.meta @@ -265,6 +265,15 @@ kind = kind_phys intent = in optional = F +[nthresh] + standard_name = threshold_for_perturbed_vertical_velocity + long_name = threshold used for perturbed vertical velocity + units = m s-1 + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [do_ca] standard_name = flag_for_cellular_automata long_name = cellular automata main switch @@ -273,6 +282,30 @@ type = logical intent = in optional = F +[ca_closure] + standard_name = flag_for_global_cellular_automata_closure + long_name = switch for ca on closure + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ca_entr] + standard_name = flag_for_global_cellular_automata_entr + long_name = switch for ca on entr + units = flag + dimensions = () + type = logical + intent = in + optional = F +[ca_trigger] + standard_name = flag_for_global_cellular_automata_trigger + long_name = switch for ca on trigger + units = flag + dimensions = () + type = logical + intent = in + optional = F [ca_deep] standard_name = fraction_of_cellular_automata_for_deep_convection long_name = fraction of cellular automata for deep convection @@ -282,6 +315,15 @@ kind = kind_phys intent = in optional = F +[rainevap] + standard_name = physics_field_for_coupling + long_name = physics_field_for_coupling + units = m2 s-2 + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = out + optional = F [cldwrk] standard_name = cloud_work_function long_name = cloud work function diff --git a/physics/sascnvn.meta b/physics/sascnvn.meta index 48c56d4b9..f330dd94d 100644 --- a/physics/sascnvn.meta +++ b/physics/sascnvn.meta @@ -222,7 +222,7 @@ optional = F [qlc] standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) in the convectively transported tracer array + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -231,7 +231,7 @@ optional = F [qli] standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real diff --git a/physics/satmedmfvdif.meta b/physics/satmedmfvdif.meta index 28cb942c0..b1c3fbfc4 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -252,7 +252,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky shortwave heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in @@ -261,7 +261,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky longwave heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in @@ -357,7 +357,7 @@ intent = in optional = F [heat] - standard_name = kinematic_surface_upward_sensible_heat_flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 dimensions = (horizontal_dimension) @@ -366,7 +366,7 @@ intent = in optional = F [evap] - standard_name = kinematic_surface_upward_latent_heat_flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 dimensions = (horizontal_dimension) diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index a514de6ad..f10ed97ef 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -7,6 +7,15 @@ module satmedmfvdifq contains +!> \defgroup satmedmfvdifq GFS Scale-aware TKE-based Moist Eddy-Diffusivity Mass-flux (TKE-EDMF, updated version) Scheme Module +!! @{ +!! \brief This subroutine contains all of the logic for the +!! scale-aware TKE-based moist eddy-diffusion mass-flux (TKE-EDMF, updated version) scheme. +!! For local turbulence mixing, a TKE closure model is used. +!! Updated version of satmedmfvdif.f (May 2019) to have better low level +!! inversion, to reduce the cold bias in lower troposphere, +!! and to reduce the negative wind speed bias in upper troposphere + !> \section arg_table_satmedmfvdifq_init Argument Table !! \htmlinclude satmedmfvdifq_init.html !! @@ -33,30 +42,21 @@ end subroutine satmedmfvdifq_init subroutine satmedmfvdifq_finalize () end subroutine satmedmfvdifq_finalize -!> \defgroup satmedmfq GFS Scale-aware TKE-based Moist Eddy-Diffusivity Mass-flux (TKE-EDMF, updated version) Scheme Module -!! @{ -!! \brief This subroutine contains all of the logic for the -!! scale-aware TKE-based moist eddy-diffusion mass-flux (TKE-EDMF, updated version) scheme. -!! !> \section arg_table_satmedmfvdifq_run Argument Table !! \htmlinclude satmedmfvdifq_run.html !! -!!\section gen_satmedmfvdif GFS satmedmfvdif General Algorithm -!! satmedmfvdif_run() computes subgrid vertical turbulence mixing +!!\section gen_satmedmfvdifq GFS satmedmfvdifq General Algorithm +!! satmedmfvdifq_run() computes subgrid vertical turbulence mixing !! using the scale-aware TKE-based moist eddy-diffusion mass-flux (EDMF) parameterization of !! Han and Bretherton (2019) \cite Han_2019 . !! -# The local turbulent mixing is represented by an eddy-diffusivity scheme which !! is a function of a prognostic TKE. !! -# For the convective boundary layer, nonlocal transport by large eddies -!! (mfpblt.f), is represented using a mass flux approach (Siebesma et al.(2007) \cite Siebesma_2007 ). +!! (mfpbltq.f), is represented using a mass flux approach (Siebesma et al.(2007) \cite Siebesma_2007 ). !! -# A mass-flux approach is also used to represent the stratocumulus-top-induced turbulence -!! (mfscu.f). -!! For local turbulence mixing, a TKE closure model is used. -!! Updated version of satmedmfvdif.f (May 2019) to have better low level -!! inversion, to reduce the cold bias in lower troposphere, -!! and to reduce the negative wind speed bias in upper troposphere +!! (mfscuq.f). !! \section detail_satmedmfvidfq GFS satmedmfvdifq Detailed Algorithm -!> @{ +!! @{ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & & grav,rd,cp,rv,hvap,hfus,fv,eps,epsm1, & & dv,du,tdt,rtg,u1,v1,t1,q1,swh,hlw,xmu,garea, & @@ -218,7 +218,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & parameter(gamcrt=3.,gamcrq=0.,sfcfrac=0.1) parameter(vk=0.4,rimin=-100.) parameter(rbcr=0.25,zolcru=-0.02,tdzmin=1.e-3) - parameter(rlmn=30.,rlmn1=5.,rlmn2=10.) + parameter(rlmn=30.,rlmn1=5.,rlmn2=15.) parameter(rlmx=300.,elmx=300.) parameter(prmin=0.25,prmax=4.0) parameter(pr0=1.0,prtke=1.0,prscu=0.67) @@ -228,7 +228,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & parameter(aphi5=5.,aphi16=16.) parameter(elmfac=1.0,elefac=1.0,cql=100.) parameter(dw2min=1.e-4,dkmax=1000.,xkgdx=5000.) - parameter(qlcr=3.5e-5,zstblmax=2500.,xkzinv=0.1) + parameter(qlcr=3.5e-5,zstblmax=2500.,xkzinv=0.15) parameter(h1=0.33333333) parameter(ck0=0.4,ck1=0.15,ch0=0.4,ch1=0.15) parameter(ce0=0.4) @@ -249,6 +249,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & errmsg = '' errflg = 0 +!> ## Compute preliminary variables from input arguments dt2 = delt rdt = 1. / dt2 ! @@ -259,7 +260,8 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & km1 = km - 1 kmpbl = km / 2 kmscu = km / 2 -! +!> - Compute physical height of the layer centers and interfaces from +!! the geopotential height (\p zi and \p zl) do k=1,km do i=1,im zi(i,k) = phii(i,k) * gravi @@ -284,11 +286,12 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & zm(i,k) = zi(i,k+1) enddo enddo -! horizontal grid size +!> - Compute horizontal grid size (\p gdx) do i=1,im gdx(i) = sqrt(garea(i)) enddo -! +!> - Initialize tke value at vertical layer centers and interfaces +!! from tracer (\p tke and \p tkeh) do k=1,km do i=1,im tke(i,k) = max(q1(i,k,ntke), tkmin) @@ -299,7 +302,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & tkeh(i,k) = 0.5 * (tke(i,k) + tke(i,k+1)) enddo enddo -! +!> - Compute reciprocal of \f$ \Delta z \f$ (rdzt) do k = 1,km1 do i=1,im rdzt(i,k) = 1.0 / (zl(i,k+1) - zl(i,k)) @@ -307,12 +310,18 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo ! -! set background diffusivities as a function of -! horizontal grid size with xkzm_h & xkzm_m for gdx >= 25km -! and 0.01 for gdx=5m, i.e., -! xkzm_hx = 0.01 + (xkzm_h - 0.01)/(xkgdx-5.) * (gdx-5.) -! xkzm_mx = 0.01 + (xkzm_h - 0.01)/(xkgdx-5.) * (gdx-5.) -! +!> - Compute reciprocal of pressure (tx1, tx2) + +!> - Compute minimum turbulent mixing length (rlmnz) + +!> - Compute background vertical diffusivities for scalars and momentum (xkzo and xkzmo) + +!> - set background diffusivities as a function of +!! horizontal grid size with xkzm_h & xkzm_m for gdx >= 25km +!! and 0.01 for gdx=5m, i.e., +!! \n xkzm_hx = 0.01 + (xkzm_h - 0.01)/(xkgdx-5.) * (gdx-5.) +!! \n xkzm_mx = 0.01 + (xkzm_h - 0.01)/(xkgdx-5.) * (gdx-5.) + do i=1,im kx1(i) = 1 tx1(i) = 1.0 / prsi(i,1) @@ -360,7 +369,8 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & endif enddo enddo -! + +!> - Some output variables and logical flags are initialized do i = 1,im z0(i) = 0.01 * zorl(i) dusfc(i) = 0. @@ -384,7 +394,9 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & kcld(i) = km1 endif enddo -! + +!> - Compute \f$\theta\f$(theta), and \f$q_l\f$(qlx), \f$\theta_e\f$(thetae), +!! \f$\theta_v\f$(thvx),\f$\theta_{l,v}\f$ (thlvx) including ice water do k=1,km do i=1,im pix(i,k) = psk(i) / prslk(i,k) @@ -411,10 +423,9 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & gotvx(i,k) = g / tvx(i,k) enddo enddo -! -! compute an empirical cloud fraction based on -! Xu & Randall's (1996,JAS) study -! + +!> - Compute an empirical cloud fraction based on +!! Xu and Randall (1996) \cite xu_and_randall_1996 do k = 1, km do i = 1, im plyr(i,k) = 0.01 * prsl(i,k) ! pa to mb (hpa) @@ -441,7 +452,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo ! -! compute buoyancy modified by clouds +!> - Compute buoyancy modified by clouds ! do k = 1, km1 do i = 1, im @@ -464,6 +475,8 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! +!> - Initialize diffusion coefficients to 0 and calculate the total +!! radiative heating rate (dku, dkt, radx) do k=1,km1 do i=1,im dku(i,k) = 0. @@ -475,14 +488,31 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & radx(i,k) = tem*(swh(i,k)*xmu(i)+hlw(i,k)) enddo enddo -! +!> - Compute stable/unstable PBL flag (pblflg) based on the total +!! surface energy flux (\e false if the total surface energy flux +!! is into the surface) do i = 1,im sflux(i) = heat(i) + evap(i)*fv*theta(i,1) if(.not.sfcflg(i) .or. sflux(i) <= 0.) pblflg(i)=.false. enddo ! -! compute critical bulk richardson number -! +!> ## Calculate the PBL height +!! The calculation of the boundary layer height follows Troen and Mahrt (1986) \cite troen_and_mahrt_1986 section 3. The approach is to find the level in the column where a modified bulk Richardson number exceeds a critical value. +!! - Compute critical bulk Richardson number (\f$Rb_{cr}\f$) (crb) +!! - For the unstable PBL, crb is a constant (0.25) +!! - For the stable boundary layer (SBL), \f$Rb_{cr}\f$ varies +!! with the surface Rossby number, \f$R_{0}\f$, as given by +!! Vickers and Mahrt (2004) \cite Vickers_2004 +!! \f[ +!! Rb_{cr}=0.16(10^{-7}R_{0})^{-0.18} +!! \f] +!! \f[ +!! R_{0}=\frac{U_{10}}{f_{0}z_{0}} +!! \f] +!! where \f$U_{10}\f$ is the wind speed at 10m above the ground surface, +!! \f$f_0\f$ the Coriolis parameter, and \f$z_{0}\f$ the surface roughness +!! length. To avoid too much variation, we restrict \f$Rb_{cr}\f$ to vary +!! within the range of 0.15~0.35 do i = 1,im if(pblflg(i)) then ! thermal(i) = thvx(i,1) @@ -498,7 +528,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & crb(i) = max(min(crb(i), crbmax), crbmin) endif enddo -! +!> - Compute \f$\frac{\Delta t}{\Delta z}\f$ , \f$u_*\f$ do i=1,im dtdz1(i) = dt2 / (zi(i,2)-zi(i,1)) enddo @@ -507,7 +537,8 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & ustar(i) = sqrt(stress(i)) enddo ! -! compute buoyancy (bf) and winshear square +!> - Compute buoyancy \f$\frac{\partial \theta_v}{\partial z}\f$ (bf) +!! and the wind shear squared (shr2) ! do k = 1, km1 do i = 1, im @@ -519,14 +550,18 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo ! -! find pbl height based on bulk richardson number (mrf pbl scheme) +! Find pbl height based on bulk richardson number (mrf pbl scheme) ! and also for diagnostic purpose ! do i=1,im flg(i) = .false. rbup(i) = rbsoil(i) enddo -! +!> - Given the thermal's properties and the critical Richardson number, +!! a loop is executed to find the first level above the surface (kpblx) where +!! the modified Richardson number is greater than the critical Richardson +!! number, using equation 10a from Troen and Mahrt (1996) \cite troen_and_mahrt_1986 +!! (also equation 8 from Hong and Pan (1996) \cite hong_and_pan_1996): do k = 1, kmpbl do i = 1, im if(.not.flg(i)) then @@ -541,6 +576,9 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & endif enddo enddo +!> - Once the level is found, some linear interpolation is performed to find +!! the exact height of the boundary layer top (where \f$R_{i} > Rb_{cr}\f$) +!! and the PBL height (hpbl and kpbl) and the PBL top index are saved. do i = 1,im if(kpblx(i) > 1) then k = kpblx(i) @@ -562,8 +600,15 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & if(kpbl(i) <= 1) pblflg(i)=.false. enddo ! -! compute similarity parameters -! +!> ## Compute Monin-Obukhov similarity parameters +!! - Calculate the Monin-Obukhov nondimensional stability paramter, commonly +!! referred to as \f$\zeta\f$ using the following equation from Businger et al.(1971) \cite businger_et_al_1971 +!! (eqn 28): +!! \f[ +!! \zeta = Ri_{sfc}\frac{F_m^2}{F_h} = \frac{z}{L} +!! \f] +!! where \f$F_m\f$ and \f$F_h\f$ are surface Monin-Obukhov stability functions calculated in sfc_diff.f and +!! \f$L\f$ is the Obukhov length. do i=1,im zol(i) = max(rbsoil(i)*fm(i)*fm(i)/fh(i),rimin) if(sfcflg(i)) then @@ -571,7 +616,17 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & else zol(i) = max(zol(i),zfmin) endif -! +!> - Calculate the nondimensional gradients of momentum and temperature (\f$\phi_m\f$ (phim) and \f$\phi_h\f$(phih)) are calculated using +!! eqns 5 and 6 from Hong and Pan (1996) \cite hong_and_pan_1996 depending on the surface layer stability: +!! - For the unstable and neutral conditions: +!! \f[ +!! \phi_m=(1-16\frac{0.1h}{L})^{-1/4} +!! \phi_h=(1-16\frac{0.1h}{L})^{-1/2} +!! \f] +!! - For the stable regime +!! \f[ +!! \phi_m=\phi_t=(1+5\frac{0.1h}{L}) +!! \f] zol1 = zol(i)*sfcfrac*hpbl(i)/zl(i,1) if(sfcflg(i)) then tem = 1.0 / (1. - aphi16*zol1) @@ -583,6 +638,21 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & endif enddo ! +!> - The \f$z/L\f$ (zol) is used as the stability criterion for the PBL.Currently, +!! strong unstable (convective) PBL for \f$z/L < -0.02\f$ and weakly and moderately +!! unstable PBL for \f$0>z/L>-0.02\f$ +!> - Compute the velocity scale \f$w_s\f$ (wscale) (eqn 22 of Han et al. 2019). It +!! is represented by the value scaled at the top of the surface layer: +!! \f[ +!! w_s=(u_*^3+7\alpha\kappa w_*^3)^{1/3} +!! \f] +!! where \f$u_*\f$ (ustar) is the surface friction velocity,\f$\alpha\f$ is the ratio +!! of the surface layer height to the PBL height (specified as sfcfrac =0.1), +!! \f$\kappa =0.4\f$ is the von Karman constant, and \f$w_*\f$ is the convective velocity +!! scale defined as eqn23 of Han et al.(2019): +!! \f[ +!! w_{*}=[(g/T)\overline{(w'\theta_v^{'})}_0h]^{1/3} +!! \f] do i=1,im if(pblflg(i)) then if(zol(i) < zolcru) then @@ -597,7 +667,8 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & endif enddo ! -! compute a thermal excess +!> ## The counter-gradient terms for temperature and humidity are calculated. +!! - Equation 4 of Hong and Pan (1996) \cite hong_and_pan_1996 and are used to calculate the "scaled virtual temperature excess near the surface" (equation 9 in Hong and Pan (1996) \cite hong_and_pan_1996) for use in the mass-flux algorithm. ! do i = 1,im if(pcnvflg(i)) then @@ -611,7 +682,10 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! look for stratocumulus -! +!> ## Determine whether stratocumulus layers exist and compute quantities +!! - Starting at the PBL top and going downward, if the level is less than 2.5 km +!! and \f$q_l\geq q_{lcr}\f$ then set kcld = k (find the cloud top index in the PBL. +!! If no cloud water above the threshold is hound, \e scuflg is set to F. do i=1,im flg(i) = scuflg(i) enddo @@ -639,7 +713,11 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & do i = 1, im if(scuflg(i) .and. kcld(i)==km1) scuflg(i)=.false. enddo -! +!> - Starting at the PBL top and going downward, if the level is less +!! than the cloud top, find the level of the minimum radiative heating +!! rate wihin the cloud. If the level of the minimum is the lowest model +!! level or the minimum radiative heating rate is positive, then set +!! scuflg to F. do i = 1, im flg(i)=scuflg(i) enddo @@ -663,9 +741,10 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute components for mass flux mixing by large thermals +!> ## Compute components for mass flux mixing by large thermals !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! +!> - If the PBL is convective, the updraft properties are initialized +!! to be the same as the state variables. do k = 1, km do i = 1, im if(pcnvflg(i)) then @@ -692,12 +771,14 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo enddo -! +!> - Call mfpbltq(), which is an EDMF parameterization (Siebesma et al.(2007) \cite Siebesma_2007) +!! to take into account nonlocal transport by large eddies. For details of the mfpbltq subroutine, step into its documentation ::mfpbltq call mfpbltq(im,ix,km,kmpbl,ntcw,ntrac1,dt2, & pcnvflg,zl,zm,q1,t1,u1,v1,plyr,pix,thlx,thvx, & gdx,hpbl,kpbl,vpert,buou,xmf, & tcko,qcko,ucko,vcko,xlamue,bl_upfr) -! +!> - Call mfscuq(), which is a new mass-flux parameterization for +!! stratocumulus-top-induced turbulence mixing. For details of the mfscuq subroutine, step into its documentation ::mfscuq call mfscuq(im,ix,km,kmscu,ntcw,ntrac1,dt2, & scuflg,zl,zm,q1,t1,u1,v1,plyr,pix, & thlx,thvx,thlvx,gdx,thetae, @@ -705,8 +786,8 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & & tcdo,qcdo,ucdo,vcdo,xlamde,bl_dnfr) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute prandtl number and exchange coefficient varying with height -! + +!> ## Compute Prandtl number \f$P_r\f$ (prn) and exchange coefficient varying with height do k = 1, kmpbl do i = 1, im if(k < kpbl(i)) then @@ -750,8 +831,8 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & ! enddo ! enddo ! -! The background vertical diffusivities in the inversion layers are limited -! to be less than or equal to xkzminv +!> ## The background vertical diffusivities in the inversion layers are limited +!! to be less than or equal to xkzinv ! do k = 1,km1 do i=1,im @@ -767,7 +848,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute an asymtotic mixing length +!> ## Compute an asymtotic mixing length ! do k = 1, km1 do i = 1, im @@ -827,7 +908,18 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & ! tem = 0.5 * (zi(i,k+1)-zi(i,k)) tem1 = min(tem, rlmnz(i,k)) -! +!> - Following Bougeault and Lacarrere(1989), the characteristic length +!! scale (\f$l_2\f$) (eqn 10 in Han et al.(2019) \cite Han_2019) is given by: +!!\f[ +!! l_2=min(l_{up},l_{down}) +!!\f] +!! and dissipation length scale \f$l_d\f$ is given by: +!!\f[ +!! l_d=(l_{up}l_{down})^{1/2} +!!\f] +!! where \f$l_{up}\f$ and \f$l_{down}\f$ are the distances that a parcel +!! having an initial TKE can travel upward and downward before being stopped +!! by buoyancy effects. ptem2 = min(zlup,zldn) rlam(i,k) = elmfac * ptem2 rlam(i,k) = max(rlam(i,k), tem1) @@ -840,7 +932,8 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & ! enddo enddo -! +!> - Compute the surface layer length scale (\f$l_1\f$) following +!! Nakanishi (2001) \cite Nakanish_2001 (eqn 9 of Han et al.(2019) \cite Han_2019) do k = 1, km1 do i = 1, im tem = vk * zl(i,k) @@ -869,7 +962,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute eddy diffusivities +!> ## Compute eddy diffusivities !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! do k = 1, km1 @@ -922,8 +1015,8 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & ! enddo enddo -! -! compute a minimum TKE deduced from background diffusivity for momentum. +!> ## Compute TKE. +!! - Compute a minimum TKE deduced from background diffusivity for momentum. ! do k = 1, km1 do i = 1, im @@ -942,7 +1035,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! compute buoyancy and shear productions of tke +!> - Compute buoyancy and shear productions of TKE !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! do k = 1, km1 @@ -1066,7 +1159,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo ! !---------------------------------------------------------------------- -! first predict tke due to tke production & dissipation(diss) +!> - First predict tke due to tke production & dissipation(diss) ! dtn = dt2 / float(ndt) do n = 1, ndt @@ -1084,7 +1177,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo ! -! compute updraft & downdraft properties for tke +!> - Compute updraft & downdraft properties for TKE ! do k = 1, km do i = 1, im @@ -1122,7 +1215,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo ! !---------------------------------------------------------------------- -! compute tridiagonal matrix elements for turbulent kinetic energy +!> - Compute tridiagonal matrix elements for turbulent kinetic energy ! do i=1,im ad(i,1) = 1.0 @@ -1170,11 +1263,11 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo c -c solve tridiagonal problem for tke +!> - Call tridit() to solve tridiagonal problem for TKE c call tridit(im,km,1,al,ad,au,f1,au,f1) c -c recover tendency of tke +!> - Recover the tendency of tke c do k = 1,km do i = 1,im @@ -1184,7 +1277,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo c -c compute tridiagonal matrix elements for heat and moisture +!> ## Compute tridiagonal matrix elements for heat and moisture c do i=1,im ad(i,1) = 1. @@ -1293,11 +1386,11 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo endif c -c solve tridiagonal problem for heat and moisture +!> - Call tridin() to solve tridiagonal problem for heat and moisture c call tridin(im,km,ntrac1,al,ad,au,f1,f2,au,f1,f2) c -c recover tendencies of heat and moisture +!> - Recover the tendencies of heat and moisture c do k = 1,km do i = 1,im @@ -1348,7 +1441,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & endif endif ! -! add tke dissipative heating to temperature tendency +!> ## Add TKE dissipative heating to temperature tendency ! if(dspheat) then do k = 1,km1 @@ -1369,7 +1462,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & endif endif c -c compute tridiagonal matrix elements for momentum +!> ## Compute tridiagonal matrix elements for momentum c do i=1,im ad(i,1) = 1.0 + dtdz1(i) * stress(i) / spd1(i) @@ -1427,11 +1520,11 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & enddo enddo c -c solve tridiagonal problem for momentum +!> - Call tridi2() to solve tridiagonal problem for momentum c call tridi2(im,km,al,ad,au,f1,f2,au,f1,f2) c -c recover tendencies of momentum +!> - Recover the tendencies of momentum c do k = 1,km do i = 1,im @@ -1455,7 +1548,7 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & endif ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -! pbl height for diagnostic purpose +!> ## Save PBL height for diagnostic purpose ! do i = 1, im hpbl(i) = hpblx(i) @@ -1466,5 +1559,5 @@ subroutine satmedmfvdifq_run(ix,im,km,ntrac,ntcw,ntiw,ntke, & return end subroutine satmedmfvdifq_run !> @} - +!! @} end module satmedmfvdifq diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index f2c735def..01211b599 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -252,7 +252,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky shortwave heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in @@ -261,7 +261,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky longwave heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in @@ -357,7 +357,7 @@ intent = in optional = F [heat] - standard_name = kinematic_surface_upward_sensible_heat_flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 dimensions = (horizontal_dimension) @@ -366,7 +366,7 @@ intent = in optional = F [evap] - standard_name = kinematic_surface_upward_latent_heat_flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 dimensions = (horizontal_dimension) diff --git a/physics/sfc_cice.f b/physics/sfc_cice.f index 0a1a49c77..d0aaee476 100644 --- a/physics/sfc_cice.f +++ b/physics/sfc_cice.f @@ -41,7 +41,7 @@ end subroutine sfc_cice_finalize !----------------------------------- subroutine sfc_cice_run & ! --- inputs: - & ( im, cplflx, cplchm, hvap, cp, rvrdm1, rd, & + & ( im, cplflx, hvap, cp, rvrdm1, rd, & & t1, q1, cm, ch, prsl1, & & wind, flag_cice, flag_iter, dqsfc, dtsfc, & & dusfc, dvsfc, & @@ -58,7 +58,7 @@ subroutine sfc_cice_run & ! ! ! call sfc_cice ! ! inputs: ! -! ( im, cplflx, cplchm, hvap, cp, rvrdm1, rd, ! +! ( im, cplflx, hvap, cp, rvrdm1, rd, ! ! t1, q1, cm, ch, prsl1, ! ! wind, flag_cice, flag_iter, dqsfc, dtsfc, ! ! dusfc, dvsfc, ! @@ -99,7 +99,6 @@ subroutine sfc_cice_run & ! --- inputs: integer, intent(in) :: im logical, intent(in) :: cplflx - logical, intent(in) :: cplchm ! real (kind=kind_phys), dimension(im), intent(in) :: u1, v1, & real (kind=kind_phys), dimension(im), intent(in) :: & @@ -126,9 +125,7 @@ subroutine sfc_cice_run & errmsg = '' errflg = 0 ! - if ((.not. cplflx) .and. (.not.cplchm)) then - return - endif + if (.not. cplflx) return ! cpinv = 1.0/cp hvapi = 1.0/hvap diff --git a/physics/sfc_cice.meta b/physics/sfc_cice.meta index 48aa1f4c8..a1c57d4d9 100644 --- a/physics/sfc_cice.meta +++ b/physics/sfc_cice.meta @@ -17,14 +17,6 @@ type = logical intent = in optional = F -[cplchm] - standard_name = flag_for_chemistry_coupling - long_name = flag controlling cplchm collection (default off) - units = flag - dimensions = () - type = logical - intent = in - optional = F [hvap] standard_name = latent_heat_of_vaporization_of_water_at_0C long_name = latent heat of evaporation/sublimation @@ -132,8 +124,8 @@ intent = in optional = F [dqsfc] - standard_name = surface_upward_latent_heat_flux_for_coupling_interstitial - long_name = sfc latent heat flux for coupling interstitial + standard_name = surface_upward_latent_heat_flux_for_coupling + long_name = sfc latent heat flux for coupling units = W m-2 dimensions = (horizontal_dimension) type = real @@ -141,8 +133,8 @@ intent = in optional = F [dtsfc] - standard_name = surface_upward_sensible_heat_flux_for_coupling_interstitial - long_name = sfc sensible heat flux for coupling interstitial + standard_name = surface_upward_sensible_heat_flux_for_coupling + long_name = sfc sensible heat flux for coupling units = W m-2 dimensions = (horizontal_dimension) type = real @@ -150,8 +142,8 @@ intent = in optional = F [dusfc] - standard_name = surface_x_momentum_flux_for_coupling_interstitial - long_name = sfc x momentum flux for coupling interstitial + standard_name = surface_x_momentum_flux_for_coupling + long_name = sfc x momentum flux for coupling units = Pa dimensions = (horizontal_dimension) type = real @@ -159,8 +151,8 @@ intent = in optional = F [dvsfc] - standard_name = surface_y_momentum_flux_for_coupling_interstitial - long_name = sfc y momentum flux for coupling interstitial + standard_name = surface_y_momentum_flux_for_coupling + long_name = sfc y momentum flux for coupling units = Pa dimensions = (horizontal_dimension) type = real diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 4cbf94245..c2ebf8257 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -175,9 +175,9 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) #endif z0max = max(1.0e-6, min(0.01 * z0rl_lnd(i), z1(i))) !** xubin's new z0 over land - tem1 = 1.0 - shdmax(i) - tem2 = tem1 * tem1 - tem1 = 1.0 - tem2 + tem1 = 1.0 - shdmax(i) + tem2 = tem1 * tem1 + tem1 = 1.0 - tem2 if( ivegsrc == 1 ) then @@ -220,11 +220,15 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) z0max = max(z0max, 1.0e-6) ! czilc = 10.0 ** (- (0.40/0.07) * z0) ! fei's canopy height dependance of czil - czilc = 0.8 +! czilc = 0.8 - tem1 = 1.0 - sigmaf(i) - ztmax = z0max*exp( - tem1*tem1 - & * czilc*ca*sqrt(ustar_lnd(i)*(0.01/1.5e-05))) +! tem1 = 1.0 - sigmaf(i) +! ztmax = z0max*exp( - tem1*tem1 +! & * czilc*ca*sqrt(ustar_lnd(i)*(0.01/1.5e-05))) +! + czilc = 10.0 ** (- 4. * z0max) ! Trier et al. (2011, WAF) + ztmax = z0max * exp( - czilc * ca + & * 258.2 * sqrt(ustar_lnd(i)*z0max) ) ! mg, sfc-perts: add surface perturbations to ztmax/z0max ratio over land @@ -246,9 +250,9 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) tvs = 0.5 * (tsurf_ice(i)+tskin_ice(i)) * virtfac z0max = max(1.0e-6, min(0.01 * z0rl_ice(i), z1(i))) !** xubin's new z0 over land and sea ice - tem1 = 1.0 - shdmax(i) - tem2 = tem1 * tem1 - tem1 = 1.0 - tem2 + tem1 = 1.0 - shdmax(i) + tem2 = tem1 * tem1 + tem1 = 1.0 - tem2 if( ivegsrc == 1 ) then @@ -261,11 +265,15 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! czilc = 10.0 ** (- (0.40/0.07) * z0) ! fei's canopy height ! dependance of czil - czilc = 0.8 +! czilc = 0.8 + +! tem1 = 1.0 - sigmaf(i) +! ztmax = z0max*exp( - tem1*tem1 +! & * czilc*ca*sqrt(ustar_ice(i)*(0.01/1.5e-05))) + czilc = 10.0 ** (- 4. * z0max) ! Trier et al. (2011, WAF) + ztmax = z0max * exp( - czilc * ca + & * 258.2 * sqrt(ustar_ice(i)*z0max) ) - tem1 = 1.0 - sigmaf(i) - ztmax = z0max*exp( - tem1*tem1 - & * czilc*ca*sqrt(ustar_ice(i)*(0.01/1.5e-05))) ztmax = max(ztmax, 1.0e-6) ! call stability @@ -281,11 +289,11 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! the stuff now put into "stability" if (wet(i)) then ! Some open ocean - tvs = 0.5 * (tsurf_ocn(i)+tskin_ocn(i)) * virtfac - z0 = 0.01 * z0rl_ocn(i) - z0max = max(1.0e-6, min(z0,z1(i))) + tvs = 0.5 * (tsurf_ocn(i)+tskin_ocn(i)) * virtfac + z0 = 0.01 * z0rl_ocn(i) + z0max = max(1.0e-6, min(z0,z1(i))) ustar_ocn(i) = sqrt(grav * z0 / charnock) - wind10m = sqrt(u10m(i)*u10m(i)+v10m(i)*v10m(i)) + wind10m = sqrt(u10m(i)*u10m(i)+v10m(i)*v10m(i)) !** test xubin's new z0 @@ -307,7 +315,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) call znot_t_v6(wind10m, ztmax) ! 10-m wind,m/s, ztmax(m) else if (sfc_z0_type == 7) then call znot_t_v7(wind10m, ztmax) ! 10-m wind,m/s, ztmax(m) - else if (sfc_z0_type /= 0) then + else if (sfc_z0_type > 0) then write(0,*)'no option for sfc_z0_type=',sfc_z0_type stop endif @@ -322,33 +330,35 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! ! update z0 over ocean ! - if (sfc_z0_type == 0) then - z0 = (charnock / grav) * ustar_ocn(i) * ustar_ocn(i) + if (sfc_z0_type >= 0) then + if (sfc_z0_type == 0) then + z0 = (charnock / grav) * ustar_ocn(i) * ustar_ocn(i) ! mbek -- toga-coare flux algorithm -! z0 = (charnock / grav) * ustar(i)*ustar(i) + arnu/ustar(i) +! z0 = (charnock / grav) * ustar(i)*ustar(i) + arnu/ustar(i) ! new implementation of z0 -! cc = ustar(i) * z0 / rnu -! pp = cc / (1. + cc) -! ff = grav * arnu / (charnock * ustar(i) ** 3) -! z0 = arnu / (ustar(i) * ff ** pp) - - if (redrag) then - z0rl_ocn(i) = 100.0 * max(min(z0, z0s_max), 1.e-7) +! cc = ustar(i) * z0 / rnu +! pp = cc / (1. + cc) +! ff = grav * arnu / (charnock * ustar(i) ** 3) +! z0 = arnu / (ustar(i) * ff ** pp) + + if (redrag) then + z0rl_ocn(i) = 100.0 * max(min(z0, z0s_max), 1.e-7) + else + z0rl_ocn(i) = 100.0 * max(min(z0,.1), 1.e-7) + endif + + elseif (sfc_z0_type == 6) then ! wang + call znot_m_v6(wind10m, z0) ! wind, m/s, z0, m + z0rl_ocn(i) = 100.0 * z0 ! cm + elseif (sfc_z0_type == 7) then ! wang + call znot_m_v7(wind10m, z0) ! wind, m/s, z0, m + z0rl_ocn(i) = 100.0 * z0 ! cm else - z0rl_ocn(i) = 100.0 * max(min(z0,.1), 1.e-7) + z0rl_ocn(i) = 1.0e-4 endif - elseif (sfc_z0_type == 6) then ! wang - call znot_m_v6(wind10m, z0) ! wind, m/s, z0, m - z0rl_ocn(i) = 100.0 * z0 ! cm - elseif (sfc_z0_type == 7) then ! wang - call znot_m_v7(wind10m, z0) ! wind, m/s, z0, m - z0rl_ocn(i) = 100.0 * z0 ! cm - else - z0rl_ocn(i) = 1.0e-4 endif - endif ! end of if(open ocean) ! endif ! end of if(flagiter) loop diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 3b4b8a118..a7436cb8f 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -130,11 +130,9 @@ end subroutine lsm_ruc_finalize !> \defgroup lsm_ruc_group GSD RUC LSM Model !! This module contains the RUC Land Surface Model developed by NOAA/GSD !! (Smirnova et al. 2016 \cite Smirnova_2016). -#if 0 !> \section arg_table_lsm_ruc_run Argument Table !! \htmlinclude lsm_ruc_run.html !! -#endif !>\section gen_lsmruc GSD RUC LSM General Algorithm ! DH* TODO - make order of arguments the same as in the metadata table subroutine lsm_ruc_run & ! inputs diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index 3ae9a57a3..6eaadfbb4 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -429,7 +429,7 @@ optional = F [qc] standard_name = cloud_condensed_water_mixing_ratio_at_lowest_model_layer - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water at lowest model layer + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) at lowest model layer units = kg kg-1 dimensions = (horizontal_dimension) type = real diff --git a/physics/sfc_noahmp_drv.f b/physics/sfc_noahmp_drv.f index 5ddd5aefc..bdba632bf 100644 --- a/physics/sfc_noahmp_drv.f +++ b/physics/sfc_noahmp_drv.f @@ -69,9 +69,6 @@ end subroutine noahmpdrv_finalize !! - Calculate the surface specific humidity and convert surface sensible and latent heat fluxes in W m-2 from their kinematic values. !! - If a "guess" run, restore the land-related prognostic fields. ! ! -! lheatstrg- logical, flag for canopy heat storage 1 ! -! parameterization ! -! ! !----------------------------------- subroutine noahmpdrv_run & !................................... @@ -80,7 +77,6 @@ subroutine noahmpdrv_run & & sigmaf, sfcemis, dlwflx, dswsfc, snet, delt, tg3, cm, ch, & & prsl1, prslki, zf, dry, wind, slopetyp, & & shdmin, shdmax, snoalb, sfalb, flag_iter, flag_guess, & - & lheatstrg, & & idveg, iopt_crs, iopt_btr, iopt_run, iopt_sfc, iopt_frz, & & iopt_inf, iopt_rad, iopt_alb, iopt_snf, iopt_tbot, & & iopt_stc, xlatin, xcoszin, iyrlen, julian, & @@ -169,8 +165,6 @@ subroutine noahmpdrv_run & real (kind=kind_phys), intent(in) :: delt logical, dimension(im), intent(in) :: flag_iter, flag_guess - logical, intent(in) :: lheatstrg - real (kind=kind_phys), intent(in) :: con_hvap, con_cp, con_jcal, & & rhoh2o, con_eps, con_epsm1, con_fvirt, & & con_rd, con_hfus @@ -270,8 +264,6 @@ subroutine noahmpdrv_run & & irb,tr,evc,chleaf,chuc,chv2,chb2, & & fpice,pahv,pahg,pahb,pah,co2pp,o2pp,ch2b - real (kind=kind_phys) :: cpfac - integer :: i, k, ice, stype, vtype ,slope,nroot,couple logical :: flag(im) logical :: snowng,frzgra @@ -660,11 +652,6 @@ subroutine noahmpdrv_run & call noahmp_options(idveg ,iopt_crs,iopt_btr,iopt_run,iopt_sfc, & & iopt_frz,iopt_inf,iopt_rad,iopt_alb,iopt_snf,iopt_tbot,iopt_stc) -! -! initialize heat capacity enhancement factor for heat storage parameterization -! - cpfac = 1.0 - if ( vtype == isice_table ) then ice = -1 @@ -752,7 +739,6 @@ subroutine noahmpdrv_run & & qc , swdn , lwdn ,& ! in : forcing & pconv , pnonc , pshcv , psnow , pgrpl , phail ,& ! in : forcing & tbot , co2pp , o2pp , foln , ficeold , zlvl ,& ! in : forcing - & lheatstrg ,& ! in : canopy heat storage & alboldx , sneqvox ,& ! in/out : & tsnsox , slsoil , smsoil , tahx , eahx , fwetx ,& ! in/out : & canliqx , canicex , tvx , tgx , qsfc1d , qsnowx ,& ! in/out : @@ -760,7 +746,7 @@ subroutine noahmpdrv_run & & zwtx , wax , wtx , wslakex , lfmassx , rtmassx,& ! in/out : & stmassx , woodx , stblcpx , fastcpx , xlaix ,xsaix ,& ! in/out : & cmx , chx , taussx ,& ! in/out : - & smcwtdx ,deeprechx, rechx , cpfac ,& ! in/out : + & smcwtdx ,deeprechx, rechx ,& ! in/out : & z0wrf ,& ! out & fsa , fsr , fira , fsh , ssoil , fcev ,& ! out : & fgev , fctr , ecan , etran , edir , trad ,& ! out : @@ -901,7 +887,7 @@ subroutine noahmpdrv_run & ! ssoil = -1.0 *ssoil call penman (sfctmp,sfcprs,chx,t2v,th2,prcp,fdown,ssoil, & - & cpfac,q2,q2sat,etp,snowng,frzgra,ffrozp,dqsdt2,emissi,fsno) + & q2,q2sat,etp,snowng,frzgra,ffrozp,dqsdt2,emissi,fsno) ep(i) = etp @@ -1170,7 +1156,7 @@ end subroutine transfer_mp_parameters !! partial sums/products are also calculated and passed back to the !! calling routine for later use. subroutine penman (sfctmp,sfcprs,ch,t2v,th2,prcp,fdown,ssoil, & - & cpfac,q2,q2sat,etp,snowng,frzgra,ffrozp, & + & q2,q2sat,etp,snowng,frzgra,ffrozp, & & dqsdt2,emissi_in,sncovr) ! etp is calcuated right after ssoil @@ -1181,12 +1167,11 @@ subroutine penman (sfctmp,sfcprs,ch,t2v,th2,prcp,fdown,ssoil, & implicit none logical, intent(in) :: snowng, frzgra real, intent(in) :: ch, dqsdt2,fdown,prcp,ffrozp, & - & q2, q2sat,ssoil,cpfac, sfcprs, sfctmp, & + & q2, q2sat,ssoil, sfcprs, sfctmp, & & t2v, th2,emissi_in,sncovr real, intent(out) :: etp real :: epsca,flx2,rch,rr,t24 real :: a, delta, fnet,rad,rho,emissi,elcp1,lvs - real :: elcpx real, parameter :: elcp = 2.4888e+3, lsubc = 2.501000e+6,cp = 1004.6 real, parameter :: lsubs = 2.83e+6, rd = 287.05, cph2o = 4.1855e+3 @@ -1200,12 +1185,11 @@ subroutine penman (sfctmp,sfcprs,ch,t2v,th2,prcp,fdown,ssoil, & ! prepare partial quantities for penman equation. ! ---------------------------------------------------------------------- emissi=emissi_in - elcpx = elcp / cpfac -! elcp1 = (1.0-sncovr)*elcpx + sncovr*elcpx*lsubs/lsubc +! elcp1 = (1.0-sncovr)*elcp + sncovr*elcp*lsubs/lsubc lvs = (1.0-sncovr)*lsubc + sncovr*lsubs flx2 = 0.0 - delta = elcpx * dqsdt2 + delta = elcp * dqsdt2 ! delta = elcp1 * dqsdt2 t24 = sfctmp * sfctmp * sfctmp * sfctmp rr = t24 * 6.48e-8 / (sfcprs * ch) + 1.0 @@ -1216,7 +1200,7 @@ subroutine penman (sfctmp,sfcprs,ch,t2v,th2,prcp,fdown,ssoil, & ! adjust the partial sums / products with the latent heat ! effects caused by falling precipitation. ! ---------------------------------------------------------------------- - rch = rho * cp * cpfac * ch + rch = rho * cp * ch if (.not. snowng) then if (prcp > 0.0) rr = rr + cph2o * prcp / rch else @@ -1239,7 +1223,7 @@ subroutine penman (sfctmp,sfcprs,ch,t2v,th2,prcp,fdown,ssoil, & ! ---------------------------------------------------------------------- end if rad = fnet / rch + th2- sfctmp - a = elcpx * (q2sat - q2) + a = elcp * (q2sat - q2) ! a = elcp1 * (q2sat - q2) epsca = (a * rr + rad * delta) / (delta + rr) etp = epsca * rch / lsubc diff --git a/physics/sfc_noahmp_drv.meta b/physics/sfc_noahmp_drv.meta index 066bc1e87..1fdee7a4a 100644 --- a/physics/sfc_noahmp_drv.meta +++ b/physics/sfc_noahmp_drv.meta @@ -325,14 +325,6 @@ type = logical intent = in optional = F -[lheatstrg] - standard_name = flag_for_canopy_heat_storage - long_name = flag for canopy heat storage parameterization - units = flag - dimensions = () - type = logical - intent = in - optional = F [idveg] standard_name = flag_for_dynamic_vegetation_option long_name = choice for dynamic vegetation option (see noahmp module for definition) diff --git a/physics/sfc_nst.f b/physics/sfc_nst.f index ed43a719d..b2fcb0948 100644 --- a/physics/sfc_nst.f +++ b/physics/sfc_nst.f @@ -29,19 +29,16 @@ end subroutine sfc_nst_finalize !! \section NSST_general_algorithm GFS Near-Surface Sea Temperature Scheme General Algorithm !> @{ subroutine sfc_nst_run & -! --- inputs: - & ( im, hvap, cp, hfus, jcal, eps, epsm1, rvrdm1, rd, rhw0, & + & ( im, hvap, cp, hfus, jcal, eps, epsm1, rvrdm1, rd, rhw0, & ! --- inputs: & pi, sbc, ps, u1, v1, t1, q1, tref, cm, ch, & & prsl1, prslki, prsik1, prslk1, wet, xlon, sinlat, & & stress, & & sfcemis, dlwflx, sfcnsw, rain, timestep, kdt, solhr,xcosz, & & wind, flag_iter, flag_guess, nstf_name1, nstf_name4, & & nstf_name5, lprnt, ipr, & -! --- input/output: - & tskin, tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, & + & tskin, tsurf, xt, xs, xu, xv, xz, zm, xtts, xzts, dt_cool, & ! --- input/output: & z_c, c_0, c_d, w_0, w_d, d_conv, ifd, qrain, & -! --- outputs: - & qsurf, gflux, cmm, chh, evap, hflx, ep, errmsg, errflg & + & qsurf, gflux, cmm, chh, evap, hflx, ep, errmsg, errflg & ! --- outputs: & ) ! ! ===================================================================== ! @@ -252,9 +249,9 @@ subroutine sfc_nst_run & errmsg = '' errflg = 0 - cpinv=1.0/cp - hvapi=1.0/hvap - elocp=hvap/cp + cpinv = 1.0/cp + hvapi = 1.0/hvap + elocp = hvap/cp sss = 34.0 ! temporarily, when sea surface salinity data is not ready ! @@ -676,7 +673,7 @@ end subroutine sfc_nst_pre_finalize !! @{ subroutine sfc_nst_pre_run & (im, wet, tsfc_ocn, tsurf_ocn, tseal, xt, xz, dt_cool, - & z_c, tref, cplflx, errmsg, errflg) + & z_c, tref, cplflx, oceanfrac, errmsg, errflg) use machine , only : kind_phys @@ -686,7 +683,7 @@ subroutine sfc_nst_pre_run integer, intent(in) :: im logical, dimension(im), intent(in) :: wet real (kind=kind_phys), dimension(im), intent(in) :: - & tsfc_ocn, xt, xz, dt_cool, z_c + & tsfc_ocn, xt, xz, dt_cool, z_c, oceanfrac logical, intent(in) :: cplflx ! --- input/outputs: @@ -724,7 +721,7 @@ subroutine sfc_nst_pre_run if (cplflx) then tem1 = half / omz1 do i=1,im - if (wet(i)) then + if (wet(i) .and. oceanfrac(i) > zero) then tem2 = one / xz(i) dt_warm = (xt(i)+xt(i)) * tem2 if ( xz(i) > omz1) then @@ -777,7 +774,7 @@ end subroutine sfc_nst_post_finalize ! \section NSST_detailed_post_algorithm Detailed Algorithm ! @{ subroutine sfc_nst_post_run & - & ( im, rlapse, wet, icy, oro, oro_uf, nstf_name1, & + & ( im, rlapse, tgice, wet, icy, oro, oro_uf, nstf_name1, & & nstf_name4, nstf_name5, xt, xz, dt_cool, z_c, tref, xlon, & & tsurf_ocn, tsfc_ocn, dtzm, errmsg, errflg & & ) @@ -790,7 +787,7 @@ subroutine sfc_nst_post_run & ! --- inputs: integer, intent(in) :: im logical, dimension(im), intent(in) :: wet, icy - real (kind=kind_phys), intent(in) :: rlapse + real (kind=kind_phys), intent(in) :: rlapse, tgice real (kind=kind_phys), dimension(im), intent(in) :: oro, oro_uf integer, intent(in) :: nstf_name1, nstf_name4, nstf_name5 real (kind=kind_phys), dimension(im), intent(in) :: xt, xz, & @@ -838,7 +835,7 @@ subroutine sfc_nst_post_run & ! if (wet(i) .and. .not.icy(i)) then ! if (wet(i) .and. (Model%frac_grid .or. .not. icy(i))) then if (wet(i)) then - tsfc_ocn(i) = max(271.2, tref(i) + dtzm(i)) + tsfc_ocn(i) = max(tgice, tref(i) + dtzm(i)) ! tsfc_ocn(i) = max(271.2, tref(i) + dtzm(i)) - & ! (oro(i)-oro_uf(i))*rlapse endif diff --git a/physics/sfc_nst.meta b/physics/sfc_nst.meta index d74f68c0e..ac75aa05d 100644 --- a/physics/sfc_nst.meta +++ b/physics/sfc_nst.meta @@ -759,6 +759,15 @@ type = logical intent = in optional = F +[oceanfrac] + standard_name = sea_area_fraction + long_name = fraction of horizontal grid area occupied by ocean + units = frac + dimensions = (horizontal_dimension) + type = real + kind = kind_phys + intent = in + optional = F [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP @@ -808,6 +817,15 @@ kind = kind_phys intent = in optional = F +[tgice] + standard_name = freezing_point_temperature_of_seawater + long_name = freezing point temperature of seawater + units = K + dimensions = () + type = real + kind = kind_phys + intent = in + optional = F [wet] standard_name = flag_nonzero_wet_surface_fraction long_name = flag indicating presence of some ocean or lake surface area fraction diff --git a/physics/sfc_ocean.F b/physics/sfc_ocean.F index 9635f30b8..e21ddb3a7 100644 --- a/physics/sfc_ocean.F +++ b/physics/sfc_ocean.F @@ -1,3 +1,9 @@ +!>\file sfc_ocean.F +!! This file contains an alternative GFS near-surface sea temperature +!! scheme when the model is initialized from GRIB2 data. + +!> This module contains the CCPP-compliant GFS near-surface sea temperature +!! scheme when the model is initialized from GRIB2 data. module sfc_ocean implicit none private @@ -15,19 +21,17 @@ end subroutine sfc_ocean_init subroutine sfc_ocean_finalize() end subroutine sfc_ocean_finalize -#if 0 +!>\defgroup gfs_ocean_main GFS Simple Ocean Scheme Module +!! This subroutine calculates thermodynamical properties over +!! open water. !! \section arg_table_sfc_ocean_run Argument Table !! \htmlinclude sfc_ocean_run.html !! -#endif subroutine sfc_ocean_run & -!................................... -! --- inputs: - & ( im, cp, rd, eps, epsm1, hvap, rvrdm1, ps, t1, q1, & + & ( im, cp, rd, eps, epsm1, hvap, rvrdm1, ps, t1, q1, & ! --- inputs & tskin, cm, ch, prsl1, prslki, wet, wind, & & flag_iter, & -! --- outputs: - & qsurf, cmm, chh, gflux, evap, hflx, ep, & + & qsurf, cmm, chh, gflux, evap, hflx, ep, & ! --- outputs & errmsg, errflg & & ) diff --git a/physics/sflx.f b/physics/sflx.f index 6a5914d02..2740a70ff 100644 --- a/physics/sflx.f +++ b/physics/sflx.f @@ -172,7 +172,6 @@ subroutine gfssflx &! --- input ! consolidated constents/parameters by using ! ! module physcons, and added program documentation! ! sep 2009 -- s. moorthi minor fixes ! -! nov 2018 -- j. han add canopy heat storage parameterization ! ! ! ! ==================== defination of variables ==================== ! ! ! @@ -345,12 +344,6 @@ subroutine gfssflx &! --- input integer :: ice, k, kz ! -! --- parameters for heat storage parametrization -! - real (kind=kind_phys) :: cpx, cpx1, cpfac, xx1, xx2 - real (kind=kind_phys), parameter :: z0min=0.2_kind_phys, & - & z0max=1.0_kind_phys -! !===> ... begin here ! ! --- ... initialization @@ -681,7 +674,11 @@ subroutine gfssflx &! --- input !! overlying green canopy, adapted from section 2.1.2 of !! \cite peters-lidard_et_al_1997. !wz only urban for igbp type - if(ivegsrc == 1 .and. vegtyp == 13) then +! +!jhan urban canopy heat storage effect is included in pbl scheme +! + if((.not.lheatstrg) .and. & + & (ivegsrc == 1 .and. vegtyp == 13)) then df1 = 3.24*(1.-shdfac) + shdfac*df1*exp(sbeta*shdfac) else df1 = df1 * exp( sbeta*shdfac ) @@ -811,22 +808,6 @@ subroutine gfssflx &! --- input fdown = swnet + lwdn endif ! end if_couple_block -! -! --- enhance cp as a function of z0 to mimic heat storage -! - cpx = cp - cpx1 = cp1 - cpfac = 1.0 - if (lheatstrg) then - if ((ivegsrc == 1 .and. vegtyp /= 13) - & .or. ivegsrc == 2) then - xx1 = (z0 - z0min) / (z0max - z0min) - xx2 = 1.0 + min(max(xx1, 0.0), 1.0) - cpx = cp * xx2 - cpx1 = cp1 * xx2 - cpfac = cp / cpx - endif - endif !> - Call penman() to calculate potential evaporation (\a etp), !! and other partial products and sums for later @@ -835,7 +816,7 @@ subroutine gfssflx &! --- input call penman ! --- inputs: ! ! ( sfctmp, sfcprs, sfcems, ch, t2v, th2, prcp, fdown, ! -! cpx, cpfac, ssoil, q2, q2sat, dqsdt2, snowng, frzgra, ! +! ssoil, q2, q2sat, dqsdt2, snowng, frzgra, ! ! --- outputs: ! ! t24, etp, rch, epsca, rr, flx2 ) ! @@ -850,7 +831,7 @@ subroutine gfssflx &! --- input call canres ! --- inputs: ! ! ( nsoil, nroot, swdn, ch, q2, q2sat, dqsdt2, sfctmp, ! -! cpx1, sfcprs, sfcems, sh2o, smcwlt, smcref, zsoil, rsmin, ! +! sfcprs, sfcems, sh2o, smcwlt, smcref, zsoil, rsmin, ! ! rsmax, topt, rgl, hs, xlai, ! ! --- outputs: ! ! rc, pc, rcs, rct, rcq, rcsoil ) ! @@ -872,7 +853,7 @@ subroutine gfssflx &! --- input ! smcdry, cmcmax, dt, shdfac, sbeta, sfctmp, sfcems, ! ! t24, th2, fdown, epsca, bexp, pc, rch, rr, cfactr, ! ! slope, kdt, frzx, psisat, zsoil, dksat, dwsat, ! -! zbot, ice, rtdis, quartz, fxexp, csoil, ! +! zbot, ice, rtdis, quartz, fxexp, csoil, lheatstrg, ! ! --- input/outputs: ! ! cmc, t1, stc, sh2o, tbot, ! ! --- outputs: ! @@ -888,7 +869,7 @@ subroutine gfssflx &! --- input ! cmcmax, dt, df1, sfcems, sfctmp, t24, th2, fdown, epsca, ! ! bexp, pc, rch, rr, cfactr, slope, kdt, frzx, psisat, ! ! zsoil, dwsat, dksat, zbot, shdfac, ice, rtdis, quartz, ! -! fxexp, csoil, flx2, snowng, ! +! fxexp, csoil, flx2, snowng, lheatstrg, ! ! --- input/outputs: ! ! prcp1, cmc, t1, stc, sncovr, sneqv, sndens, snowh, ! ! sh2o, tbot, beta, ! @@ -1074,7 +1055,7 @@ end subroutine alcalc subroutine canres ! --- inputs: ! & ( nsoil, nroot, swdn, ch, q2, q2sat, dqsdt2, sfctmp, & -! & cpx1, sfcprs, sfcems, sh2o, smcwlt, smcref, zsoil, rsmin, & +! & sfcprs, sfcems, sh2o, smcwlt, smcref, zsoil, rsmin, & ! & rsmax, topt, rgl, hs, xlai, & ! --- outputs: ! & rc, pc, rcs, rct, rcq, rcsoil & @@ -1107,7 +1088,6 @@ subroutine canres ! q2sat - real, sat. air humidity at 1st level abv ground 1 ! ! dqsdt2 - real, slope of sat. humidity function wrt temp 1 ! ! sfctmp - real, sfc temperature at 1st level above ground 1 ! -! cpx1 - real, enhanced air heat capacity for heat storage 1 ! ! sfcprs - real, sfc pressure 1 ! ! sfcems - real, sfc emissivity for lw radiation 1 ! ! sh2o - real, volumetric soil moisture nsoil ! @@ -1213,8 +1193,8 @@ subroutine canres ! evaporation (containing rc term). rc = rsmin / (xlai*rcs*rct*rcq*rcsoil) - rr = (4.0*sfcems*sigma1*rd1/cpx1) * (sfctmp**4.0)/(sfcprs*ch) + 1.0 - delta = (lsubc/cpx1) * dqsdt2 + rr = (4.0*sfcems*sigma1*rd1/cp1) * (sfctmp**4.0)/(sfcprs*ch) + 1.0 + delta = (lsubc/cp1) * dqsdt2 pc = (rr + delta) / (rr*(1.0 + rc*ch) + delta) ! @@ -1299,7 +1279,7 @@ subroutine nopac ! & smcdry, cmcmax, dt, shdfac, sbeta, sfctmp, sfcems, & ! & t24, th2, fdown, epsca, bexp, pc, rch, rr, cfactr, & ! & slope, kdt, frzx, psisat, zsoil, dksat, dwsat, & -! & zbot, ice, rtdis, quartz, fxexp, csoil, & +! & zbot, ice, rtdis, quartz, fxexp, csoil, lheatstrg, & ! --- input/outputs: ! & cmc, t1, stc, sh2o, tbot, & ! --- outputs: @@ -1356,6 +1336,8 @@ subroutine nopac ! quartz - real, soil quartz content 1 ! ! fxexp - real, bare soil evaporation exponent 1 ! ! csoil - real, soil heat capacity 1 ! +! lheatstrg- logical, flag for canopy heat storage 1 ! +! parameterization ! ! ! ! input/outputs from and to the calling program: ! ! cmc - real, canopy moisture content 1 ! @@ -1393,6 +1375,8 @@ subroutine nopac ! & zsoil(nsoil), dksat, dwsat, zbot, rtdis(nsoil), & ! & quartz, fxexp, csoil +! logical, intent(in) :: lheatstrg + ! --- input/outputs: ! real (kind=kind_phys), intent(inout) :: cmc, t1, stc(nsoil), & ! & sh2o(nsoil), tbot @@ -1522,7 +1506,11 @@ subroutine nopac ! sub sfc heat flux (see additional comments on veg effect ! sub-sfc heat flx in routine sflx) !wz only urban for igbp type - if(ivegsrc == 1 .and. vegtyp == 13) then +! +!jhan urban canopy heat storage effect is included in pbl scheme +! + if((.not.lheatstrg) .and. & + & (ivegsrc == 1 .and. vegtyp == 13)) then df1 = 3.24*(1.-shdfac) + shdfac*df1*exp(sbeta*shdfac) else df1 = df1 * exp( sbeta*shdfac ) @@ -1539,6 +1527,7 @@ subroutine nopac ! --- inputs: & ( nsoil, smc, smcmax, dt, yy, zz1, zsoil, zbot, & & psisat, bexp, df1, ice, quartz, csoil, vegtyp, & + & shdfac, lheatstrg, & ! --- input/outputs: & stc, t1, tbot, sh2o, & ! --- outputs: @@ -1567,7 +1556,7 @@ subroutine penman !................................... ! --- inputs: ! & ( sfctmp, sfcprs, sfcems, ch, t2v, th2, prcp, fdown, & -! & cpx, cpfac, ssoil, q2, q2sat, dqsdt2, snowng, frzgra, & +! & ssoil, q2, q2sat, dqsdt2, snowng, frzgra, & ! --- outputs: ! & t24, etp, rch, epsca, rr, flx2 & ! & ) @@ -1593,8 +1582,6 @@ subroutine penman ! th2 - real, air potential temp at zlvl abv grnd 1 ! ! prcp - real, precip rate 1 ! ! fdown - real, net solar + downward lw flux at sfc 1 ! -! cpx - real, enhanced air heat capacity for heat storage 1 ! -! cpfac - real, ratio air heat capacity to enhanced one 1 ! ! ssoil - real, upward soil heat flux 1 ! ! q2 - real, mixing ratio at hght zlvl abv ground 1 ! ! q2sat - real, sat mixing ratio at zlvl abv ground 1 ! @@ -1632,11 +1619,11 @@ subroutine penman ! --- ... prepare partial quantities for penman equation. - delta = elcp * cpfac * dqsdt2 + delta = elcp * dqsdt2 t24 = sfctmp * sfctmp * sfctmp * sfctmp rr = t24 * 6.48e-8 / (sfcprs*ch) + 1.0 rho = sfcprs / (rd1*t2v) - rch = rho * cpx * ch + rch = rho * cp * ch ! --- ... adjust the partial sums / products with the latent heat ! effects caused by falling precipitation. @@ -1662,7 +1649,7 @@ subroutine penman ! --- ... finish penman equation calculations. rad = fnet/rch + th2 - sfctmp - a = elcp * cpfac * (q2sat - q2) + a = elcp * (q2sat - q2) epsca = (a*rr + rad*delta) / (delta + rr) etp = epsca * rch / lsubc ! @@ -2336,7 +2323,7 @@ subroutine snopac ! & cmcmax, dt, df1, sfcems, sfctmp, t24, th2, fdown, epsca, & ! & bexp, pc, rch, rr, cfactr, slope, kdt, frzx, psisat, & ! & zsoil, dwsat, dksat, zbot, shdfac, ice, rtdis, quartz, & -! & fxexp, csoil, flx2, snowng, & +! & fxexp, csoil, flx2, snowng, lheatstrg, & ! --- input/outputs: ! & prcp1, cmc, t1, stc, sncovr, sneqv, sndens, snowh, & ! & sh2o, tbot, beta, & @@ -2396,6 +2383,8 @@ subroutine snopac ! csoil - real, soil heat capacity 1 ! ! flx2 - real, freezing rain latent heat flux 1 ! ! snowng - logical, snow flag 1 ! +! lheatstrg- logical, flag for canopy heat storage 1 ! +! parameterization ! ! ! ! input/outputs from and to the calling program: ! ! prcp1 - real, effective precip 1 ! @@ -2442,6 +2431,9 @@ subroutine snopac ! & csoil, fxexp, flx2, zsoil(nsoil), rtdis(nsoil) ! logical, intent(in) :: snowng +! +! logical, intent(in) :: lheatstrg +! ! --- input/outputs: ! real (kind=kind_phys), intent(inout) :: prcp1, t1, sncovr, sneqv, & @@ -2758,6 +2750,7 @@ subroutine snopac ! --- inputs: & ( nsoil, smc, smcmax, dt, yy, zz1, zsoil, zbot, & & psisat, bexp, df1, ice, quartz, csoil, vegtyp, & + & shdfac, lheatstrg, & ! --- input/outputs: & stc, t11, tbot, sh2o, & ! --- outputs: @@ -3278,6 +3271,7 @@ subroutine shflx & ! --- inputs: & ( nsoil, smc, smcmax, dt, yy, zz1, zsoil, zbot, & & psisat, bexp, df1, ice, quartz, csoil, vegtyp, & + & shdfac, lheatstrg, & ! --- input/outputs: & stc, t1, tbot, sh2o, & ! --- outputs: @@ -3312,6 +3306,9 @@ subroutine shflx & ! quartz - real, soil quartz content 1 ! ! csoil - real, soil heat capacity 1 ! ! vegtyp - integer, vegtation type 1 ! +! shdfac - real, aeral coverage of green vegetation 1 ! +! lheatstrg- logical, flag for canopy heat storage 1 ! +! parameterization ! ! ! ! input/outputs: ! ! stc - real, soil temp nsoil ! @@ -3332,7 +3329,10 @@ subroutine shflx & integer, intent(in) :: nsoil, ice, vegtyp real (kind=kind_phys), intent(in) :: smc(nsoil), smcmax, dt, yy, & - & zz1, zsoil(nsoil), zbot, psisat, bexp, df1, quartz, csoil + & zz1, zsoil(nsoil), zbot, psisat, bexp, df1, quartz, csoil, & + & shdfac + + logical, intent(in) :: lheatstrg ! --- input/outputs: real (kind=kind_phys), intent(inout) :: stc(nsoil), t1, tbot, & @@ -3387,7 +3387,7 @@ subroutine shflx & ! --- inputs: & ( nsoil, stc, smc, smcmax, zsoil, yy, zz1, tbot, & & zbot, psisat, dt, bexp, df1, quartz, csoil,vegtyp, & - & shdfac, & + & shdfac, lheatstrg, & ! --- input/outputs: & sh2o, & ! --- outputs: @@ -4054,7 +4054,7 @@ subroutine hrt & ! --- inputs: & ( nsoil, stc, smc, smcmax, zsoil, yy, zz1, tbot, & & zbot, psisat, dt, bexp, df1, quartz, csoil, vegtyp, & - & shdfac, & + & shdfac, lheatstrg, & ! --- input/outputs: & sh2o, & ! --- outputs: @@ -4091,6 +4091,9 @@ subroutine hrt & ! quartz - real, soil quartz content 1 ! ! csoil - real, soil heat capacity 1 ! ! vegtyp - integer, vegetation type 1 ! +! shdfac - real, aeral coverage of green vegetation 1 ! +! lheatstrg- logical, flag for canopy heat storage 1 ! +! parameterization ! ! ! ! input/outputs: ! ! sh2o - real, unfrozen soil moisture nsoil ! @@ -4110,6 +4113,8 @@ subroutine hrt & & smcmax, zsoil(nsoil), yy, zz1, tbot, zbot, psisat, dt, & & bexp, df1, quartz, csoil, shdfac + logical, intent(in) :: lheatstrg + ! --- input/outputs: real (kind=kind_phys), intent(inout) :: sh2o(nsoil) @@ -4131,8 +4136,11 @@ subroutine hrt & ! csoil_loc=csoil - if (ivegsrc == 1)then + if (.not.lheatstrg .and. ivegsrc == 1)then !urban +! +!jhan urban canopy heat storage effect is included in pbl scheme +! if( vegtyp == 13 ) then ! csoil_loc=3.0e6 csoil_loc=3.0e6*(1.-shdfac)+csoil*shdfac ! gvf @@ -4225,7 +4233,7 @@ subroutine hrt & call snksrc & ! --- inputs: & ( nsoil, 1, tavg, smc(1), smcmax, psisat, bexp, dt, & - & qtot, zsoil, shdfac, & + & qtot, zsoil, & ! --- input/outputs: & sh2o(1), & ! --- outputs: @@ -4271,7 +4279,11 @@ subroutine hrt & ! if ( vegtyp == 13 ) df1n = 3.24 ! endif !wz only urban for igbp type - if(ivegsrc == 1 .and. vegtyp == 13) then +! +!jhan urban canopy heat storage effect is included in pbl scheme +! + if((.not.lheatstrg) .and. + & (ivegsrc == 1 .and. vegtyp == 13)) then df1n = 3.24*(1.-shdfac) + shdfac*df1n endif @@ -4315,7 +4327,11 @@ subroutine hrt & ! if ( vegtyp == 13 ) df1n = 3.24 ! endif !wz only urban for igbp type - if(ivegsrc == 1 .and. vegtyp == 13) then +! +!jhan urban canopy heat storage effect is included in pbl scheme +! + if((.not.lheatstrg) .and. + & (ivegsrc == 1 .and. vegtyp == 13)) then df1n = 3.24*(1.-shdfac) + shdfac*df1n endif @@ -4371,7 +4387,7 @@ subroutine hrt & call snksrc & ! --- inputs: & ( nsoil, k, tavg, smc(k), smcmax, psisat, bexp, dt, & - & qtot, zsoil, shdfac, & + & qtot, zsoil, & ! --- input/outputs: & sh2o(k), & ! --- outputs: @@ -4786,7 +4802,7 @@ end subroutine rosr12 subroutine snksrc & ! --- inputs: & ( nsoil, k, tavg, smc, smcmax, psisat, bexp, dt, & - & qtot, zsoil, shdfac, & + & qtot, zsoil, & ! --- input/outputs: & sh2o, & ! --- outputs: @@ -4831,7 +4847,7 @@ subroutine snksrc & integer, intent(in) :: nsoil, k real (kind=kind_phys), intent(in) :: tavg, smc, smcmax, psisat, & - & bexp, dt, qtot, zsoil(nsoil), shdfac + & bexp, dt, qtot, zsoil(nsoil) ! --- input/outputs: real (kind=kind_phys), intent(inout) :: sh2o @@ -4844,15 +4860,6 @@ subroutine snksrc & ! --- external functions: ! real (kind=kind_phys) :: frh2o - -!urban -! if (ivegsrc == 1)then -! if ( vegtyp == 13 ) df1=3.24 -! endif -!wz only urban for igbp type - if(ivegsrc == 1 .and. vegtyp == 13) then - df1 = 3.24*(1.-shdfac) + shdfac*df1 - endif ! !===> ... begin here ! diff --git a/physics/shalcnv.meta b/physics/shalcnv.meta index a8f8a8ba3..e0d806a5c 100644 --- a/physics/shalcnv.meta +++ b/physics/shalcnv.meta @@ -238,7 +238,7 @@ optional = F [qlc] standard_name = cloud_condensed_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of cloud water (condensate) in the convectively transported tracer array + long_name = ratio of mass of cloud water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -247,7 +247,7 @@ optional = F [qli] standard_name = ice_water_mixing_ratio_convective_transport_tracer - long_name = moist (dry+vapor, no condensates) mixing ratio of ice water in the convectively transported tracer array + long_name = ratio of mass of ice water to mass of dry air plus vapor (without condensates) in the convectively transported tracer array units = kg kg-1 dimensions = (horizontal_dimension,vertical_dimension) type = real @@ -358,7 +358,7 @@ intent = in optional = F [heat] - standard_name = kinematic_surface_upward_sensible_heat_flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 dimensions = (horizontal_dimension) @@ -367,7 +367,7 @@ intent = in optional = F [evap] - standard_name = kinematic_surface_upward_latent_heat_flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 dimensions = (horizontal_dimension) diff --git a/physics/shinhongvdif.meta b/physics/shinhongvdif.meta index e859fca4d..4ce047aa2 100644 --- a/physics/shinhongvdif.meta +++ b/physics/shinhongvdif.meta @@ -237,7 +237,7 @@ intent = in optional = F [heat] - standard_name = kinematic_surface_upward_sensible_heat_flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 dimensions = (horizontal_dimension) @@ -246,7 +246,7 @@ intent = in optional = F [evap] - standard_name = kinematic_surface_upward_latent_heat_flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 dimensions = (horizontal_dimension) diff --git a/physics/tridi.f b/physics/tridi.f index 22a35ea9c..bd44bcc86 100644 --- a/physics/tridi.f +++ b/physics/tridi.f @@ -42,6 +42,7 @@ end subroutine tridi1 c----------------------------------------------------------------------- !>\ingroup satmedmf +!>\ingroup satmedmfvdifq !> This subroutine .. subroutine tridi2(l,n,cl,cm,cu,r1,r2,au,a1,a2) cc @@ -84,6 +85,7 @@ end subroutine tridi2 c----------------------------------------------------------------------- !>\ingroup satmedmf +!>\ingroup satmedmfvdifq !> Routine to solve the tridiagonal system to calculate u- and !! v-momentum at \f$ t + \Delta t \f$; part of two-part process to !! calculate time tendencies due to vertical diffusion. @@ -154,6 +156,7 @@ end subroutine tridin c----------------------------------------------------------------------- !>\ingroup satmedmf +!>\ingroup satmedmfvdifq !! This subroutine solves tridiagonal problem for TKE. subroutine tridit(l,n,nt,cl,cm,cu,rt,au,at) !----------------------------------------------------------------------- diff --git a/physics/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index 52e545af4..af19447dc 100644 --- a/physics/ugwp_driver_v0.F +++ b/physics/ugwp_driver_v0.F @@ -8,7 +8,8 @@ module sso_coorde use machine, only: kind_phys real(kind=kind_phys),parameter :: pgwd = 1._kind_phys real(kind=kind_phys),parameter :: pgwd4 = 1._kind_phys - end module sso_coorde + logical,parameter :: debugprint = .false. + end module sso_coorde ! ! ! Routine cires_ugwp_driver_v0 is replaced with cires_ugwp.F90/cires_ugwp_run in CCPP @@ -31,12 +32,12 @@ subroutine cires_ugwp_driver_v0(me, master, !----------------------------------------------------------- use machine, only : kind_phys use physcons, only : con_cp, con_g, con_rd, con_rv - + use ugwp_wmsdis_init, only : tamp_mpa, ilaunch - use sso_coorde, only : pgwd, pgwd4 + use sso_coorde, only : pgwd, pgwd4, debugprint implicit none !input - + integer, intent(in) :: me, master integer, intent(in) :: im, levs, kdt, imx, nmtvr, ntke, ipr @@ -47,8 +48,8 @@ subroutine cires_ugwp_driver_v0(me, master, &, sgh30, sinlat, coslat, spgrid ! spgrid = tile-area &, rain - real(kind=kind_phys), intent(in), dimension(im,levs) :: ugrs - &, vgrs, tgrs, qgrs, prsl, prslk, phil, del + real(kind=kind_phys), intent(in), dimension(im,levs) :: + &, ugrs, vgrs, tgrs, qgrs, prsl, prslk, phil, del real(kind=kind_phys), intent(in), dimension(im,levs+1) :: & phii, prsi @@ -91,7 +92,7 @@ subroutine cires_ugwp_driver_v0(me, master, ! ! switches for GW-effects: pogw=1 (OGWs) pngw=1 (NGWs) pked=1 (eddy mixing) ! - if (me == master .and. kdt < 2) then + if (me == master .and. kdt < 2 .and. debugprint) then print * write(6,*) 'FV3GFS execute ugwp_driver_v0 ' ! write(6,*) 'FV3GFS execute ugwp_driver_v0 nmtvr=', nmtvr @@ -100,7 +101,7 @@ subroutine cires_ugwp_driver_v0(me, master, write(6,*) ' COORDE EXPER pgwd4 = ', pgwd4 print * endif - + do i=1,im zlwb(i) = 0. enddo @@ -120,7 +121,7 @@ subroutine cires_ugwp_driver_v0(me, master, & zmtb, zogw, tau_mtb, tau_ogw, tau_tofd, & du3dt_mtb, du3dt_ogw, du3dt_tms) ! - if (me == master .and. kdt < 2) then + if (me == master .and. kdt < 2 .and. debugprint) then print * write(6,*) 'FV3GFS finished gwdps_v0 in ugwp_driver_v0 ' print * @@ -155,13 +156,14 @@ subroutine cires_ugwp_driver_v0(me, master, ! GMAO GEOS-5/MERRA GW-forcing lat-dep !-------- call slat_geos5_tamp(im, tamp_mpa, xlatd, tau_ngw) - + ! call slat_geos5(im, xlatd, tau_ngw) ! if (abs(1.0-cdmbgwd(3)) > 1.0e-6) then if (cdmbgwd(4) > 0.0) then do i=1,im turb_fac(i) = 0.0 + tem(i) = 0.0 enddo if (ntke > 0) then do k=1,(levs+levs)/3 @@ -191,7 +193,7 @@ subroutine cires_ugwp_driver_v0(me, master, & gw_dudt, gw_dvdt, gw_dTdt, gw_kdis, & tau_ngw, me, master, kdt) - if (me == master .and. kdt < 2) then + if (me == master .and. kdt < 2 .and. debugprint) then print * write(6,*)'FV3GFS finished fv3_ugwp_v0 in ugwp_driver_v0 ' write(6,*) ' non-stationary GWs with GMAO/MERRA GW-forcing ' @@ -215,7 +217,7 @@ subroutine cires_ugwp_driver_v0(me, master, enddo enddo endif - + if (pogw == 0.0) then ! zmtb = 0.; zogw =0. tau_mtb = 0.0 ; tau_ogw = 0.0 ; tau_tofd = 0.0 @@ -223,7 +225,7 @@ subroutine cires_ugwp_driver_v0(me, master, endif return - + !============================================================================= ! make "ugwp eddy-diffusion" update for gw_dtdt/gw_dudt/gw_dvdt by solving ! vert diffusion equations & update "Statein%tgrs, Statein%ugrs, Statein%vgrs" @@ -254,15 +256,28 @@ subroutine cires_ugwp_driver_v0(me, master, end subroutine cires_ugwp_driver_v0 #endif -! -!===================================================================== +! +!===================================================================== ! !ugwp-v0 subroutines: GWDPS_V0 and fv3_ugwp_solv2_v0 -! +! !===================================================================== !>\ingroup cires_ugwp_run !> @{ -!!Note for the sub-grid scale orography scheme in UGWP-v0: Due to degraded forecast scores of simulations with revised schemes for subgrid-scale orography effects in FV3GFS, EMC reinstalled the original gwdps-code with updated efficiency factors for the mountain blocking and OGW drag. The GFS OGW is described in the separate section (\ref GFS_GWDPS) and its “call” moved into UGWP-driver subroutine. This combination of NGW and OGW schemes was tested in the FV3GFS-L127 medium-range forecasts (15-30 days) for C96, C192, C384 and C768 resolutions and work in progress to introduce the optimal choice for the scale-aware representations of the efficiency factors that will reflect the better simulations of GW activity by FV3 dynamical core at higher horizontal resolutions. With the MERRA-2 VMF function for NGWs (\ref slat_geos5_tamp) and operational OGW drag scheme (\ref GFS_GWDPS), FV3GFS simulations can successfully forecast the recent major mid-winter sudden stratospheric warming (SSW) events of 2018-02-12 and 2018-12-31 (10-14 days before the SSW onset; Yudin et al. 2019 \cite yudin_et_al_2019). The first multi-year (2015-2018) FV3GFS simulations with UGWP-v0 also produce the equatorial QBO-like oscillations in the zonal wind and temperature anomalies. +!! Note for the sub-grid scale orography scheme in UGWP-v0: Due to degraded forecast +!! scores of simulations with revised schemes for subgrid-scale orography effects in FV3GFS, +!! EMC reinstalled the original gwdps-code with updated efficiency factors for the mountain +!! blocking and OGW drag. The GFS OGW is described in the separate section (\ref GFS_GWDPS) +!! and its "call" moved into UGWP-driver subroutine. This combination of NGW and OGW schemes +!! was tested in the FV3GFS-L127 medium-range forecasts (15-30 days) for C96, C192, C384 and +!! C768 resolutions and work in progress to introduce the optimal choice for the scale-aware +!! representations of the efficiency factors that will reflect the better simulations of GW +!! activity by FV3 dynamical core at higher horizontal resolutions. With the MERRA-2 VMF +!! function for NGWs (\ref slat_geos5_tamp) and operational OGW drag scheme (\ref GFS_GWDPS), +!! FV3GFS simulations can successfully forecast the recent major mid-winter sudden stratospheric +!! warming (SSW) events of 2018-02-12 and 2018-12-31 (10-14 days before the SSW onset; +!! Yudin et al. 2019 \cite yudin_et_al_2019). The first multi-year (2015-2018) FV3GFS simulations +!! with UGWP-v0 also produce the equatorial QBO-like oscillations in the zonal wind and temperature anomalies. !! SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, & Pdvdt, Pdudt, Pdtdt, Pkdis, U1,V1,T1,Q1,KPBL, @@ -277,8 +292,8 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! ! modified/revised version of gwdps.f (with bug fixes, tofd, appropriate ! computation of kref for OGW + COORDE diagnostics -! all constants/parameters inside cires_ugwp_initialize.F90 -!---------------------------------------- +! all constants/parameters inside cires_ugwp_initialize.F90 +!---------------------------------------- USE MACHINE , ONLY : kind_phys use ugwp_common , only : rgrav, grav, cpd, rd, rv, rcpd, rcpd2 @@ -296,7 +311,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, &, n_tofd, ze_tofd, ztop_tofd use cires_ugwp_module, only : kxw, max_kdis, max_axyz - use sso_coorde, only : pgwd, pgwd4 + use sso_coorde, only : pgwd, pgwd4, debugprint !---------------------------------------- implicit none character(len=8) :: strsolver='PSS-1986' ! current operational solver or 'WAM-2017' @@ -335,7 +350,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! !--------------------------------------------------------------------- ! # of permissible sub-grid orography hills for "any" resolution < 25 -! correction for "elliptical" hills based on shilmin-area =sgrid/25 +! correction for "elliptical" hills based on shilmin-area =sgrid/25 ! 4.*gamma*b_ell*b_ell >= shilmin ! give us limits on [b_ell & gamma *b_ell] > 5 km =sso_min ! gamma_min = 1/4*shilmin/sso_min/sso_min @@ -353,21 +368,21 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, real(kind=kind_phys) :: belpmin, dsmin, dsmax ! real(kind=kind_phys) :: arhills(im) ! not used why do we need? real(kind=kind_phys) :: xlingfs - -! -! locals + +! +! locals ! mean flow real(kind=kind_phys), dimension(im,km) :: RI_N, BNV2, RO &, VTK, VTJ, VELCO -!mtb +!mtb real(kind=kind_phys), dimension(im) :: OA, CLX , elvmax, wk &, PE, EK, UP - + real(kind=kind_phys), dimension(im,km) :: DB, ANG, UDS real(kind=kind_phys) :: ZLEN, DBTMP, R, PHIANG, DBIM, ZR real(kind=kind_phys) :: ENG0, ENG1, COSANG2, SINANG2 - real(kind=kind_phys) :: bgam, cgam, gam2, rnom, rdem + real(kind=kind_phys) :: bgam, cgam, gam2, rnom, rdem ! ! TOFD ! Some constants now in "use ugwp_oro_init" + "use ugwp_common" @@ -378,7 +393,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, &, epstofd1, krf_tofd1 &, up1, vp1, zpm real(kind=kind_phys),dimension(im, km) :: axtms, aytms -! +! ! OGW ! LOGICAL ICRILV(IM) @@ -389,9 +404,9 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, real(kind=kind_phys) :: TAUP(IM,km+1), TAUD(IM,km) real(kind=kind_phys) :: taub(im), taulin(im), heff, hsat, hdis - integer, dimension(im) :: kref, idxzb, ipt, kreflm, + integer, dimension(im) :: kref, idxzb, ipt, kreflm, & iwklm, iwk, izlow -! +! !check what we need ! real(kind=kind_phys) :: bnv, fr, ri_gw @@ -405,15 +420,15 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, &, cdmb4, mtbridge &, kxridge, inv_b2eff, zw1, zw2 &, belps, aelps, nhills, selps - + integer :: kmm1, kmm2, lcap, lcapp1 &, npt, kbps, kbpsp1,kbpsm1 &, kmps, idir, nwd, klcap, kp1, kmpbl, kmll &, k_mtb, k_zlow, ktrial, klevm1, i, j, k -! +! rcpdt = 1.0 / (cpd*dtp) grav2 = grav + grav -! +! ! mtb-blocking sigma_min and dxres => cires_initialize ! sgrmax = maxval(sparea) ; sgrmin = minval(sparea) @@ -438,7 +453,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, kxridge = float(IMX)/arad * cdmbgwd(2) - if (me == master .and. kdt == 1) then + if (me == master .and. kdt == 1 .and. debugprint) then print *, ' gwdps_v0 kxridge ', kxridge print *, ' gwdps_v0 scale2 ', cdmbgwd(2) print *, ' gwdps_v0 IMX ', imx @@ -450,7 +465,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, idxzb(i) = 0 zmtb(i) = 0.0 zogw(i) = 0.0 - rdxzb(i) = 0.0 + rdxzb(i) = 0.0 tau_ogw(i) = 0.0 tau_mtb(i) = 0.0 dusfc(i) = 0.0 @@ -473,13 +488,13 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, dudt_tms(i,k) = 0.0 enddo enddo - + ! ---- for lm and gwd calculation points - + npt = 0 do i = 1,im if ( elvmaxd(i) >= hminmt .and. hprime(i) >= hpmin ) then - + npt = npt + 1 ipt(npt) = i ! arhills(i) = 1.0 @@ -494,7 +509,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! small-scale "turbulent" oro-scales < sso_min ! if( aelps < sso_min .and. do_adjoro) then - + ! a, b > sso_min upscale ellipse a/b > 0.1 a>sso_min & h/b=>new_sigm ! aelps = sso_min @@ -507,22 +522,22 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, sigma(i) = 2.*hprime(i)/aelps gamma(i) = min(aelps/belps, 1.0) endif - - selps = belps*belps*gamma(i)*4. ! ellipse area of the el-c hill + + selps = belps*belps*gamma(i)*4. ! ellipse area of the el-c hill nhills = min(nhilmax, sparea(i)/selps) ! arhills(i) = max(nhills, 1.0) -!333 format( ' nhil: ', I6, 4(2x, F9.3), 2(2x, E9.3)) +!333 format( ' nhil: ', I6, 4(2x, F9.3), 2(2x, E9.3)) ! if (kdt==1 ) ! & write(6,333) nint(nhills)+1,xlatd(i), hprime(i),aelps*1.e-3, ! & belps*1.e-3, sigma(i),gamma(i) endif enddo - - IF (npt == 0) then + + IF (npt == 0 .and. debugprint) then ! print *, 'oro-npt = 0 elvmax ', maxval(elvmaxd), hminmt -! print *, 'oro-npt = 0 hprime ', maxval(hprime), hpmin +! print *, 'oro-npt = 0 hprime ', maxval(hprime), hpmin RETURN ! No gwd/mb calculation done endif @@ -532,18 +547,18 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, IDXZB(i) = 0 kreflm(i) = 0 enddo - + do k=1,km do i=1,im db(i,k) = 0.0 ang(i,k) = 0.0 - uds(i,k) = 0.0 + uds(i,k) = 0.0 enddo enddo KMM1 = km - 1 ; KMM2 = km - 2 ; KMLL = kmm1 LCAP = km ; LCAPP1 = LCAP + 1 - + DO I = 1, npt j = ipt(i) ELVMAX(J) = min (ELVMAXd(J)*0. + sigfac * hprime(j), hncrit) @@ -594,18 +609,18 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, BVF2 = grav2 * RDZ * (VTK(I,K+1)-VTK(I,K)) & / (VTK(I,K+1)+VTK(I,K)) bnv2(i,k+1) = max( BVF2, bnv2min ) - RI_N(I,K+1) = Bnv2(i,k)/SHR2 ! Richardson number consistent with BNV2 + RI_N(I,K+1) = Bnv2(i,k)/SHR2 ! Richardson number consistent with BNV2 ! ! add here computation for Ktur and OGW-dissipation fro VE-GFS -! +! ENDDO ENDDO K = 1 DO I = 1, npt bnv2(i,k) = bnv2(i,k+1) ENDDO -! -! level iwklm =>phil(j,k)/g < sigfac * hprime(j) < phil(j,k+1)/g +! +! level iwklm =>phil(j,k)/g < sigfac * hprime(j) < phil(j,k+1)/g ! DO I = 1, npt J = ipt(i) @@ -624,13 +639,13 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, DO I = 1, npt k_zlow = izlow(I) if (k_zlow == iwklm(i)) k_zlow = 1 - DO K = k_zlow, iwklm(I)-1 ! Kreflm(I)= iwklm(I)-1 + DO K = k_zlow, iwklm(I)-1 ! Kreflm(I)= iwklm(I)-1 J = ipt(i) ! laye-aver Rho, U, V RDELKS = DEL(J,K) * DELKS(I) - UBAR(I) = UBAR(I) + RDELKS * U1(J,K) ! trial Mean U below - VBAR(I) = VBAR(I) + RDELKS * V1(J,K) ! trial Mean V below - ROLL(I) = ROLL(I) + RDELKS * RO(I,K) ! trial Mean RO below -! + UBAR(I) = UBAR(I) + RDELKS * U1(J,K) ! trial Mean U below + VBAR(I) = VBAR(I) + RDELKS * V1(J,K) ! trial Mean V below + ROLL(I) = ROLL(I) + RDELKS * RO(I,K) ! trial Mean RO below +! BNV2bar(I) = BNV2bar(I) + .5*(BNV2(I,K)+BNV2(I,K+1))* RDELKS ENDDO ENDDO @@ -640,7 +655,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! ! integrate from Ztoph = sigfac*hprime down to Zblk if exists ! find ph_blk, dz_blk like in LM-97 and IFS -! +! ph_blk =0. DO K = iwklm(I), 1, -1 PHIANG = atan2(V1(J,K),U1(J,K))*RAD_TO_DEG @@ -701,54 +716,54 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! ! --- The drag for mtn blocked flow -! +! cdmb4 = 0.25*cdmb DO I = 1, npt J = ipt(i) ! IF ( IDXZB(I) > 0 ) then -! (4.16)-IFS +! (4.16)-IFS gam2 = gamma(j)*gamma(j) BGAM = 1.0 - 0.18*gamma(j) - 0.04*gam2 CGAM = 0.48*gamma(j) + 0.30*gam2 DO K = IDXZB(I)-1, 1, -1 - ZLEN = SQRT( ( PHIL(J,IDXZB(I)) - PHIL(J,K) ) / + ZLEN = SQRT( ( PHIL(J,IDXZB(I)) - PHIL(J,K) ) / & ( PHIL(J,K ) + Grav * hprime(J) ) ) tem = cos(ANG(I,K)) COSANG2 = tem * tem SINANG2 = 1.0 - COSANG2 -! +! ! cos =1 sin =0 => 1/R= gam ZR = 2.-gam ! cos =0 sin =1 => 1/R= 1/gam ZR = 2.- 1/gam ! rdem = COSANG2 + GAM2 * SINANG2 rnom = COSANG2*GAM2 + SINANG2 -! +! ! metOffice Dec 2010 ! correction of H. Wells & A. Zadra for the ! aspect ratio of the hill seen by MF ! (1/R , R-inverse below: 2-R) - rdem = max(rdem, 1.e-6) + rdem = max(rdem, 1.e-6) R = sqrt(rnom/rdem) ZR = MAX( 2. - R, 0. ) sigres = max(sigmin, sigma(J)) if (hprime(J)/sigres > dxres) sigres = hprime(J)/dxres mtbridge = ZR * sigres*ZLEN / hprime(J) -! (4.15)-IFS +! (4.15)-IFS ! DBTMP = CDmb4 * mtbridge * ! & MAX(cos(ANG(I,K)), gamma(J)*sin(ANG(I,K))) ! (4.16)-IFS DBTMP = CDmb4*mtbridge*(bgam* COSANG2 +cgam* SINANG2) DB(I,K)= DBTMP * UDS(I,K) ENDDO -! +! endif ENDDO -! +! !............................. !............................. ! end mtn blocking section @@ -756,7 +771,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, !............................. ! !--- Orographic Gravity Wave Drag Section -! +! ! Scale cleff between IM=384*2 and 192*2 for T126/T170 and T62 ! inside "cires_ugwp_initialize.F90" now ! @@ -771,12 +786,12 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, j = ipt(i) tem = (prsi(j,1) - prsi(j,k)) if (tem < dpmin) iwk(i) = k ! dpmin=50 mb - -!=============================================================== -! lev=111 t=311.749 hkm=0.430522 Ps-P(iwk)=52.8958 + +!=============================================================== +! lev=111 t=311.749 hkm=0.430522 Ps-P(iwk)=52.8958 ! below "Hprime" - source of OGWs and below Zblk !!! ! 27 2 kpbl ~ 1-2 km < Hprime -!=============================================================== +!=============================================================== enddo enddo ! @@ -868,7 +883,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, BNV = SQRT( BNV2bar(I) ) heff = min(HPRIME(J),hpmax) - if( zmtb(j) > 0.) heff = max(sigfac*heff-zmtb(j), 0.)/sigfac + if( zmtb(j) > 0.) heff = max(sigfac*heff-zmtb(j), 0.)/sigfac if (heff <= 0) cycle hsat = fcrit_gfs*ULOW(I)/bnv @@ -909,7 +924,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! TAUB(I) = taulin(i) ! linear flux for FR <= fcrit_gfs ! endif -! +! ! K = MAX(1, kref(I)-1) TEM = MAX(VELCO(I,K)*VELCO(I,K), dw2min) @@ -919,7 +934,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! zogw(J) = PHII(j, kref(I)) *rgrav ENDDO -! +! !----SET UP BOTTOM VALUES OF STRESS ! DO K = 1, KBPS @@ -927,9 +942,9 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, IF (K <= kref(I)) TAUP(I,K) = TAUB(I) ENDDO ENDDO - + if (strsolver == 'PSS-1986') then - + !====================================================== ! V0-GFS OROGW-solver of Palmer et al 1986 -"PSS-1986" ! in V1-OROGW LINSATDIS of "WAM-2017" @@ -937,7 +952,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! rotational/non-hydrostat OGWs important for ! HighRES-FV3GFS with dx < 10 km !====================================================== - + DO K = KMPS, KMM1 ! Vertical Level Loop KP1 = K + 1 DO I = 1, npt @@ -992,9 +1007,9 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ENDIF ENDDO ENDDO -! +! ! zero momentum deposition at the top model layer -! +! taup(1:npt,km+1) = taup(1:npt,km) ! ! Calculate wave acc-n: - (grav)*d(tau)/d(p) = taud @@ -1010,7 +1025,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! DO I = 1,npt ! TAUD(I, km) = TAUD(I,km) * FACTOP ! ENDDO - + !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ !------IF THE GRAVITY WAVE DRAG WOULD FORCE A CRITICAL LINE IN THE !------LAYERS BELOW SIGMA=RLOLEV DURING THE NEXT DELTIM TIMESTEP, @@ -1034,73 +1049,73 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ENDDO ! !--------------------------- OROGW-solver of GFS PSS-1986 -! - else +! + else ! !--------------------------- OROGW-solver of WAM2017 ! ! sigres = max(sigmin, sigma(J)) ! if (heff/sigres.gt.dxres) sigres=heff/dxres ! inv_b2eff = 0.5*sigres/heff -! XLINV(I) = max(kxridge, inv_b2eff) ! 0.5*sigma(j)/heff = 1./Lridge +! XLINV(I) = max(kxridge, inv_b2eff) ! 0.5*sigma(j)/heff = 1./Lridge dtfac(:) = 1.0 call oro_wam_2017(im, km, npt, ipt, kref, kdt, me, master, - & dtp, dxres, taub, u1, v1, t1, xn, yn, bnv2, ro, prsi,prsL, + & dtp, dxres, taub, u1, v1, t1, xn, yn, bnv2, ro, prsi,prsL, & del, sigma, hprime, gamma, theta, & sinlat, xlatd, taup, taud, pkdis) endif ! oro_wam_2017 - LINSATDIS-solver of WAM-2017 -! +! !--------------------------- OROGW-solver of WAM2017 ! ! TOFD as in BELJAARS-2004 ! -! --------------------------- +! --------------------------- IF( do_tofd ) then - axtms(:,:) = 0.0 ; aytms(:,:) = 0.0 - if ( kdt == 1 .and. me == 0) then - print *, 'VAY do_tofd from surface to ', ztop_tofd + axtms(:,:) = 0.0 ; aytms(:,:) = 0.0 + if ( kdt == 1 .and. me == 0 .and. debugprint) then + print *, 'VAY do_tofd from surface to ', ztop_tofd endif - DO I = 1,npt + DO I = 1,npt J = ipt(i) zpbl =rgrav*phil( j, kpbl(j) ) - + sigflt = min(sgh30(j), 0.3*hprime(j)) ! cannot exceed 30% of LS-SSO - + zsurf = phii(j,1)*rgrav do k=1,km zpm(k) = phiL(j,k)*rgrav up1(k) = u1(j,k) vp1(k) = v1(j,k) enddo - - call ugwp_tofd1d(km, sigflt, elvmaxd(j), zsurf, zpbl, + + call ugwp_tofd1d(km, sigflt, elvmaxd(j), zsurf, zpbl, & up1, vp1, zpm, utofd1, vtofd1, epstofd1, krf_tofd1) - + do k=1,km axtms(j,k) = utofd1(k) aytms(j,k) = vtofd1(k) -! +! ! add TOFD to GW-tendencies -! +! pdvdt(J,k) = pdvdt(J,k) + aytms(j,k) pdudt(J,k) = pdudt(J,k) + axtms(j,k) enddo !2018-diag tau_tofd(J) = sum( utofd1(1:km)* del(j,1:km)) enddo - ENDIF ! do_tofd + ENDIF ! do_tofd !--------------------------- ! combine oro-drag effects -!--------------------------- +!--------------------------- ! + diag-3d - dudt_tms = axtms + dudt_tms = axtms tau_ogw = 0. tau_mtb = 0. - + DO K = 1,KM DO I = 1,npt J = ipt(i) @@ -1110,29 +1125,29 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, if ( K < IDXZB(I) .AND. IDXZB(I) /= 0 ) then ! ! if blocking layers -- no OGWs -! +! DBIM = DB(I,K) / (1.+DB(I,K)*DTP) Pdvdt(j,k) = - DBIM * V1(J,K) +Pdvdt(j,k) Pdudt(j,k) = - DBIM * U1(J,K) +Pdudt(j,k) ENG1 = ENG0*(1.0-DBIM*DTP)*(1.-DBIM*DTP) - + DUSFC(J) = DUSFC(J) - DBIM * U1(J,K) * DEL(J,K) DVSFC(J) = DVSFC(J) - DBIM * V1(J,K) * DEL(J,K) -!2018-diag +!2018-diag dudt_mtb(j,k) = -DBIM * U1(J,K) tau_mtb(j) = tau_mtb(j) + dudt_mtb(j,k)* DEL(J,K) else ! ! OGW-s above blocking height -! +! TAUD(I,K) = TAUD(I,K) * DTFAC(I) DTAUX = TAUD(I,K) * XN(I) * pgwd DTAUY = TAUD(I,K) * YN(I) * pgwd - + Pdvdt(j,k) = DTAUY +Pdvdt(j,k) Pdudt(j,k) = DTAUX +Pdudt(j,k) - + unew = U1(J,K) + DTAUX*dtp ! Pdudt(J,K)*DTP vnew = V1(J,K) + DTAUY*dtp ! Pdvdt(J,K)*DTP ENG1 = 0.5*(unew*unew + vnew*vnew) @@ -1143,10 +1158,10 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, dudt_ogw(j,k) = DTAUX tau_ogw(j) = tau_ogw(j) +DTAUX*DEL(j,k) endif -! +! ! local energy deposition SSO-heat -! - Pdtdt(j,k) = max(ENG0-ENG1,0.)*rcpdt +! + Pdtdt(j,k) = max(ENG0-ENG1,0.)*rcpdt ENDDO ENDDO ! dusfc w/o tofd sign as in the ERA-I, MERRA and CFSR @@ -1163,7 +1178,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, !============ debug ------------------------------------------------ - if (kdt <= 2 .and. me == 0) then + if (kdt <= 2 .and. me == 0 .and. debugprint) then print *, 'vgw-oro done gwdps_v0 in ugwp-v0 step-proc ', kdt, me ! print *, maxval(pdudt)*86400., minval(pdudt)*86400, 'vgw_axoro' @@ -1210,13 +1225,13 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! TEM = MAX(VELCO(I,K)*VELCO(I,K), 0.1) ! TEMV = 1.0 / max(VELCO(I,K), 0.01) ! & * max(VELCO(I,K),0.01) -!.................................................................... +!.................................................................... enddo print * stop endif endif - + ! RETURN !--------------------------------------------------------------- @@ -1228,11 +1243,11 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! ! d) solver of Palmer et al. (1987) => Linsat of McFarlane ! -!--------------------------------------------------------------- - end subroutine gwdps_v0 - - - +!--------------------------------------------------------------- + end subroutine gwdps_v0 + + + !=============================================================================== ! use fv3gfs-v0 ! first beta version of ugwp for fv3gfs-128 @@ -1242,8 +1257,8 @@ end subroutine gwdps_v0 ! next will be lsatdis for both fv3wam & fv3gfs-128l implementations ! with (a) stochastic-deterministic propagation solvers for wave packets/spectra ! (b) gw-sources: oro/convection/dyn-instability (fronts/jets/pv-anomalies) -! (c) guidance from high-res runs for GW sources and res-aware tune-ups -!23456 +! (c) guidance from high-res runs for GW sources and res-aware tune-ups +!23456 ! ! call gwdrag_wam(1, im, ix, km, ksrc, dtp, ! & xlat, gw_dudt, gw_dvdt, taux, tauy) @@ -1270,8 +1285,8 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! nov 2015 alternative gw-solver for nggps-wam ! nov 2017 nh/rotational gw-modes for nh-fv3gfs ! --------------------------------------------------------------------------------- -! - +! + use ugwp_common , only : rgrav, grav, cpd, rd, rv &, omega2, rcpd2, pi, pi2, fv &, rad_to_deg, deg_to_rad @@ -1285,15 +1300,17 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, &, zci, zdci, zci4, zci3, zci2 &, zaz_fct, zcosang, zsinang &, nwav, nazd, zcimin, zcimax -! + + use sso_coorde, only : debugprint +! implicit none -!23456 - +!23456 + integer, intent(in) :: klev ! vertical level integer, intent(in) :: klon ! horiz tiles - real, intent(in) :: dtime ! model time step - real, intent(in) :: vm1(klon,klev) ! meridional wind + real, intent(in) :: dtime ! model time step + real, intent(in) :: vm1(klon,klev) ! meridional wind real, intent(in) :: um1(klon,klev) ! zonal wind real, intent(in) :: qm1(klon,klev) ! spec. humidity real, intent(in) :: tm1(klon,klev) ! kin temperature @@ -1307,36 +1324,36 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, real, intent(in) :: tau_ngw(klon) integer, intent(in) :: mpi_id, master, kdt -! +! ! ! out-gw effects ! real, intent(out) :: pdudt(klon,klev) ! zonal momentum tendency real, intent(out) :: pdvdt(klon,klev) ! meridional momentum tendency real, intent(out) :: pdtdt(klon,klev) ! gw-heating (u*ax+v*ay)/cp - real, intent(out) :: dked(klon,klev) ! gw-eddy diffusion - real, parameter :: minvel = 0.5 ! - real, parameter :: epsln = 1.0d-12 ! - + real, intent(out) :: dked(klon,klev) ! gw-eddy diffusion + real, parameter :: minvel = 0.5 ! + real, parameter :: epsln = 1.0d-12 ! + !vay-2018 - + real :: taux(klon,klev+1) ! EW component of vertical momentum flux (pa) real :: tauy(klon,klev+1) ! NS component of vertical momentum flux (pa) - real :: phil(klon,klev) ! gphil/grav + real :: phil(klon,klev) ! gphil/grav ! ! local =============================================================================================== ! - -! real :: zthm1(klon,klev) ! temperature interface levels - real :: zthm1 ! 1.0 / temperature interface levels + +! real :: zthm1(klon,klev) ! temperature interface levels + real :: zthm1 ! 1.0 / temperature interface levels real :: zbvfhm1(klon,ilaunch:klev) ! interface BV-frequency - real :: zbn2(klon,ilaunch:klev) ! interface BV-frequency + real :: zbn2(klon,ilaunch:klev) ! interface BV-frequency real :: zrhohm1(klon,ilaunch:klev) ! interface density real :: zuhm1(klon,ilaunch:klev) ! interface zonal wind real :: zvhm1(klon,ilaunch:klev) ! meridional wind real :: v_zmet(klon,ilaunch:klev) real :: vueff(klon,ilaunch:klev) - real :: zbvfl(klon) ! BV at launch level + real :: zbvfl(klon) ! BV at launch level real :: c2f2(klon) !23456 @@ -1367,7 +1384,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, real :: zcin2, zbvfl2, zcin3, zbvfl3, zcinc real :: zatmp, zfluxs, zdep, zfluxsq, zulm, zdft, ze1, ze2 -! +! real :: zdelp,zrgpts real :: zthstd,zrhostd,zbvfstd real :: tvc1, tvm1, tem1, tem2, tem3 @@ -1379,13 +1396,13 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, real, parameter :: rcpdl = cpd/grav ! 1/[g/cp] == cp/g &, grav2cpd = grav/rcpdl ! g*(g/cp)= g^2/cp &, cpdi = 1.0d0/cpd - + real :: expdis, fdis ! real :: fmode, expdis, fdis real :: v_kzi, v_kzw, v_cdp, v_wdp, sc, tx1 integer :: j, k, inc, jk, jl, iazi -! +! !-------------------------------------------------------------------------- ! do k=1,klev @@ -1397,20 +1414,20 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, phil(j,k) = philg(j,k) * rgrav enddo enddo -!----------------------------------------------------------- +!----------------------------------------------------------- ! also other options to alter tropical values ! tamp = 100.e-3*1.e3 = 100 mpa -! vay-2017 zfluxglob=> lat-dep here from geos-5/merra-2 +! vay-2017 zfluxglob=> lat-dep here from geos-5/merra-2 !----------------------------------------------------------- -! call slat_geos5_tamp(klon, tamp_mpa, xlatd, tau_ngw) +! call slat_geos5_tamp(klon, tamp_mpa, xlatd, tau_ngw) + - ! phil = philg*rgrav ! rcpd = 1.0/(grav/cpd) ! 1/[g/cp] ! grav2cpd = grav*grav/cpd ! g*(g/cp)= g^2/cp - if (kdt ==1 .and. mpi_id == master) then + if (kdt ==1 .and. mpi_id == master .and. debugprint) then print *, maxval(tm1), minval(tm1), 'vgw: temp-res ' print *, 'ugwp-v0: zcimin=' , zcimin print *, 'ugwp-v0: zcimax=' , zcimax @@ -1428,7 +1445,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, enddo enddo -! +! ! set initial min Cxi for critical level absorption do iazi=1,nazd do jl=1,klon @@ -1457,7 +1474,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, zbn2(jl,jk) = grav2cpd*zthm1 & * (1.0+rcpdl*(tm1(jl,jk)-tm1(jl,jk-1))/zdelp) zbn2(jl,jk) = max(min(zbn2(jl,jk), gssec), bv2min) - zbvfhm1(jl,jk) = sqrt(zbn2(jl,jk)) ! bn = sqrt(bn2) + zbvfhm1(jl,jk) = sqrt(zbn2(jl,jk)) ! bn = sqrt(bn2) enddo enddo @@ -1478,9 +1495,9 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, C2F2(JL) = tx1 * tx1 zbvfl(jl) = zbvfhm1(jl,ilaunch) enddo -! +! ! define intrinsic velocity (relative to launch level velocity) u(z)-u(zo), and coefficinets -! ------------------------------------------------------------------------------------------ +! ------------------------------------------------------------------------------------------ do iazi=1, nazd do jl=1,klon zul(jl,iazi) = zcosang(iazi) * zuhm1(jl,ilaunch) @@ -1571,7 +1588,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, zpu(jl,ilaunch,1) = zpu(jl,ilaunch,1) + zflux(jl,inc,1)*zcinc enddo enddo -! +! ! normalize and include lat-dep (precip or merra-2) ! ----------------------------------------------------------- ! also other options to alter tropical values @@ -1614,7 +1631,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, enddo enddo -! ------------------------------------------------------------- +! ------------------------------------------------------------- ! azimuth do-loop ! -------------------- do iazi=1, nazd @@ -1682,7 +1699,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! saturated limit wfit = kzw*kzw*kt; wfdt = wfit/(kxw*cx)*betat ! & dissipative kzi = 2.*kzw*(wfdm+wfdt)*dzpi(k) ! define kxw = -!======================================================================= +!======================================================================= v_cdp = abs(zcin-zui(jL,jk,iazi)) v_wdp = v_kxw*v_cdp wdop2 = v_wdp* v_wdp @@ -1697,7 +1714,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! !linsatdis: kzw2, kzw3, kdsat, c2f2, cdf2, cdf1 ! -!kzw2 = (zBn2(k)-wdop2)/Cdf2 - rhp4 - v_kx2w ! full lin DS-NiGW (N2-wd2)*k2=(m2+k2+[1/2H]^2)*(wd2-f2) +!kzw2 = (zBn2(k)-wdop2)/Cdf2 - rhp4 - v_kx2w ! full lin DS-NiGW (N2-wd2)*k2=(m2+k2+[1/2H]^2)*(wd2-f2) ! Kds = kxw*Cdf1*rhp2/kzw3 ! v_cdp = sqrt( cdf2 ) @@ -1710,7 +1727,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, v_kzw = 0. v_cdp = 0. ! no effects of reflected waves endif - + ! fmode = zflux(jl,inc,iazi) ! fdis = fmode*expdis fdis = expdis * zflux(jl,inc,iazi) @@ -1764,25 +1781,25 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! ! endif - enddo !jl=1,klon + enddo !jl=1,klon enddo !waves inc=1,nwav ! -------------- enddo ! end jk do-loop vertical loop ! --------------- enddo ! end nazd do-loop -! ---------------------------------------------------------------------------- +! ---------------------------------------------------------------------------- ! sum contribution for total zonal and meridional flux + ! energy dissipation ! --------------------------------------------------- -! +! do jk=1,klev+1 do jl=1,klon - taux(jl,jk) = 0.0 - tauy(jl,jk) = 0.0 + taux(jl,jk) = 0.0 + tauy(jl,jk) = 0.0 enddo - enddo - + enddo + tem3 = zaz_fct*cpdi do iazi=1,nazd tem1 = zaz_fct*zcosang(iazi) @@ -1798,7 +1815,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, enddo ! ! update du/dt and dv/dt tendencies ..... no contribution to heating => keddy/tracer-mom-heat -! ---------------------------- +! ---------------------------- ! do jk=ilaunch,klev @@ -1824,7 +1841,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! if (dked(jl,jk) < 0) dked(jl,jk) = dked_min enddo enddo -! +! ! add limiters/efficiency for "unbalanced ics" if it is needed ! do jk=ilaunch,klev @@ -1835,10 +1852,10 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, dked(jl,jk) = gw_eff * dked(jl,jk) enddo enddo -! +! !--------------------------------------------------------------------------- ! - if (kdt == 1 .and. mpi_id == master) then + if (kdt == 1 .and. mpi_id == master .and. debugprint) then print *, 'vgw done ' ! print *, maxval(pdudt)*86400., minval(pdudt)*86400, 'vgw ax' @@ -1889,7 +1906,7 @@ subroutine edmix_ugwp_v0(im, levs, dtp, ! locals ! integer :: i, j, k -!------------------------------------------------------------------------ +!------------------------------------------------------------------------ ! solving 1D-vertical eddy diffusion to "smooth" ! GW-related tendencies: du/dt, dv/dt, d(PT)/dt ! we need to use sum of molecular + eddy terms including turb-part @@ -1900,7 +1917,7 @@ subroutine edmix_ugwp_v0(im, levs, dtp, ! this "diffusive-way" is tested with UGWP-tendencies ! forced by various wave sources. X' =dx/dt *dt ! d(X + X')/dt = K*diff(X + X') => -! +! ! wave1 dX'/dt = Kw * diff(X')... eddy part "Kwave" on wave-part ! turb2 dX/dt = Kturb * diff(X) ... resolved scale mixing "Kturb" like PBL ! we may assume "zero-GW"-tendency at the top lid and "zero" flux @@ -1920,7 +1937,7 @@ subroutine edmix_ugwp_v0(im, levs, dtp, real(kind=kind_phys),dimension(levs) :: bn2, shr2, ksum real(kind=kind_phys) :: eps_shr, eps_bn2, eps_dis real(kind=kind_phys) :: rdz , uz, vz, ptz -! ------------------------------------------------------------------------- +! ------------------------------------------------------------------------- ! Prw*Lsat2 =1, for GW-eddy diffusion Pr_wave = Kv/Kt ! Pr_wave ~1/Lsat2 = 1/Frcit2 = 2. => Lsat2 = 1./2 (Frc ~0.7) ! m*u'/N = u'/{c-U) = h'N/(c-U) = Lsat = Fcrit @@ -1935,11 +1952,11 @@ subroutine edmix_ugwp_v0(im, levs, dtp, real(kind=kind_phys), parameter :: prmax = 4.0 real(kind=kind_phys), parameter :: hps = 7000., h4 = 0.25/hps real(kind=kind_phys), parameter :: kedmin = 0.01, kedmax = 250. - - + + real(kind=kind_phys) :: rdtp, rineg, kamp, zmet, zgrow real(kind=kind_phys) :: stab, stab_dt, dtstab, ritur - integer :: nstab + integer :: nstab real(kind=kind_phys) :: w1, w2, w3 rdtp = 1./dtp nstab = 1 @@ -1962,17 +1979,17 @@ subroutine edmix_ugwp_v0(im, levs, dtp, uz = up(k+1)-up(k) vz = vp(k+1)-vp(k) ptz =2.*(pt(k+1)-pt(k))/(pt(k+1)+pt(k)) - shr2(k) = rdz*rdz*(max(uz*uz+vz*vz, dw2min)) + shr2(k) = rdz*rdz*(max(uz*uz+vz*vz, dw2min)) bn2(k) = grav*rdz*ptz zmet = phil(j,k)*rgrav zgrow = exp(zmet*h4) if ( bn2(k) < 0. ) then -! +! ! adjust PT-profile to bn2(k) = bnv2min -- neutral atmosphere ! adapt "pdtdt = (Ptadj-Ptdyn)/Ptmap" ! - print *,' UGWP-V0 unstab PT(z) via gwdTdt ', bn2(k), k - +! print *,' UGWP-V0 unstab PT(z) via gwdTdt ', bn2(k), k + rineg = bn2(k)/shr2(k) bn2(k) = max(bn2(k), bnv2min) kamp = sqrt(shr2(k))*sc2u *zgrow @@ -1999,7 +2016,7 @@ subroutine edmix_ugwp_v0(im, levs, dtp, Fw(1:levs) = pdudt(i, 1:levs) Fw1(1:levs) = pdvdt(i, 1:levs) Km(1:levs) = ksum(1:levs) * rho(1:levs)* rho(1:levs) - + do j=1, nstab call diff_1d_wtend(levs, dtstab, Fw, Fw1, Km, & rdp, rdpm, Sw, Sw1) @@ -2009,7 +2026,7 @@ subroutine edmix_ugwp_v0(im, levs, dtp, ed_dudt(i,:) = Sw ed_dvdt(i,:) = Sw1 - + Pt(1:levs) = t1(i,1:levs)*Ptmap(1:levs) Kpt = Km*iPr_pt Fw(1:levs) = pdTdt(i, 1:levs)*Ptmap(1:levs) @@ -2020,7 +2037,7 @@ subroutine edmix_ugwp_v0(im, levs, dtp, ed_dtdt(i,1:levs) = Sw(1:levs)/Ptmap(1:levs) enddo - + end subroutine edmix_ugwp_v0 subroutine diff_1d_wtend(levs, dt, F, F1, Km, rdp, rdpm, S, S1) @@ -2031,8 +2048,8 @@ subroutine diff_1d_wtend(levs, dt, F, F1, Km, rdp, rdpm, S, S1) real(kind=kind_phys) :: S(levs), S1(levs), F(levs), F1(levs) real(kind=kind_phys) :: Km(levs), rdp(levs), rdpm(levs-1) integer :: i, k - real(kind=kind_phys) :: Kp1, ad, cd, bd -! real(kind=kind_phys) :: km1, Kp1, ad, cd, bd + real(kind=kind_phys) :: Kp1, ad, cd, bd +! real(kind=kind_phys) :: km1, Kp1, ad, cd, bd ! S(:) = 0.0 ; S1(:) = 0.0 ! ! explicit diffusion solver diff --git a/physics/ysuvdif.F90 b/physics/ysuvdif.F90 index a417e53d5..fff945774 100644 --- a/physics/ysuvdif.F90 +++ b/physics/ysuvdif.F90 @@ -25,7 +25,7 @@ end subroutine ysuvdif_finalize !! \htmlinclude ysuvdif_run.html !! !------------------------------------------------------------------------------- - subroutine ysuvdif_run(ix,im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & + subroutine ysuvdif_run(ix,im,km,ux,vx,tx,qx,p2d,p2di,pi2d, & utnp,vtnp,ttnp,qtnp, & swh,hlw,xmu,ntrac,ndiff,ntcw,ntiw, & phii,phil,psfcpa, & diff --git a/physics/ysuvdif.meta b/physics/ysuvdif.meta index 458ff75ae..fe18e6f45 100644 --- a/physics/ysuvdif.meta +++ b/physics/ysuvdif.meta @@ -128,7 +128,7 @@ standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step long_name = total sky shortwave heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in @@ -137,7 +137,7 @@ standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step long_name = total sky longwave heating rate units = K s-1 - dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) + dimensions = (horizontal_dimension,vertical_dimension) type = real kind = kind_phys intent = in @@ -264,7 +264,7 @@ intent = in optional = F [heat] - standard_name = kinematic_surface_upward_sensible_heat_flux + standard_name = kinematic_surface_upward_sensible_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward sensible heat flux units = K m s-1 dimensions = (horizontal_dimension) @@ -273,7 +273,7 @@ intent = in optional = F [evap] - standard_name = kinematic_surface_upward_latent_heat_flux + standard_name = kinematic_surface_upward_latent_heat_flux_reduced_by_surface_roughness long_name = kinematic surface upward latent heat flux units = kg kg-1 m s-1 dimensions = (horizontal_dimension) diff --git a/tools/check_encoding.py b/tools/check_encoding.py new file mode 100755 index 000000000..1d24d4679 --- /dev/null +++ b/tools/check_encoding.py @@ -0,0 +1,25 @@ +#!/usr/bin/env python + +#import chardet +import os +import sys + + +SUFFICES = [ '.f', '.F', '.f90', '.F90', '.meta' ] + +for root, dirs, files in os.walk(os.getcwd()): + #print root, dirs, files + for file in files: + suffix = os.path.splitext(file)[1] + #print file, suffix + if suffix in SUFFICES: + with open(os.path.join(root, file)) as f: + contents = f.read() + try: + contents.decode('ascii') + except UnicodeDecodeError: + for line in contents.split('\n'): + try: + line.decode('ascii') + except UnicodeDecodeError: + raise Exception('Detected non-ascii characters in file {}, line: "{}"'.format(os.path.join(root, file), line))