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 b8d3c3e18..7bd357d46 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 3.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 @@ -340,51 +322,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 @@ -398,9 +348,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_MP_generic.F90 b/physics/GFS_MP_generic.F90 index 3e490771f..ab68e206a 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -157,7 +157,7 @@ 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 enddo diff --git a/physics/GFS_PBL_generic.F90 b/physics/GFS_PBL_generic.F90 index ff59aa465..c99908014 100644 --- a/physics/GFS_PBL_generic.F90 +++ b/physics/GFS_PBL_generic.F90 @@ -84,7 +84,8 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, 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, errmsg, errflg) + hybedmf, do_shoc, satmedmf, qgrs, vdftra, lheatstrg, z0fac, e0fac, zorl, & + u10m, v10m, hflx, evap, hflxq, evapq, hffac, hefac, errmsg, errflg) use machine, only : kind_phys use GFS_PBL_generic_common, only : set_aerosol_tracer_index @@ -102,11 +103,25 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, real(kind=kind_phys), dimension(im, levs, ntrac), intent(in) :: qgrs real(kind=kind_phys), dimension(im, levs, nvdiff), intent(inout) :: vdftra + ! 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, u10m, v10m + 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 + ! 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 + + ! Local variables integer :: i, k, kk, k1, n + real(kind=kind_phys) :: tem, tem1, tem2 ! Initialize CCPP error handling variables errmsg = '' @@ -258,6 +273,35 @@ subroutine GFS_PBL_generic_pre_run (im, levs, nvdiff, ntrac, ! 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_PBL_generic_pre_run end module GFS_PBL_generic_pre @@ -287,7 +331,8 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, 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, & 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, errmsg, errflg) + dqsfc_cice, wet, dry, icy, wind, stress_ocn, hflx_ocn, evap_ocn, ugrs1, vgrs1, dkt_cpl, dkt, hffac, hefac, & + errmsg, errflg) use machine, only : kind_phys use GFS_PBL_generic_common, only : set_aerosol_tracer_index @@ -328,6 +373,9 @@ 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 @@ -523,8 +571,8 @@ subroutine GFS_PBL_generic_post_run (im, levs, nvdiff, ntrac, 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) + 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 @@ -547,12 +595,12 @@ 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 (ldiag3d) then diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index 2319f0044..61429eec9 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -307,6 +307,113 @@ kind = kind_phys intent = inout 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 +[u10m] + standard_name = x_wind_at_10m + long_name = 10 meter u wind speed + 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 = 10 meter v wind speed + units = m s-1 + 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 @@ -747,7 +854,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) @@ -756,7 +863,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) @@ -1220,6 +1327,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 [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 0303248b7..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, & @@ -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 af2cb0093..3c21e990f 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -498,9 +498,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_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 0f02e7c63..0af5e9db7 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) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index b6d833796..30067976e 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -63,7 +63,6 @@ subroutine GFS_surface_composites_pre_run (im, frac_grid, flag_cice, cplflx, cpl integer, intent(out) :: errflg ! Local variables - real(kind=kind_phys) :: tem integer :: i ! Initialize CCPP error handling variables @@ -367,10 +366,10 @@ 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) @@ -442,6 +441,7 @@ subroutine GFS_surface_composites_post_run ( fh2(i) = fh2_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) @@ -483,6 +483,7 @@ subroutine GFS_surface_composites_post_run ( hflx(i) = hflx_ice(i) qss(i) = qss_ice(i) tsfc(i) = tsfc_ice(i) + if( cplflx ) tsfcl(i) = tsfc_ice(i) endif zorll(i) = zorl_lnd(i) 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_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/dcyc2.meta b/physics/dcyc2.meta index 2fa998781..244ebc6bd 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -183,7 +183,7 @@ intent = in optional = F [swh] - 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 shortwave heating rate on radiation time step units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -192,7 +192,7 @@ intent = in optional = F [swhc] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_timestep + 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,vertical_dimension) @@ -201,7 +201,7 @@ intent = in optional = F [hlw] - 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 longwave heating rate on radiation time step units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -210,7 +210,7 @@ intent = in optional = F [hlwc] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_timestep + 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,vertical_dimension) diff --git a/physics/gcm_shoc.meta b/physics/gcm_shoc.meta index 07f014356..f4d2f3ae9 100644 --- a/physics/gcm_shoc.meta +++ b/physics/gcm_shoc.meta @@ -251,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) @@ -260,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) 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 f0947b9b4..83ff8d554 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -19,12 +19,12 @@ module m_micro !> \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,& +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_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 @@ -134,7 +134,7 @@ 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 & &, alf_fac, qc_min, pdfflag & &, kdt, xlat, xlon, rhc_i, & @@ -183,7 +183,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & integer, parameter :: ncolmicro = 1 integer,intent(in) :: im, ix,lm, kdt, fprcp, pdfflag - logical,intent(in) :: flipv, aero_in, skip_macro, iccn + 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) :: & @@ -443,7 +444,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 @@ -504,7 +505,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 @@ -673,7 +674,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 @@ -729,7 +730,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 @@ -982,19 +983,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 @@ -1129,7 +1132,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) @@ -1500,7 +1503,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) @@ -1637,7 +1640,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) diff --git a/physics/m_micro.meta b/physics/m_micro.meta index 749b627f7..8ea90f7b9 100644 --- a/physics/m_micro.meta +++ b/physics/m_micro.meta @@ -424,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) @@ -433,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) @@ -790,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 @@ -819,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] diff --git a/physics/micro_mg2_0.F90 b/physics/micro_mg2_0.F90 index 135c11e49..744b46ebc 100644 --- a/physics/micro_mg2_0.F90 +++ b/physics/micro_mg2_0.F90 @@ -395,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, & @@ -466,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 @@ -1115,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) @@ -1154,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 @@ -1169,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 fd155bfa7..6164cf544 100644 --- a/physics/micro_mg3_0.F90 +++ b/physics/micro_mg3_0.F90 @@ -521,7 +521,7 @@ subroutine micro_mg_tend ( & !--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, & @@ -610,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 @@ -1459,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) @@ -1513,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 @@ -1528,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 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.meta b/physics/module_MYNNPBL_wrapper.meta index da09c0089..eb8fcb0fd 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -291,7 +291,7 @@ intent = out 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) @@ -300,7 +300,7 @@ intent = in optional = F [qflx] - 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) @@ -729,7 +729,7 @@ intent = inout 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) @@ -738,7 +738,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_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 b5297b63f..25377dc84 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -145,7 +145,7 @@ intent = in optional = F [swh] - 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 shortwave heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -154,7 +154,7 @@ intent = in optional = F [hlw] - 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 longwave heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -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.meta b/physics/moninedmf_hafs.meta index effe50c52..f6ec78b59 100644 --- a/physics/moninedmf_hafs.meta +++ b/physics/moninedmf_hafs.meta @@ -145,7 +145,7 @@ intent = in optional = F [swh] - 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 shortwave heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -154,7 +154,7 @@ intent = in optional = F [hlw] - 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 longwave heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -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/moninshoc.meta b/physics/moninshoc.meta index 80d8f71fc..d5fd594ab 100644 --- a/physics/moninshoc.meta +++ b/physics/moninshoc.meta @@ -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) diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 2978b8df2..22b8124c1 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -39,10 +39,10 @@ subroutine mp_thompson_init(ncol, nlev, is_aerosol_aware, & integer, intent(in) :: ncol integer, intent(in) :: nlev logical, intent(in) :: is_aerosol_aware - real(kind_phys), optional, intent(inout) :: nwfa2d(1:ncol) - real(kind_phys), optional, intent(inout) :: nifa2d(1:ncol) - real(kind_phys), optional, intent(inout) :: nwfa(1:ncol,1:nlev) - real(kind_phys), optional, intent(inout) :: nifa(1:ncol,1:nlev) + real(kind_phys), optional, intent(inout) :: nwfa2d(:) + real(kind_phys), optional, intent(inout) :: nifa2d(:) + real(kind_phys), optional, intent(inout) :: nwfa(:,:) + real(kind_phys), optional, intent(inout) :: nifa(:,:) integer, intent(in) :: mpicomm integer, intent(in) :: mpirank integer, intent(in) :: mpiroot 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 da7496f87..912b1228f 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 692042937..5e542db6c 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/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/satmedmfvdif.meta b/physics/satmedmfvdif.meta index dcf307e55..c33e4b85f 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -249,7 +249,7 @@ intent = in optional = F [swh] - 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 shortwave heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -258,7 +258,7 @@ intent = in optional = F [hlw] - 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 longwave heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -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 63fee345b..5ecf63a39 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -213,7 +213,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) @@ -223,7 +223,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) diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index f755a8ce9..d41e45906 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -249,7 +249,7 @@ intent = in optional = F [swh] - 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 shortwave heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -258,7 +258,7 @@ intent = in optional = F [hlw] - 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 longwave heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -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_diff.f b/physics/sfc_diff.f index 60d5ceeea..c2ebf8257 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -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 @@ -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 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/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 533b9cd0e..e0d806a5c 100644 --- a/physics/shalcnv.meta +++ b/physics/shalcnv.meta @@ -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/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index 4edd84a7a..6dd03534a 100644 --- a/physics/ugwp_driver_v0.F +++ b/physics/ugwp_driver_v0.F @@ -8,6 +8,7 @@ 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 + logical,parameter :: debugprint = .false. end module sso_coorde ! ! @@ -33,7 +34,7 @@ subroutine cires_ugwp_driver_v0(me, master, 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 @@ -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 @@ -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 * @@ -192,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 ' @@ -297,7 +298,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' @@ -439,7 +440,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 @@ -521,7 +522,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, 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 RETURN ! No gwd/mb calculation done @@ -1060,7 +1061,7 @@ SUBROUTINE GWDPS_V0(IM, km, imx, do_tofd, ! --------------------------- IF( do_tofd ) then axtms(:,:) = 0.0 ; aytms(:,:) = 0.0 - if ( kdt == 1 .and. me == 0) then + if ( kdt == 1 .and. me == 0 .and. debugprint) then print *, 'VAY do_tofd from surface to ', ztop_tofd endif DO I = 1,npt @@ -1164,7 +1165,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' @@ -1286,6 +1287,8 @@ 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 @@ -1411,7 +1414,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! 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 @@ -1839,7 +1842,7 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! !--------------------------------------------------------------------------- ! - 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' @@ -1972,7 +1975,7 @@ subroutine edmix_ugwp_v0(im, levs, dtp, ! 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) diff --git a/physics/ysuvdif.meta b/physics/ysuvdif.meta index da01b0a41..fe18e6f45 100644 --- a/physics/ysuvdif.meta +++ b/physics/ysuvdif.meta @@ -125,7 +125,7 @@ intent = inout optional = F [swh] - 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 shortwave heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -134,7 +134,7 @@ intent = in optional = F [hlw] - 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 longwave heating rate units = K s-1 dimensions = (horizontal_dimension,vertical_dimension) @@ -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)