From b002bc978bed5f3f5226ee7be22491c82e2666f4 Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Fri, 31 May 2019 22:34:36 -0400 Subject: [PATCH 01/44] fixed a bug in calculating CIN --- physics/cs_conv.F90 | 36 ++++++++++++++++++++++++++---------- 1 file changed, 26 insertions(+), 10 deletions(-) diff --git a/physics/cs_conv.F90 b/physics/cs_conv.F90 index d5c2e1011..f1d0a5468 100644 --- a/physics/cs_conv.F90 +++ b/physics/cs_conv.F90 @@ -209,7 +209,8 @@ module cs_conv ! spblcrit=0.03, & !< minimum cloudbase height in p/ps ! spblcrit=0.035,& !< minimum cloudbase height in p/ps ! spblcrit=0.025,& !< minimum cloudbase height in p/ps - cincrit=-150.0 + cincrit=-10.0, & + capecrit=0.0 ! cincrit=-120.0 ! cincrit=-100.0 @@ -1155,8 +1156,22 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions DO I=ISTS,IENS CAPE(i) = zero CIN(i) = zero - JBUOY(i) = 0 +! JBUOY(i) = 0 enddo + +!Anning Cheng, CIN from the cloud base to positive buoy layer only + DO I=ISTS,IENS + if (kb(i) > 0) then + DO K=kb(i),KMAX + BUOY = (GDH(I,1)-GDHS(I,K)) / ((one+ELOCP*FDQS(I,K)) * CP*GDT(I,K)) + if (BUOY < 0.) then + CIN(I) = CIN(I) + BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) + else + cycle + end if + ENDDO + end if + ENDDO DO K=2,KMAX DO I=ISTS,IENS if (kb(i) > 0) then @@ -1165,21 +1180,22 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ELSE BUOY = (GDS(I,1)-GDS(I,K)) / (CP*GDT(I,K)) END IF - IF (BUOY > zero .AND. JBUOY(I) /= 0) THEN + IF (BUOY > zero) THEN CAPE(I) = CAPE(I) + BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) - JBUOY(I) = 2 - ELSEIF (BUOY < zero .AND. JBUOY(I) /= 2) THEN - CIN(I) = CIN(I) - BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) - JBUOY(I) = 1 +! IF (BUOY > zero .AND. JBUOY(I) /= 0) THEN +! CAPE(I) = CAPE(I) + BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) +! JBUOY(I) = 2 +! ELSEIF (BUOY < zero .AND. JBUOY(I) /= 2) THEN +! CIN(I) = CIN(I) - BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) +! JBUOY(I) = 1 ENDIF endif ENDDO ENDDO DO I=ISTS,IENS - IF (JBUOY(I) /= 2) CIN(I) = -999.D0 - if (cin(i) < cincrit) kb(i) = -1 +! IF (JBUOY(I) /= 2) CIN(I) = -999.D0 + if (cin(i) < cincrit .or. cape(i) -# Initialization before summing over cloud type do k=1,kmax ! Moorthi From 289f834f94154724a6222910cf1efc15b64b61f7 Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Fri, 27 Dec 2019 16:44:56 -0500 Subject: [PATCH 02/44] passed compliation ccpp/physics --- physics/m_micro.F90 | 3 ++- physics/m_micro.meta | 12 ++---------- physics/micro_mg2_0.F90 | 3 ++- physics/micro_mg3_0.F90 | 3 ++- 4 files changed, 8 insertions(+), 13 deletions(-) diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index d57139701..7ac887a3b 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -183,7 +183,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & integer, parameter :: ncolmicro = 1 integer,intent(in) :: im, ix,lm, ipr, kdt, fprcp, pdfflag - logical,intent(in) :: flipv, skip_macro, lprnt, iccn + logical,intent(in) :: flipv, skip_macro, lprnt + 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) :: & diff --git a/physics/m_micro.meta b/physics/m_micro.meta index d649edebf..6406755e2 100644 --- a/physics/m_micro.meta +++ b/physics/m_micro.meta @@ -781,14 +781,6 @@ kind = kind_phys intent = in optional = F -[iaerclm] - standard_name = flag_for_aerosol_input_MG - long_name = flag for using aerosols in Morrison-Gettelman microphysics - units = flag - dimensions = () - type = logical - intent = in - optional = F [naai_i] standard_name = in_number_concentration long_name = IN number concentration @@ -810,9 +802,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 b3f7d19b3..90bf48054 100644 --- a/physics/micro_mg2_0.F90 +++ b/physics/micro_mg2_0.F90 @@ -464,7 +464,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 + logical, intent(in) :: lprnt + integer, intent(in) :: iccn ! used for scavenging diff --git a/physics/micro_mg3_0.F90 b/physics/micro_mg3_0.F90 index 4043c0737..215d3516b 100644 --- a/physics/micro_mg3_0.F90 +++ b/physics/micro_mg3_0.F90 @@ -583,7 +583,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 + integer, intent(in) :: iccn !< flag for IN and CCN forcing for Morrison-Gettelman microphysics + ! used for scavenging From 16ead436cc5e9bdf1bce2a3a5565799f8d8e2efb Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Mon, 30 Dec 2019 16:35:51 -0500 Subject: [PATCH 03/44] changes in meta data --- physics/m_micro.meta | 14 +++----------- 1 file changed, 3 insertions(+), 11 deletions(-) diff --git a/physics/m_micro.meta b/physics/m_micro.meta index d649edebf..baba6c617 100644 --- a/physics/m_micro.meta +++ b/physics/m_micro.meta @@ -781,14 +781,6 @@ kind = kind_phys intent = in optional = F -[iaerclm] - standard_name = flag_for_aerosol_input_MG - long_name = flag for using aerosols in Morrison-Gettelman microphysics - units = flag - dimensions = () - type = logical - intent = in - optional = F [naai_i] standard_name = in_number_concentration long_name = IN number concentration @@ -810,11 +802,11 @@ [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 + optional = 0 [skip_macro] standard_name = flag_skip_macro long_name = flag to skip cloud macrophysics in Morrison scheme From b30d0ce83f25e80616770dd433451b99eccb3a57 Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Tue, 31 Dec 2019 21:53:55 -0500 Subject: [PATCH 04/44] fixed an error in m_micro.meta --- physics/m_micro.meta | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/m_micro.meta b/physics/m_micro.meta index baba6c617..6406755e2 100644 --- a/physics/m_micro.meta +++ b/physics/m_micro.meta @@ -806,7 +806,7 @@ dimensions = () type = integer intent = in - optional = 0 + optional = F [skip_macro] standard_name = flag_skip_macro long_name = flag to skip cloud macrophysics in Morrison scheme From e9e685055dd95ddcac721e1eaf4a878658e12749 Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Thu, 2 Jan 2020 14:06:51 -0500 Subject: [PATCH 05/44] passed ccpp compilation and testing ipd compilation --- CMakeLists.txt | 174 ++++++++++++++++-------- physics/GFS_MP_generic.F90 | 48 ++++--- physics/GFS_phys_time_vary.fv3.F90 | 10 +- physics/GFS_phys_time_vary.scm.F90 | 10 +- physics/cires_ugwp_post.F90 | 20 +-- physics/cs_conv.F90 | 40 ++---- physics/drag_suite.F90 | 19 ++- physics/gwdps.f | 8 +- physics/module_gfdl_cloud_microphys.F90 | 8 +- physics/mp_thompson.F90 | 2 +- physics/sfc_drv_ruc.F90 | 31 ++--- physics/sfc_drv_ruc.meta | 45 ++---- 12 files changed, 221 insertions(+), 194 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 443d7ea51..b8d3c3e18 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -97,9 +97,23 @@ list(APPEND LIBS "ccpp") #------------------------------------------------------------------------------ # Set the sources: physics schemes -include(./CCPP_SCHEMES.cmake) +set(SCHEMES $ENV{CCPP_SCHEMES}) +if(SCHEMES) + message(INFO "Got CCPP_SCHEMES from environment variable: ${SCHEMES}") +else(SCHEMES) + include(./CCPP_SCHEMES.cmake) + message(INFO "Got SCHEMES from cmakefile include file: ${SCHEMES}") +endif(SCHEMES) + # Set the sources: physics scheme caps -include(./CCPP_CAPS.cmake) +set(CAPS $ENV{CCPP_CAPS}) +if(CAPS) + message(INFO "Got CAPS from environment variable: ${CAPS}") +else(CAPS) + include(./CCPP_CAPS.cmake) + message(INFO "Got CAPS from cmakefile include file: ${CAPS}") +endif(CAPS) + # Create empty lists for schemes with special compiler optimization flags set(SCHEMES_SFX_OPT "") # Create empty lists for schemes with special floating point precision flags @@ -109,13 +123,28 @@ set(SCHEMES2 ${SCHEMES}) #------------------------------------------------------------------------------ if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") set(CMAKE_Fortran_FLAGS "${CMAKE_Fortran_FLAGS} -ffree-line-length-none") - SET_SOURCE_FILES_PROPERTIES(./physics/module_bfmicrophysics.f ./physics/sflx.f ./physics/sfc_diff.f ./physics/sfc_diag.f PROPERTIES COMPILE_FLAGS -fdefault-real-8) - SET_SOURCE_FILES_PROPERTIES(./physics/module_nst_model.f90 ./physics/calpreciptype.f90 PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -ffree-form") - SET_SOURCE_FILES_PROPERTIES(./physics/mersenne_twister.f PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fno-range-check") - SET_SOURCE_FILES_PROPERTIES(./physics/module_nst_water_prop.f90 PROPERTIES COMPILE_FLAGS "-ffree-line-length-none -fdefault-real-8 -ffree-form") - SET_SOURCE_FILES_PROPERTIES(./physics/aer_cloud.F ./physics/wv_saturation.F ./physics/cldwat2m_micro.F ./physics/surface_perturbation.F90 PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fdefault-double-8") - SET_SOURCE_FILES_PROPERTIES(./physics/module_mp_thompson_make_number_concentrations.F90 PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fdefault-double-8") - SET_SOURCE_FILES_PROPERTIES(./physics/module_SF_JSFC.F90 ./physics/module_BL_MYJPBL.F90 PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fdefault-double-8") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_bfmicrophysics.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sflx.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diff.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diag.f + PROPERTIES COMPILE_FLAGS -fdefault-real-8) + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_model.f90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/calpreciptype.f90 + PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -ffree-form") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/mersenne_twister.f + PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fno-range-check") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_water_prop.f90 + PROPERTIES COMPILE_FLAGS "-ffree-line-length-none -fdefault-real-8 -ffree-form") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/aer_cloud.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/wv_saturation.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/cldwat2m_micro.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/surface_perturbation.F90 + PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fdefault-double-8") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_mp_thompson_make_number_concentrations.F90 + PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fdefault-double-8") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_SF_JSFC.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_BL_MYJPBL.F90 + PROPERTIES COMPILE_FLAGS "-fdefault-real-8 -fdefault-double-8") if (PROJECT STREQUAL "CCPP-FV3") # Set 32-bit floating point precision flags for certain files # that are executed in the dynamics (fast physics part) @@ -126,10 +155,10 @@ if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") CMAKE_Fortran_FLAGS_PREC32 "${CMAKE_Fortran_FLAGS_PREC32}") string(REPLACE "-fdefault-double-8" "" CMAKE_Fortran_FLAGS_PREC32 "${CMAKE_Fortran_FLAGS_PREC32}") - SET_PROPERTY(SOURCE ./physics/gfdl_fv_sat_adj.F90 + SET_PROPERTY(SOURCE ${CMAKE_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90 APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_PREC32} ") # Add all of the above files to the list of schemes with special floating point precision flags - list(APPEND SCHEMES_SFX_PREC ./physics/gfdl_fv_sat_adj.F90) + list(APPEND SCHEMES_SFX_PREC ${CMAKE_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90) endif (DYN32) # Remove files with special floating point precision flags from list @@ -145,30 +174,30 @@ if (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel") # Adjust settings for bit-for-bit reproducibility of NEMSfv3gfs if (PROJECT STREQUAL "CCPP-FV3") - SET_SOURCE_FILES_PROPERTIES(./physics/module_bfmicrophysics.f - ./physics/sflx.f - ./physics/sfc_diff.f - ./physics/sfc_diag.f - ./physics/module_nst_model.f90 - ./physics/calpreciptype.f90 - ./physics/mersenne_twister.f - ./physics/module_nst_water_prop.f90 - ./physics/aer_cloud.F - ./physics/wv_saturation.F - ./physics/cldwat2m_micro.F - ./physics/surface_perturbation.F90 - ./physics/radiation_aerosols.f - ./physics/cu_gf_deep.F90 - ./physics/cu_gf_sh.F90 - ./physics/module_bl_mynn.F90 - ./physics/module_MYNNPBL_wrapper.F90 - ./physics/module_sf_mynn.F90 - ./physics/module_MYNNSFC_wrapper.F90 - ./physics/module_MYNNrad_pre.F90 - ./physics/module_MYNNrad_post.F90 - ./physics/module_mp_thompson_make_number_concentrations.F90 - ./physics/module_SF_JSFC.F90 - ./physics/module_BL_MYJPBL.F90 + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_bfmicrophysics.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sflx.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diff.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diag.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_model.f90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/calpreciptype.f90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/mersenne_twister.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_water_prop.f90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/aer_cloud.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/wv_saturation.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/cldwat2m_micro.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/surface_perturbation.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/radiation_aerosols.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/cu_gf_deep.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/cu_gf_sh.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_bl_mynn.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_MYNNPBL_wrapper.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_sf_mynn.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_MYNNSFC_wrapper.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_MYNNrad_pre.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_MYNNrad_post.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_mp_thompson_make_number_concentrations.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_SF_JSFC.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_BL_MYJPBL.F90 PROPERTIES COMPILE_FLAGS "-r8 -ftz") # Replace -xHost or -xCORE-AVX2 with -xCORE-AVX-I for certain files @@ -182,10 +211,10 @@ elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel") string(REPLACE "-axSSE4.2,AVX,CORE-AVX2,CORE-AVX512" "-axSSE4.2,AVX,CORE-AVX-I" CMAKE_Fortran_FLAGS_LOPT1 "${CMAKE_Fortran_FLAGS_LOPT1}") - SET_SOURCE_FILES_PROPERTIES(./physics/radiation_aerosols.f + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/radiation_aerosols.f PROPERTIES COMPILE_FLAGS "${CMAKE_Fortran_FLAGS_LOPT1}") # Add all of the above files to the list of schemes with special compiler flags - list(APPEND SCHEMES_SFX_OPT ./physics/radiation_aerosols.f) + list(APPEND SCHEMES_SFX_OPT ${CMAKE_CURRENT_SOURCE_DIR}/physics/radiation_aerosols.f) # Remove files with special compiler flags from list of files with standard compiler flags list(REMOVE_ITEM SCHEMES ${SCHEMES_SFX_OPT}) @@ -200,10 +229,10 @@ elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel") set(CMAKE_Fortran_FLAGS_PREC32 ${CMAKE_Fortran_FLAGS_DEFAULT_PREC}) string(REPLACE "-real-size 64" "-real-size 32" CMAKE_Fortran_FLAGS_PREC32 "${CMAKE_Fortran_FLAGS_PREC32}") - SET_PROPERTY(SOURCE ./physics/gfdl_fv_sat_adj.F90 + SET_PROPERTY(SOURCE ${CMAKE_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90 APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_PREC32} ") # Add all of the above files to the list of schemes with special floating point precision flags - list(APPEND SCHEMES_SFX_PREC ./physics/gfdl_fv_sat_adj.F90) + list(APPEND SCHEMES_SFX_PREC ${CMAKE_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90) endif (DYN32) # Remove files with special floating point precision flags from list @@ -216,22 +245,52 @@ elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "Intel") APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_DEFAULT_PREC} ") else (PROJECT STREQUAL "CCPP-FV3") - SET_SOURCE_FILES_PROPERTIES(./physics/module_bfmicrophysics.f ./physics/sflx.f ./physics/sfc_diff.f ./physics/sfc_diag.f PROPERTIES COMPILE_FLAGS -r8) - SET_SOURCE_FILES_PROPERTIES(./physics/module_nst_model.f90 ./physics/calpreciptype.f90 PROPERTIES COMPILE_FLAGS "-r8 -free") - SET_SOURCE_FILES_PROPERTIES(./physics/mersenne_twister.f PROPERTIES COMPILE_FLAGS "-r8 -ftz") - SET_SOURCE_FILES_PROPERTIES(./physics/module_nst_water_prop.f90 PROPERTIES COMPILE_FLAGS "-extend-source 132 -r8 -free") - SET_SOURCE_FILES_PROPERTIES(./physics/aer_cloud.F ./physics/wv_saturation.F ./physics/cldwat2m_micro.F ./physics/surface_perturbation.F90 PROPERTIES COMPILE_FLAGS "-r8") - SET_SOURCE_FILES_PROPERTIES(./physics/module_mp_thompson_make_number_concentrations.F90 PROPERTIES COMPILE_FLAGS "-r8") - SET_SOURCE_FILES_PROPERTIES(./physics/module_SF_JSFC.F90 ./physics/module_BL_MYJPBL.F90 PROPERTIES COMPILE_FLAGS "-r8") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_bfmicrophysics.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sflx.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diff.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diag.f + PROPERTIES COMPILE_FLAGS -r8) + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_model.f90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/calpreciptype.f90 + PROPERTIES COMPILE_FLAGS "-r8 -free") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/mersenne_twister.f + PROPERTIES COMPILE_FLAGS "-r8 -ftz") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_water_prop.f90 + PROPERTIES COMPILE_FLAGS "-extend-source 132 -r8 -free") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/aer_cloud.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/wv_saturation.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/cldwat2m_micro.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/surface_perturbation.F90 + PROPERTIES COMPILE_FLAGS "-r8") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_mp_thompson_make_number_concentrations.F90 + PROPERTIES COMPILE_FLAGS "-r8") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_SF_JSFC.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_BL_MYJPBL.F90 + PROPERTIES COMPILE_FLAGS "-r8") endif (PROJECT STREQUAL "CCPP-FV3") elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "PGI") - SET_SOURCE_FILES_PROPERTIES(./physics/module_bfmicrophysics.f ./physics/sflx.f ./physics/sfc_diff.f ./physics/sfc_diag.f PROPERTIES COMPILE_FLAGS -r8) - SET_SOURCE_FILES_PROPERTIES(./physics/module_nst_model.f90 ./physics/calpreciptype.f90 PROPERTIES COMPILE_FLAGS "-r8 -Mfree") - SET_SOURCE_FILES_PROPERTIES(./physics/mersenne_twister.f PROPERTIES COMPILE_FLAGS "-r8 -Mnofptrap") - SET_SOURCE_FILES_PROPERTIES(./physics/module_nst_water_prop.f90 PROPERTIES COMPILE_FLAGS "-r8 -Mfree") - SET_SOURCE_FILES_PROPERTIES(./physics/aer_cloud.F ./physics/wv_saturation.F ./physics/cldwat2m_micro.F ./physics/surface_perturbation.F90 PROPERTIES COMPILE_FLAGS "-r8") - SET_SOURCE_FILES_PROPERTIES(./physics/module_mp_thompson_make_number_concentrations.F90 PROPERTIES COMPILE_FLAGS "-r8") - SET_SOURCE_FILES_PROPERTIES(./physics/module_SF_JSFC.F90 ./physics/module_BL_MYJPBL.F90 PROPERTIES COMPILE_FLAGS "-r8") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_bfmicrophysics.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sflx.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diff.f + ${CMAKE_CURRENT_SOURCE_DIR}/physics/sfc_diag.f + PROPERTIES COMPILE_FLAGS -r8) + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_model.f90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/calpreciptype.f90 + PROPERTIES COMPILE_FLAGS "-r8 -Mfree") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/mersenne_twister.f + PROPERTIES COMPILE_FLAGS "-r8 -Mnofptrap") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_nst_water_prop.f90 + PROPERTIES COMPILE_FLAGS "-r8 -Mfree") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/aer_cloud.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/wv_saturation.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/cldwat2m_micro.F + ${CMAKE_CURRENT_SOURCE_DIR}/physics/surface_perturbation.F90 + PROPERTIES COMPILE_FLAGS "-r8") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_mp_thompson_make_number_concentrations.F90 + PROPERTIES COMPILE_FLAGS "-r8") + SET_SOURCE_FILES_PROPERTIES(${CMAKE_CURRENT_SOURCE_DIR}/physics/module_SF_JSFC.F90 + ${CMAKE_CURRENT_SOURCE_DIR}/physics/module_BL_MYJPBL.F90 + PROPERTIES COMPILE_FLAGS "-r8") if (PROJECT STREQUAL "CCPP-FV3") # Set 32-bit floating point precision flags for certain files # that are executed in the dynamics (fast physics part) @@ -240,10 +299,10 @@ elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "PGI") set(CMAKE_Fortran_FLAGS_PREC32 ${CMAKE_Fortran_FLAGS_DEFAULT_PREC}) string(REPLACE "-r8" "-r4" CMAKE_Fortran_FLAGS_PREC32 "${CMAKE_Fortran_FLAGS_PREC32}") - SET_PROPERTY(SOURCE ./physics/gfdl_fv_sat_adj.F90 + SET_PROPERTY(SOURCE ${CMAKE_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90 APPEND_STRING PROPERTY COMPILE_FLAGS " ${CMAKE_Fortran_FLAGS_PREC32} ") # Add all of the above files to the list of schemes with special floating point precision flags - list(APPEND SCHEMES_SFX_PREC ./physics/gfdl_fv_sat_adj.F90) + list(APPEND SCHEMES_SFX_PREC ${CMAKE_CURRENT_SOURCE_DIR}/physics/gfdl_fv_sat_adj.F90) endif (DYN32) # Remove files with special floating point precision flags from list @@ -291,9 +350,10 @@ if(STATIC) add_library(ccppphys STATIC ${SCHEMES} ${SCHEMES_SFX_OPT} ${CAPS}) # Generate list of Fortran modules from defined sources foreach(source_f90 ${CAPS}) - string(REGEX REPLACE ".F90" ".mod" tmp_module_f90 ${source_f90}) + 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}) + list(APPEND MODULES_F90 ${CMAKE_CURRENT_BINARY_DIR}/${module_f90}) endforeach() else(STATIC) add_library(ccppphys SHARED ${SCHEMES} ${SCHEMES_SFX_OPT} ${CAPS}) diff --git a/physics/GFS_MP_generic.F90 b/physics/GFS_MP_generic.F90 index 66357844f..512257258 100644 --- a/physics/GFS_MP_generic.F90 +++ b/physics/GFS_MP_generic.F90 @@ -270,7 +270,7 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt enddo enddo - ! Conversion factor mm per physics timestep to m per day + ! Conversion factor from mm per day to m per physics timestep tem = dtp * con_p001 / con_day !> - For GFDL and Thompson MP scheme, determine convective snow by surface temperature; @@ -280,26 +280,34 @@ subroutine GFS_MP_generic_post_run(im, ix, levs, kdt, nrcm, ncld, nncl, ntcw, nt if (imp_physics == imp_physics_gfdl .or. imp_physics == imp_physics_thompson) then ! determine convective rain/snow by surface temperature ! determine large-scale rain/snow by rain/snow coming out directly from MP - do i = 1, im - !tprcp(i) = max(0.0, rain(i) )! clu: rain -> tprcp ! DH now lines 245-250 - srflag(i) = 0. ! clu: default srflag as 'rain' (i.e. 0) - if (tsfc(i) >= 273.15) then - crain = rainc(i) - csnow = 0.0 - else - crain = 0.0 - csnow = rainc(i) - endif -! if (snow0(i,1)+ice0(i,1)+graupel0(i,1)+csnow > rain0(i,1)+crain) then -! if (snow0(i)+ice0(i)+graupel0(i)+csnow > 0.0) then -! Sfcprop%srflag(i) = 1. ! clu: set srflag to 'snow' (i.e. 1) -! endif + + if (lsm/=lsm_ruc) then + do i = 1, im + !tprcp(i) = max(0.0, rain(i) )! clu: rain -> tprcp ! DH now lines 245-250 + srflag(i) = 0. ! clu: default srflag as 'rain' (i.e. 0) + if (tsfc(i) >= 273.15) then + crain = rainc(i) + csnow = 0.0 + else + crain = 0.0 + csnow = rainc(i) + endif +! if (snow0(i,1)+ice0(i,1)+graupel0(i,1)+csnow > rain0(i,1)+crain) then +! if (snow0(i)+ice0(i)+graupel0(i)+csnow > 0.0) then +! Sfcprop%srflag(i) = 1. ! clu: set srflag to 'snow' (i.e. 1) +! endif ! compute fractional srflag - total_precip = snow0(i)+ice0(i)+graupel0(i)+rain0(i)+rainc(i) - if (total_precip > rainmin) then - srflag(i) = (snow0(i)+ice0(i)+graupel0(i)+csnow)/total_precip - endif - enddo + total_precip = snow0(i)+ice0(i)+graupel0(i)+rain0(i)+rainc(i) + if (total_precip > rainmin) then + srflag(i) = (snow0(i)+ice0(i)+graupel0(i)+csnow)/total_precip + endif + enddo + else + ! only for RUC LSM + do i=1,im + srflag(i) = sr(i) + enddo + endif ! lsm==lsm_ruc elseif( .not. cal_pre) then if (imp_physics == imp_physics_mg) then ! MG microphysics do i=1,im diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 4ad699529..f9e2369cd 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -164,7 +164,7 @@ 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) @@ -172,13 +172,13 @@ 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 .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 == 1) then + if (Model%iccn) 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 @@ -242,7 +242,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 == 1) then + if (Model%iccn) 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, & @@ -451,7 +451,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 == 1) then + if (Model%iccn) 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 34a04192a..5e60f667f 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -107,7 +107,7 @@ 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) @@ -115,11 +115,11 @@ 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 .false., then ntrcaer == 1 + ! If Model%iaerclm is .false., then ntrcaer == 1 ntrcaer = size(Tbd%aer_nm, dim=3) endif - if (Model%iccn == 1) then + if (Model%iccn) 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 @@ -156,7 +156,7 @@ subroutine GFS_phys_time_vary_init (Grid, Model, Interstitial, Tbd, errmsg, errf Model%me, Model%master) endif !--- read in and initialize IN and CCN - if (Model%iccn == 1) then + if (Model%iccn) 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) @@ -331,7 +331,7 @@ subroutine GFS_phys_time_vary_run (Grid, Statein, Model, Tbd, Sfcprop, Cldprop, Tbd%aer_nm) endif !--- ICCN interpolation - if (Model%iccn == 1) then + if (Model%iccn) 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/cires_ugwp_post.F90 b/physics/cires_ugwp_post.F90 index 72f59a6c5..70a7d602d 100755 --- a/physics/cires_ugwp_post.F90 +++ b/physics/cires_ugwp_post.F90 @@ -37,19 +37,19 @@ subroutine cires_ugwp_post_run (ldiag_ugwp, dtf, im, levs, & real(kind=kind_phys), intent(in) :: dtf logical, intent(in) :: ldiag_ugwp !< flag for CIRES UGWP Diagnostics - real(kind=kind_phys), intent(in), dimension(im) :: zmtb, zlwb, zogw - real(kind=kind_phys), intent(in), dimension(im) :: tau_mtb, tau_ogw, tau_tofd, tau_ngw - real(kind=kind_phys), intent(inout), dimension(im) :: tot_mtb, tot_ogw, tot_tofd, tot_ngw - real(kind=kind_phys), intent(inout), dimension(im) :: tot_zmtb, tot_zlwb, tot_zogw - real(kind=kind_phys), intent(in), dimension(im, levs) :: gw_dtdt, gw_dudt, gw_dvdt, dudt_mtb, dudt_ogw, dudt_tms - real(kind=kind_phys), intent(inout), dimension(im, levs) :: du3dt_mtb, du3dt_ogw, du3dt_tms, du3dt_ngw, dv3dt_ngw - real(kind=kind_phys), intent(inout), dimension(im, levs) :: dtdt, dudt, dvdt + real(kind=kind_phys), intent(in), dimension(:) :: zmtb, zlwb, zogw + real(kind=kind_phys), intent(in), dimension(:) :: tau_mtb, tau_ogw, tau_tofd, tau_ngw + real(kind=kind_phys), intent(inout), dimension(:) :: tot_mtb, tot_ogw, tot_tofd, tot_ngw + real(kind=kind_phys), intent(inout), dimension(:) :: tot_zmtb, tot_zlwb, tot_zogw + real(kind=kind_phys), intent(in), dimension(:,:) :: gw_dtdt, gw_dudt, gw_dvdt, dudt_mtb, dudt_ogw, dudt_tms + real(kind=kind_phys), intent(inout), dimension(:,:) :: du3dt_mtb, du3dt_ogw, du3dt_tms, du3dt_ngw, dv3dt_ngw + real(kind=kind_phys), intent(inout), dimension(:,:) :: dtdt, dudt, dvdt ! For if (lssav) block, originally in gwdps_post_run logical, intent(in) :: lssav, ldiag3d - real(kind=kind_phys), intent(in), dimension(im) :: dusfcg, dvsfcg - real(kind=kind_phys), intent(inout), dimension(im) :: dugwd, dvgwd - real(kind=kind_phys), intent(inout), dimension(im, levs) :: du3dt, dv3dt, dt3dt + real(kind=kind_phys), intent(in), dimension(:) :: dusfcg, dvsfcg + real(kind=kind_phys), intent(inout), dimension(:) :: dugwd, dvgwd + real(kind=kind_phys), intent(inout), dimension(:,:) :: du3dt, dv3dt, dt3dt character(len=*), intent(out) :: errmsg integer, intent(out) :: errflg diff --git a/physics/cs_conv.F90 b/physics/cs_conv.F90 index f9d7518ef..956d5a1d0 100644 --- a/physics/cs_conv.F90 +++ b/physics/cs_conv.F90 @@ -181,10 +181,9 @@ module cs_conv ! spblcrit=0.03, & !< minimum cloudbase height in p/ps ! spblcrit=0.035,& !< minimum cloudbase height in p/ps ! spblcrit=0.025,& !< minimum cloudbase height in p/ps - cincrit=-10.0, & - capecrit=0.0 -! cincrit=-120.0 -! cincrit=-100.0 + cincrit= -150.0 +! cincrit= -120.0 +! cincrit= -100.0 !DD precz0 and preczh control partitioning of water between detrainment !DD and precipitation. Decrease for more precip @@ -1080,22 +1079,8 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions DO I=ISTS,IENS CAPE(i) = zero CIN(i) = zero -! JBUOY(i) = 0 + JBUOY(i) = 0 enddo - -!Anning Cheng, CIN from the cloud base to positive buoy layer only - DO I=ISTS,IENS - if (kb(i) > 0) then - DO K=kb(i),KMAX - BUOY = (GDH(I,1)-GDHS(I,K)) / ((one+ELOCP*FDQS(I,K)) * CP*GDT(I,K)) - if (BUOY < 0.) then - CIN(I) = CIN(I) + BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) - else - cycle - end if - ENDDO - end if - ENDDO DO K=2,KMAX DO I=ISTS,IENS if (kb(i) > 0) then @@ -1104,22 +1089,21 @@ SUBROUTINE CS_CUMLUS (im , IJSDIM, KMAX , NTR , & !DD dimensions ELSE BUOY = (GDS(I,1)-GDS(I,K)) / (CP*GDT(I,K)) END IF - IF (BUOY > zero) THEN + IF (BUOY > zero .AND. JBUOY(I) >= -1) THEN CAPE(I) = CAPE(I) + BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) -! IF (BUOY > zero .AND. JBUOY(I) /= 0) THEN -! CAPE(I) = CAPE(I) + BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) -! JBUOY(I) = 2 -! ELSEIF (BUOY < zero .AND. JBUOY(I) /= 2) THEN -! CIN(I) = CIN(I) - BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) -! JBUOY(I) = 1 + JBUOY(I) = 2 + ELSEIF (BUOY < zero .AND. JBUOY(I) /= 2) THEN + CIN(I) = CIN(I) - BUOY * GRAV * (GDZM(I,K+1) - GDZM(I,K)) + JBUOY(I) = -1 ENDIF endif ENDDO ENDDO DO I=ISTS,IENS -! IF (JBUOY(I) /= 2) CIN(I) = -999.D0 - if (cin(i) < cincrit .or. cape(i) -# Initialize variables before summing over cloud types do k=1,kmax ! Moorthi diff --git a/physics/drag_suite.F90 b/physics/drag_suite.F90 index 56902c631..eb371adb1 100644 --- a/physics/drag_suite.F90 +++ b/physics/drag_suite.F90 @@ -485,7 +485,7 @@ subroutine drag_suite_run( & varmax_fd = 150., & beta_ss = 0.1, & beta_fd = 0.2 - real(kind=kind_phys) :: var_temp + real(kind=kind_phys) :: var_temp, var_temp2 ! added Beljaars orographic form drag real(kind=kind_phys), dimension(im,km) :: utendform,vtendform @@ -1060,7 +1060,9 @@ subroutine drag_suite_run( & !tauwavex0=0.5*XNBV*xlinv(i)*(2.*MIN(varss(i),40.))**2*ro(i,kts)*u1(i,3) var_temp = MIN(varss(i),varmax_ss) + & MAX(0.,beta_ss*(varss(i)-varmax_ss)) - tauwavex0=0.5*XNBV*xlinv(i)*(2.*var_temp)**2*ro(i,kvar)*u1(i,kvar) + ! Note: This is a semi-implicit treatment of the time differencing + var_temp2 = 0.5*XNBV*xlinv(i)*(2.*var_temp)**2*ro(i,kvar) ! this is greater than zero + tauwavex0=-var_temp2*u1(i,kvar)/(1.+var_temp2*deltim) tauwavex0=tauwavex0*ss_taper else tauwavex0=0. @@ -1073,7 +1075,8 @@ subroutine drag_suite_run( & !tauwavey0=0.5*XNBV*xlinv(i)*(2.*MIN(varss(i),40.))**2*ro(i,kts)*v1(i,3) var_temp = MIN(varss(i),varmax_ss) + & MAX(0.,beta_ss*(varss(i)-varmax_ss)) - tauwavey0=0.5*XNBV*xlinv(i)*(2.*var_temp)**2*ro(i,kvar)*v1(i,kvar) + ! Note: This is a semi-implicit treatment of the time differencing + tauwavey0=-var_temp2*v1(i,kvar)/(1.+var_temp2*deltim) tauwavey0=tauwavey0*ss_taper else tauwavey0=0. @@ -1154,10 +1157,12 @@ subroutine drag_suite_run( & DO k=kts,km wsp=SQRT(u1(i,k)**2 + v1(i,k)**2) ! alpha*beta*Cmd*Ccorr*2.109 = 12.*1.*0.005*0.6*2.109 = 0.0759 - utendform(i,k)=-0.0759*wsp*u1(i,k)* & - EXP(-(zl(i,k)/H_efold)**1.5)*a2*zl(i,k)**(-1.2)*ss_taper - vtendform(i,k)=-0.0759*wsp*v1(i,k)* & - EXP(-(zl(i,k)/H_efold)**1.5)*a2*zl(i,k)**(-1.2)*ss_taper + var_temp = 0.0759*EXP(-(zl(i,k)/H_efold)**1.5)*a2* & + zl(i,k)**(-1.2)*ss_taper ! this is greater than zero + ! Note: This is a semi-implicit treatment of the time differencing + ! per Beljaars et al. (2004, QJRMS) + utendform(i,k) = - var_temp*wsp*u1(i,k)/(1. + var_temp*deltim*wsp) + vtendform(i,k) = - var_temp*wsp*v1(i,k)/(1. + var_temp*deltim*wsp) !IF(zl(i,k) > 4000.) exit ENDDO ENDIF diff --git a/physics/gwdps.f b/physics/gwdps.f index d5e34a04a..0ea2c8754 100644 --- a/physics/gwdps.f +++ b/physics/gwdps.f @@ -299,12 +299,8 @@ subroutine gwdps_run( & ! Interface variables integer, intent(in) :: im, ix, km, imx, kdt, ipr, me integer, intent(in) :: KPBL(IM) ! Index for the PBL top layer! - ! DH* adding intent(in) information for the following variables - ! changes the results on Theia/Intel - skip for bit-for-bit results *DH -! real(kind=kind_phys), intent(in) :: & -! & deltim, G, CP, RD, RV, cdmbgwd(2) - real(kind=kind_phys) deltim, G, CP, RD, RV, cdmbgwd(4) - ! *DH + real(kind=kind_phys), intent(in) :: & + & deltim, G, CP, RD, RV, cdmbgwd(4) real(kind=kind_phys), intent(inout) :: & & A(IX,KM), B(IX,KM), C(IX,KM) real(kind=kind_phys), intent(in) :: & diff --git a/physics/module_gfdl_cloud_microphys.F90 b/physics/module_gfdl_cloud_microphys.F90 index 2f6e5ec1a..01ab4655c 100644 --- a/physics/module_gfdl_cloud_microphys.F90 +++ b/physics/module_gfdl_cloud_microphys.F90 @@ -4729,7 +4729,7 @@ subroutine cloud_diagnosis (is, ie, ks, ke, den, delp, lsm, qmw, qmi, qmr, qms, real :: n0r = 8.0e6, n0s = 3.0e6, n0g = 4.0e6 real :: alphar = 0.8, alphas = 0.25, alphag = 0.5 real :: gammar = 17.837789, gammas = 8.2850630, gammag = 11.631769 - real :: qmin = 1.0e-12, beta = 1.22 + real :: qmin = 1.0e-12, beta = 1.22, qmin1 = 9.e-6 do k = ks, ke do i = is, ie @@ -4759,7 +4759,7 @@ subroutine cloud_diagnosis (is, ie, ks, ke, den, delp, lsm, qmw, qmi, qmr, qms, ! cloud ice (Heymsfield and Mcfarquhar, 1996) ! ----------------------------------------------------------------------- - if (qmi (i, k) .gt. qmin) then + if (qmi (i, k) .gt. qmin1) then qci (i, k) = dpg * qmi (i, k) * 1.0e3 rei_fac = log (1.0e3 * qmi (i, k) * den (i, k)) if (t (i, k) - tice .lt. - 50) then @@ -4785,7 +4785,7 @@ subroutine cloud_diagnosis (is, ie, ks, ke, den, delp, lsm, qmw, qmi, qmr, qms, ! cloud ice (Wyser, 1998) ! ----------------------------------------------------------------------- - if (qmi (i, k) .gt. qmin) then + if (qmi (i, k) .gt. qmin1) then qci (i, k) = dpg * qmi (i, k) * 1.0e3 bw = - 2. + 1.e-3 * log10 (den (i, k) * qmi (i, k) / rho_0) * max (0.0, tice - t (i, k)) ** 1.5 rei (i, k) = 377.4 + bw * (203.3 + bw * (37.91 + 2.3696 * bw)) @@ -4815,7 +4815,7 @@ subroutine cloud_diagnosis (is, ie, ks, ke, den, delp, lsm, qmw, qmi, qmr, qms, ! snow (Lin et al., 1983) ! ----------------------------------------------------------------------- - if (qms (i, k) .gt. qmin) then + if (qms (i, k) .gt. qmin1) then qcs (i, k) = dpg * qms (i, k) * 1.0e3 lambdas = exp (0.25 * log (pi * rhos * n0s / qms (i, k) / den (i, k))) res (i, k) = 0.5 * exp (log (gammas / 6) / alphas) / lambdas * 1.0e6 diff --git a/physics/mp_thompson.F90 b/physics/mp_thompson.F90 index 3b2da9c3e..812229f98 100644 --- a/physics/mp_thompson.F90 +++ b/physics/mp_thompson.F90 @@ -395,7 +395,7 @@ subroutine mp_thompson_run(ncol, nlev, con_g, con_rd, & graupel = max(0.0, delta_graupel_mp/1000.0_kind_phys) ice = max(0.0, delta_ice_mp/1000.0_kind_phys) snow = max(0.0, delta_snow_mp/1000.0_kind_phys) - rain = max(0.0, delta_rain_mp - (delta_graupel_mp + delta_ice_mp + delta_snow_mp)/1000.0_kind_phys) + rain = max(0.0, (delta_rain_mp - (delta_graupel_mp + delta_ice_mp + delta_snow_mp))/1000.0_kind_phys) end subroutine mp_thompson_run !>@} diff --git a/physics/sfc_drv_ruc.F90 b/physics/sfc_drv_ruc.F90 index 64e4d4597..fe12b5e17 100644 --- a/physics/sfc_drv_ruc.F90 +++ b/physics/sfc_drv_ruc.F90 @@ -69,7 +69,6 @@ end subroutine lsm_ruc_finalize ! im - integer, horiz dimention and num of used pts 1 ! ! km - integer, vertical soil layer dimension 9 ! ! ps - real, surface pressure (pa) im ! -! u1, v1 - real, u/v component of surface layer wind im ! ! t1 - real, surface layer mean temperature (k) im ! ! q1 - real, surface layer mean specific humidity im ! ! soiltyp - integer, soil type (integer index) im ! @@ -86,6 +85,7 @@ end subroutine lsm_ruc_finalize ! prsl1 - real, sfc layer 1 mean pressure (pa) im ! ! prslki - real, dimensionless exner function at layer 1 im ! ! zf - real, height of bottom layer (m) im ! +! wind real, surface layer wind speed (m/s) im ! ! slopetyp - integer, class of sfc slope (integer index) im ! ! shdmin - real, min fractional coverage of green veg im ! ! shdmax - real, max fractnl cover of green veg (not used) im ! @@ -139,13 +139,13 @@ end subroutine lsm_ruc_finalize ! DH* TODO - make order of arguments the same as in the metadata table subroutine lsm_ruc_run & ! inputs & ( iter, me, master, kdt, im, nlev, lsoil_ruc, lsoil, zs, & - & u1, v1, t1, q1, qc, soiltyp, vegtype, sigmaf, & + & t1, q1, qc, soiltyp, vegtype, sigmaf, & & sfcemis, dlwflx, dswsfc, snet, delt, tg3, cm, ch, & - & prsl1, zf, ddvel, shdmin, shdmax, alvwf, alnwf, & + & prsl1, zf, wind, shdmin, shdmax, alvwf, alnwf, & & snoalb, sfalb, flag_iter, flag_guess, isot, ivegsrc, fice, & - & smc, stc, slc, lsm_ruc, lsm, land, & + & smc, stc, slc, lsm_ruc, lsm, land, islimsk, & & imp_physics, imp_physics_gfdl, imp_physics_thompson, & - & smcwlt2, smcref2, wspd, do_mynnsfclay, & + & smcwlt2, smcref2, do_mynnsfclay, & & con_cp, con_rv, con_rd, con_g, con_pi, con_hvap, con_fvirt,& ! constants & weasd, snwdph, tskin, tskin_ocn, & ! in/outs & rainnc, rainc, ice, snow, graupel, & ! in @@ -173,10 +173,10 @@ subroutine lsm_ruc_run & ! inputs real (kind=kind_phys), dimension(im,lsoil), intent(inout) :: smc,stc,slc - real (kind=kind_phys), dimension(im), intent(in) :: u1, v1,& + real (kind=kind_phys), dimension(im), intent(in) :: & & t1, sigmaf, sfcemis, dlwflx, dswsfc, snet, tg3, cm, & - & ch, prsl1, ddvel, shdmin, shdmax, & - & snoalb, alvwf, alnwf, zf, qc, q1, wspd + & ch, prsl1, wind, shdmin, shdmax, & + & snoalb, alvwf, alnwf, zf, qc, q1 real (kind=kind_phys), intent(in) :: delt real (kind=kind_phys), intent(in) :: con_cp, con_rv, con_g, & @@ -184,6 +184,7 @@ subroutine lsm_ruc_run & ! inputs con_hvap, con_fvirt logical, dimension(im), intent(in) :: flag_iter, flag_guess, land + integer, dimension(im), intent(in) :: islimsk ! sea/land/ice mask (=0/1/2) logical, intent(in) :: do_mynnsfclay ! --- in/out: @@ -215,7 +216,7 @@ subroutine lsm_ruc_run & ! inputs ! --- locals: real (kind=kind_phys), dimension(im) :: rch, rho, & - & q0, qs1, wind, weasd_old, snwdph_old, & + & q0, qs1, weasd_old, snwdph_old, & & tprcp_old, srflag_old, tskin_old, canopy_old, & & tsnow_old, snowfallac_old, acsnow_old, sfalb_old, & & sfcqv_old, sfcqc_old, wetness_old, zorl_old, sncovr1_old @@ -384,7 +385,7 @@ subroutine lsm_ruc_run & ! inputs !> - Set flag for land and ice points. !- 10may19 - ice points are turned off. flag(i) = land(i) - if (land(i) .and. (vegtype(i)==iswater .or. vegtype(i)==isice)) then + if (land(i) .and. (vegtype(i)==iswater .or. (vegtype(i)==isice.and.islimsk(i)==2))) then !write(errmsg,'(a,i0,a,i0)') 'Logic error in sfc_drv_ruc_run: for i=', i, & ! ', land(i) is true but vegtype(i) is water or ice: ', vegtype(i) !errflg = 1 @@ -471,15 +472,7 @@ subroutine lsm_ruc_run & ! inputs do i = 1, im if (flag_iter(i) .and. flag(i)) then - !if (do_mynnsfclay) then - ! WARNING - used of wspd computed in MYNN sfc leads to massive cooling. - ! wind(i) = wspd(i) - !else - wind(i) = max(sqrt( u1(i)*u1(i) + v1(i)*v1(i) ) & - + max(0.0, min(ddvel(i), 30.0)), 1.0) - !endif q0(i) = max(q1(i)/(1.-q1(i)), 1.e-8) !* q1=specific humidity at level 1 (kg/kg) - rho(i) = prsl1(i) / (con_rd*t1(i)*(1.0+con_fvirt*q0(i))) qs1(i) = rslf(prsl1(i),t1(i)) !* qs1=sat. mixing ratio at level 1 (kg/kg) q0 (i) = min(qs1(i), q0(i)) @@ -897,7 +890,7 @@ subroutine lsm_ruc_run & ! inputs sfcdew(i) = dew(i,j) qsurf(i) = qsfc(i,j) sncovr1(i) = sncovr(i,j) - stm(i) = soilm(i,j) * 1000.0 ! unit conversion (from m to kg m-2) + stm(i) = soilm(i,j) tsurf(i) = soilt(i,j) tice(i) = tsurf(i) diff --git a/physics/sfc_drv_ruc.meta b/physics/sfc_drv_ruc.meta index 8d06e4785..dac459405 100644 --- a/physics/sfc_drv_ruc.meta +++ b/physics/sfc_drv_ruc.meta @@ -278,6 +278,14 @@ type = logical intent = in optional = F +[islimsk] + standard_name = sea_land_ice_mask + long_name = sea/land/ice mask (=0/1/2) + units = flag + dimensions = (horizontal_dimension) + type = integer + intent = in + optional = F [rainnc] standard_name = lwe_thickness_of_explicit_rainfall_amount_from_previous_timestep long_name = explicit rainfall from previous timestep @@ -377,24 +385,6 @@ kind = kind_phys intent = in optional = F -[u1] - standard_name = x_wind_at_lowest_model_layer - long_name = zonal wind at lowest model layer - units = m s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F -[v1] - standard_name = y_wind_at_lowest_model_layer - long_name = meridional wind at lowest model layer - units = m s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = in - optional = F [prsl1] standard_name = air_pressure_at_lowest_model_layer long_name = mean pressure at lowest model layer @@ -404,9 +394,9 @@ kind = kind_phys intent = in optional = F -[ddvel] - standard_name = surface_wind_enhancement_due_to_convection - long_name = surface wind enhancement due to convection +[wind] + standard_name = wind_speed_at_lowest_model_layer + long_name = wind speed at lowest model level units = m s-1 dimensions = (horizontal_dimension) type = real @@ -468,23 +458,14 @@ intent = in optional = F [sfcemis] - standard_name = surface_longwave_emissivity - long_name = surface lw emissivity in fraction + standard_name = surface_longwave_emissivity_over_land_interstitial + long_name = surface lw emissivity in fraction over land (temporary use as interstitial) units = frac dimensions = (horizontal_dimension) type = real kind = kind_phys intent = inout optional = F -[wspd] - standard_name = wind_speed_at_lowest_model_layer - long_name = wind speed at lowest model level - units = m s-1 - dimensions = (horizontal_dimension) - type = real - kind = kind_phys - intent = inout - optional = F [cm] standard_name = surface_drag_coefficient_for_momentum_in_air_over_land long_name = surface exchange coeff for momentum over land From 47ecb07ac0e7dfee9537fa5a013b7bf1e9ed9b7c Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Mon, 6 Jan 2020 16:08:16 -0500 Subject: [PATCH 06/44] regression test for iccn=1 and iccn=2 --- physics/GFS_phys_time_vary.fv3.F90 | 6 +++--- physics/GFS_phys_time_vary.scm.F90 | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index f9e2369cd..16f84e4c7 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -178,7 +178,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e !$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 @@ -242,7 +242,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, & @@ -451,7 +451,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 5e60f667f..095dac2c7 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -119,7 +119,7 @@ subroutine GFS_phys_time_vary_init (Grid, Model, Interstitial, Tbd, errmsg, errf 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 @@ -156,7 +156,7 @@ subroutine GFS_phys_time_vary_init (Grid, Model, Interstitial, Tbd, errmsg, errf 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) @@ -331,7 +331,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, & From 15ca41814c28f91b9a4db86fe4f50c85b38de323 Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Fri, 17 Jan 2020 14:16:25 -0500 Subject: [PATCH 07/44] MERRA2 consistent radiation pass regression tests --- physics/GFS_rrtmg_pre.F90 | 7 +- physics/aerclm_def.F | 21 +- physics/aerinterp.F90 | 323 ++-- physics/radiation_aerosols.f | 3128 +++++++++++----------------------- 4 files changed, 1139 insertions(+), 2340 deletions(-) diff --git a/physics/GFS_rrtmg_pre.F90 b/physics/GFS_rrtmg_pre.F90 index f6e683bff..7845165a6 100644 --- a/physics/GFS_rrtmg_pre.F90 +++ b/physics/GFS_rrtmg_pre.F90 @@ -473,9 +473,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/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..8c7046d37 100644 --- a/physics/aerinterp.F90 +++ b/physics/aerinterp.F90 @@ -16,169 +16,185 @@ module aerinterp contains SUBROUTINE read_aerdata (me, master, iflip, idate ) - - use machine, only: kind_phys + use machine, only: kind_phys, kind_io4, kind_io8 use aerclm_def use netcdf !--- in/out integer, intent(in) :: me, master, iflip, idate(4) - !--- 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 + print *, 'fname not found, abort' + stop 8888 + endif + call nf_open(fname , nf90_NOWRITE, ncid) + + vname = trim(specname(1)) + call nf_inq_varid(ncid, vname, varid) + call nf_inq_varndims(ncid, varid, ndims) + + 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) + +! specify latsaer, lonsaer, hmx + lonsaer = dim1 + latsaer = dim2 + hmx = int(dim1/2) ! to swap long from W-E to E-W + + if(me==master) then + print *, 'MERRA2 dim: ',dim1, dim2, dim3 + endif + +! allocate arrays + if (.not. allocated(aer_loni)) then + allocate (aer_loni(lonsaer)) + allocate (aer_lati(latsaer)) + endif + + 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 + +! 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 + + do i = 1, latsaer + aer_lat(i) = aer_lati(i) + enddo + + call nf_close(ncid) + +! 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 +!! =================================================================== +!! loop thru m01 - m12 for aer/pres array +!! =================================================================== 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, & + fname=trim("aeroclim.m"//mn//".nc") + if (me == master) print *, "aerosol climo:", fname, & "for imon:",imon,idate inquire (file = fname, exist = file_exist) if ( file_exist ) then if (me == master) print *, & - "EJ, aerosol climo found; proceed the run" + "aerosol climo found; proceed the run" else - print *,"EJ, Error! aerosol climo not found; abort the run" + print *,"Error! aerosol climo not found; abort the run" stop 555 endif - call nf_open(fname, NF90_NOWRITE, ncid) + call nf_open(fname , nf90_NOWRITE, ncid) -! merra2 data is top down -! for GFS, iflip 0: toa to sfc; 1: sfc to toa - -! 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) - -! aer_clm is top-down (following MERRA2) -! aerin is bottom-up (following GFS) - -! if ( imon == 1 .and. me == master ) then -! print *, 'EJ, du1(1,1) :', aerin(1,1,:,1,imon) -! endif - -! construct 3-d pressure array (Pa) - call nf_inq_varid(ncid, "PS", varid) - call nf_get_var(ncid, varid, ps_clm) +! ====> construct 3-d pressure array (Pa) call nf_inq_varid(ncid, "DELP", varid) - call nf_get_var(ncid, varid, delp_clm) - -! 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_get_var(ncid, varid, buff) - do i = 1, lonsaer 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) -! 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 - -! 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 + klev = ( dim3 - k ) + 1 endif - aer_pres(i,j,k,imon)= pres_tmp(klev) + 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) + aerin(i,j,k,ii,imon) = 1.d0*buffx(i+hmx,j,klev,1) + 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 + END SUBROUTINE read_aerdata ! !********************************************************************** ! @@ -214,11 +230,6 @@ SUBROUTINE setindxaer(npts,dlat,jindx1,jindx2,ddy,dlon, & 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,11 +248,6 @@ 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 @@ -265,7 +271,8 @@ SUBROUTINE aerinterpol(me,master,npts,IDATE,FHOUR,jindx1,jindx2, & 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 +293,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 @@ -307,15 +313,8 @@ 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 +! DO L=1,levsaer DO J=1,npts J1 = JINDX1(J) @@ -338,51 +337,41 @@ SUBROUTINE aerinterpol(me,master,npts,IDATE,FHOUR,jindx1,jindx2, & +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 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 + endif + ENDDO !L-loop + ENDDO !J-loop ! - RETURN + RETURN END SUBROUTINE aerinterpol end module aerinterp + diff --git a/physics/radiation_aerosols.f b/physics/radiation_aerosols.f index 60bb50d34..339b991f0 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 : ntrcaer + ! implicit none ! @@ -167,29 +183,29 @@ 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 + integer, save :: NSWBND = NBDSW +!> 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 - integer, save :: NSWLWBD = NBDSW+NBDLW + integer, save :: NLWBND = NBDLW +!> 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 ! =.false.:aerosol effect is not 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 +!> \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(:,:) :: & - & ssarhi_grt -! asymmetry parameter for SW+LW spectral 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 + elseif ( iaermdl==1 .or. iaermdl==2 ) then ! gocart clim/prog scheme -! call gcrt_climinit - -! 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 !................................ @@ -971,11 +783,11 @@ subroutine set_spectrum ! ! ! ==================== defination of variables =================== ! ! ! -!> - inputs: (module constants) -!! - NWVTOT: total num of wave numbers used in sw spectrum -!! - NWVTIR: total num of wave numbers used in the ir region -!! -!> - outputs: (in-scope variables) +!> - inputs: (module constants) +!! - NWVTOT: total num of wave numbers used in sw spectrum +!! - NWVTIR: total num of wave numbers used in the ir region +!! +!> - outputs: (in-scope variables) !! - solfwv(NWVTOT): solar flux for each individual wavenumber !! (\f$W/m^2\f$) !! - eirfwv(NWVTIR): ir flux(273k) for each individual wavenumber @@ -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,8 +904,8 @@ end subroutine aer_init !----------------------------------- !!@} -!>\ingroup module_radiation_aerosols -!> This subroutine is the opac-climatology aerosol initialization + +!> 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 !! \f$(w/m^2)\f$ @@ -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 @@ -1291,7 +1098,7 @@ subroutine set_aercoef ! !===> ... begin here ! -!> -# Reading climatological aerosols optical data from aeros_file, +!> -# Reading climatological aerosols optical data from aeros_file, !! including: inquire (file=aeros_file, exist=file_exist) @@ -1336,56 +1143,56 @@ subroutine set_aercoef endif !> - ending wave num for 61 aerosol spectral bands - read(NIAERCM,21) cline + read(NIAERCM,21) cline 21 format(a80) read(NIAERCM,22) iendwv(:) 22 format(13i6) !> - atmos scale height for 5 domains, 7 profs - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,24) haer(:,:) 24 format(20f4.1) !> - reference pressure for 5 domains, 7 profs - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,26) prsref(:,:) 26 format(10f7.2) !> - rh independent ext coef for 61 bands, 6 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhidext0(:,:) 28 format(8e10.3) !> - rh independent sca coef for 61 bands, 6 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhidsca0(:,:) !> - rh independent ssa coef for 61 bands, 6 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhidssa0(:,:) !> - rh independent asy coef for 61 bands, 6 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhidasy0(:,:) !> - rh dependent ext coef for 61 bands, 8 rh lev, 4 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhdpext0(:,:,:) !> - rh dependent sca coef for 61 bands, 8 rh lev, 4 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhdpsca0(:,:,:) !> - rh dependent ssa coef for 61 bands, 8 rh lev, 4 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhdpssa0(:,:,:) !> - rh dependent asy coef for 61 bands, 8 rh lev, 4 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhdpasy0(:,:,:) !> - stratospheric background aeros for 61 bands - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) straext0(:) close (NIAERCM) @@ -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 & @@ -1955,12 +1759,16 @@ subroutine aer_update & endif !> -# Call trop_update() to update monthly tropospheric aerosol data. - if ( lalwflg .or. laswflg ) then + 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. - if ( lavoflg ) then + if ( lavoflg ) then call volc_update endif @@ -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,27 +2359,12 @@ 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 !> -# Compute stratosphere volcanic forcing: !! - select data in 4 lat bands, interpolation at the boundaries -!! - Find lower boundary of stratosphere: polar, fixed at 25000pa +!! - Find lower boundary of stratosphere: polar, fixed at 25000pa !! (250mb); tropic, fixed at 15000pa (150mb); mid-lat, interpolation !! - SW: add volcanic aerosol optical depth to the background value !! - Smoothing profile at boundary if needed @@ -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,13 +2678,13 @@ 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 & + subroutine aer_property & & ( prsi,prsl,prslk,tvly,rhlay,dz,hz,tracer, & ! --- inputs: - & alon,alat,slmsk, laersw,laerlw, & - & IMAX,NLAY,NLP1, & + & alon,alat,slmsk, laersw,laerlw, & + & IMAX,NLAY,NLP1, & & aerosw,aerolw,aerodp & ! --- outputs: & ) @@ -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 +!> 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 +!! 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), dimension(:) :: solfwv ! one wvn sol flux + real (kind=kind_phys), dimension(:) :: eirfwv ! one wvn ir flux - real (kind=kind_phys), intent(in) :: raddt, fdaer - - 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 -!-------------------------------------------------------------------------- - - if ( .not. lgrtint ) then - -! --- ... already done aerspc initialization, continue + 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 - continue + 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 - else - -! --- ... 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 /= ntrcaer ) 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) - - 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 + call optavg_gocart +! --- inputs: (in-scope variables, module variables) +! --- outputs: (module variables) -! --- ... 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 ! ! ! -! output arguments: (to module variables) ! +! external module variables: (in physparam) ! +! laswflg - control flag for sw spectral region ! +! lalwflg - control flag for lw spectral region ! +! ! +! 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 + + 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 - enddo ! end do_nb_block for sw + 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) -! --- ... loop for each lw radiation spectral band + 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 - do nb = 1, NLWBND + refb = sumreft * rsolbd - ib = NBDSW + nb - rirbd = f_one / eirbnd(nb) + 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) -! --- for rh independent aerosol species + enddo ! end do_nh_block + enddo ! end do_nc_block for rh-dep aeros - 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_nb_block for sw + endif ! end if_laswflg_block - 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 +! --- ... loop for each lw radiation spectral band - refb = sumreft * rirbd + 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) + 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 ) -! ================================================================== ! -! ! -! 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 - - 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 - -! prognostic aerosols on gfs grids - real (kind=kind_phys), dimension(:,:,:),allocatable:: aermr,dmfcs + real (kind=kind_phys), dimension(nlay,nswlwbd):: tauae,ssaae,asyae + real (kind=kind_phys), dimension(nspc) :: spcodp -! 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 + 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 -! --- 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,:,:) - -! --- map geos-gocart climo (dmclmx) to gfs level (dmclm) - pkstr(:)=fpkap(pstmp(:)) - psfc = pkstr(1) ! pressure at sfc - ptop = pkstr(KMXG) ! pressure at toa - -! --- map grid in verical direction (follow how ozone is mapped -! in radiation_gases routine) +! --- initialize tauae, ssaae, asyae + do m = 1, NSWLWBD 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,:) - + tauae(k,m) = f_zero + ssaae(k,m) = f_one + asyae(k,m) = f_zero enddo - endif lab_if_clim -! -! --- compute fcst/clim merged aerosol loading (dmanl) and the -! radiation optical properties (aerosw, aerolw) -! - do k = 1, NLAY + enddo -! --- map global to local arrays (rh1 and dz1) - rh1(k) = rhlay(i,k) - dz1(k) = dz (i,k) +! --- set floor value for aerms (kg/m3) + do k = 1, NLAY + do m = 1, kcm + aerms(k,m) = 1.e-15 + enddo + enddo -! --- 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 + 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 -! --- determine dmanl from dmclm and dmfcs - do m = 1, NMXG - dmanl(k,m)= ctaer*dmfcs(i,k,m) + & - & ( f_one-ctaer)*dmclm(k,m) + do m = 1, KCM + aerms(k,m) = aerfld(i,k,m)*rho ! dry mass (kg/m3) enddo - enddo +! +! --- calculate sw/lw aerosol optical properties for the +! corresponding frequency bands -!> -# Call aeropt_grt() to alculate sw/lw aerosol optical properties -!! for the corresponding frequency bands. + call aeropt +! --- inputs: (in-scope variables) +! --- outputs: (in-scope variables) - call aeropt_grt -! --- inputs: (in scope variables) -! --- outputs: (in scope variables) + enddo ! end_do_k_loop - if ( lsswr ) then +! ---------------------------------------------------------------------- - if ( laswflg ) then +! --- 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 + 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 - else - - aerosw(:,:,:,:) = f_zero - - endif +! --- update diagnostic aod arrays + do k = 1, NLAY + aerodp(i,1) = aerodp(i,1) + tauae(k,nv_aod) + enddo - endif ! end if_lsswr_block + do m = 1, NSPC + aerodp(i,m+1) = spcodp(m) + enddo - if ( lslwr ) then + endif ! end if_larsw_block - if ( lalwflg ) then + if ( laerlw ) 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 + if ( NLWBND == 1 ) then + m1 = NSWBND + 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 - endif - + enddo else - - aerolw(:,:,:,:) = f_zero - + 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 + 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 ! !==========================================! +!> @} From 11821ddcbe34ff4ed53950f14348911914a56c7e Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Mon, 27 Jan 2020 15:11:24 +0000 Subject: [PATCH 08/44] fixed too much high level cloud for iccn==2 --- physics/m_micro.F90 | 24 +++++++++++++----------- physics/micro_mg3_0.F90 | 2 ++ 2 files changed, 15 insertions(+), 11 deletions(-) diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index 7ac887a3b..7df85fbc8 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -973,17 +973,19 @@ 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 (iccn .ne. 1) then CDNC_NUC(I,k) = npccninr8(k) diff --git a/physics/micro_mg3_0.F90 b/physics/micro_mg3_0.F90 index 215d3516b..31ff83cc4 100644 --- a/physics/micro_mg3_0.F90 +++ b/physics/micro_mg3_0.F90 @@ -1506,6 +1506,8 @@ subroutine micro_mg_tend ( & 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 From 6466b9105bdad7830467c5035c31b16205d7f795 Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Thu, 13 Feb 2020 12:44:52 -0500 Subject: [PATCH 09/44] changed ntrcaer in rad_aero to ntrcaerm --- physics/radiation_aerosols.f | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/radiation_aerosols.f b/physics/radiation_aerosols.f index 339b991f0..45a909ca8 100644 --- a/physics/radiation_aerosols.f +++ b/physics/radiation_aerosols.f @@ -169,7 +169,7 @@ module module_radiation_aerosols ! use module_radlw_parameters, only : NBDLW, wvnlw1, wvnlw2 ! use funcphys, only : fpkap - use aerclm_def, only : ntrcaer + use aerclm_def, only : ntrcaerm ! implicit none @@ -3499,7 +3499,7 @@ subroutine gocart_aerinit & ! --- ... invoke gocart aerosol initialization - if (KCM /= ntrcaer ) then + if (KCM /= ntrcaerm ) then print *, 'ERROR in # of gocart aer species',KCM stop 3000 endif From fdf79db9abf3f82a6a6045e44cdefed8ab4d58a7 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 17 Mar 2020 15:39:06 -0600 Subject: [PATCH 10/44] Squashed commit of the following: commit 107b22d297a203dbf24e7f161b24d5a180ff9f3b Merge: 43e0e38 73f9f09 Author: Dustin Swales Date: Thu Mar 5 21:07:31 2020 +0000 Merge branch 'dtc/develop' of https://github.com/NCAR/ccpp-physics into rrtmgp-dev2 commit 43e0e38d9553742aa681e34213cc2cdfbd3bca4e Author: Dustin Swales Date: Thu Feb 27 15:49:56 2020 -0700 Try adding many mpi_barrier commands commit 36de8f56671b03217d14853745219ef611732384 Author: Dustin Swales Date: Thu Feb 27 13:55:27 2020 -0700 Added mpi_bast commands back in commit 75fdb61479ae836bb81795438436a6a58f9fbd6f Author: Dustin Swales Date: Wed Feb 19 15:16:15 2020 -0700 Reverted some changes commit 93ae6cba0133ca8b990ff8314aa40e70f708ac55 Author: Dustin Swales Date: Wed Feb 19 14:59:09 2020 -0700 Removed deprecated files. commit 0e954b799ca362b748093b2a601a2c090ca98269 Author: Dustin Swales Date: Wed Feb 19 14:57:25 2020 -0700 Removed my login credential from .gitmodules. commit 244d3efadedf9aee74787ea4374069c96ddb43e5 Author: Dustin Swales Date: Wed Feb 19 14:54:07 2020 -0700 Reverted some changes. commit e201f0846c163420136ff90114a53079dda1d00f Author: Dustin Swales Date: Wed Feb 19 10:25:45 2020 -0700 Cleaned up rrtmgp_lw_pre.F90 commit 1d92cfaff0dba748ad8005dcd4c579111035a2e9 Author: Dustin Swales Date: Tue Feb 18 15:54:04 2020 -0700 Reverted changes to GFS_rrtmgp_sw_pre.F90 commit b57ebfd04e71bd5edcfe2b5cccda4f28b8f0d6eb Author: Dustin Swales Date: Tue Feb 18 14:49:30 2020 -0700 Revert earleir change. commit ab6c12eb92075fbaa7bb0babee68b1326385ed23 Author: Dustin Swales Date: Tue Feb 18 14:23:43 2020 -0700 Switch back hprime to hprime(:,1) commit 12acbb019ce7b9e40e1fd70e6a738e994024e74f Merge: c5ba6f9 6d55230 Author: Dustin Swales Date: Tue Feb 18 14:05:21 2020 -0700 Merge branch 'rrtmgp-dev2' of https://github.com/dustinswales/ccpp-physics into rrtmgp-dev2-no-mpi_bcast commit 6d552308db8258e843f56ff33339b57c2a94efab Author: Dustin Swales Date: Tue Feb 18 14:04:49 2020 -0700 Chnaged intent of lw_cloud_optical_props commit a3cd7db3a278d2ab0ad787a608ad3d4cc73e5c76 Author: Dustin Swales Date: Tue Feb 18 13:32:51 2020 -0700 Remove using gas switches. commit c5ba6f942f01088f8b2a9d822b7b2163563bd558 Author: Dustin Swales Date: Tue Feb 18 13:31:15 2020 -0700 Remove using gas switches. commit c47706ba033e72f20c97d482e91a80856367f587 Author: Dustin Swales Date: Tue Feb 18 12:25:32 2020 -0700 changed variable name. commit 723f74014151b9a7d8b5d34fd67e9ddb3e19d0db Merge: 596229b c1bf1ae Author: Dustin Swales Date: Tue Feb 18 11:58:18 2020 -0700 Merge branch 'rrtmgp-dev2' of https://github.com/dustinswales/ccpp-physics into rrtmgp-dev2-no-mpi_bcast commit c1bf1ae02bde5a0462dc0b5614f8acb1d88fefaf Author: Dustin Swales Date: Tue Feb 18 11:57:44 2020 -0700 Try using 1D hprime commit 596229bac3c1b0c71aef0a4f8a2afd9c16a96436 Merge: 9c682fc c984e90 Author: Dustin Swales Date: Fri Feb 14 16:56:36 2020 -0700 Merge branch 'rrtmgp-dev2' of https://github.com/dustinswales/ccpp-physics into rrtmgp-dev2-no-mpi_bcast commit c984e907306502fa109d514b64031102102ae512 Author: Dustin Swales Date: Fri Feb 14 16:54:38 2020 -0700 Cleaned up a tad. commit 9c682fc7ee703eb9e801bd264899f72cdde1bd01 Merge: c2eb222 54a38d9 Author: Dustin Swales Date: Wed Feb 12 10:45:23 2020 -0700 Merge branch 'rrtmgp-dev2' of https://github.com/dustinswales/ccpp-physics into rrtmgp-dev2-no-mpi_bcast commit 54a38d99cc46599bac0df04478865c1a287b48b2 Author: Dustin Swales Date: Wed Feb 12 10:43:24 2020 -0700 Removed cloud-fraction rounding. Was using for debugging purposes. commit b1e111fc0fe4ecb7c854dd538ae36f15c67af44a Author: Dustin Swales Date: Wed Feb 12 10:39:01 2020 -0700 Reverted recent change. commit 6473891e32fa5aca404c61e1fec6ca9d4744bb52 Author: Dustin Swales Date: Wed Feb 12 09:48:51 2020 -0700 Reverted some local changes. commit 8d42056e8e14713d8b76412138568538f6aacd9e Merge: 75c479d 01ed01f Author: Dustin Swales Date: Wed Feb 12 09:29:47 2020 -0700 Merge branch 'master' of https://github.com/NCAR/ccpp-physics into rrtmgp-dev2 commit c2eb222ed073ae53c24d15d71a92ef12dde41fc8 Merge: 3aa8cd4 75c479d Author: Dustin Swales Date: Tue Feb 11 15:16:01 2020 -0700 Merge branch 'rrtmgp-dev2' of https://github.com/dustinswales/ccpp-physics into rrtmgp-dev2-no-mpi_bcast Conflicts: physics/rrtmgp_lw_cloud_optics.F90 physics/rrtmgp_sw_cloud_optics.F90 commit 75c479d4f3c8e99649ed8ab8e8d83892eaf72592 Author: Dustin Swales Date: Tue Feb 11 15:13:34 2020 -0700 Updated interface to rte-rrtmgp routines. commit 30b523724d8339de8c4ef2a98e778e0c878b494e Author: Dustin Swales Date: Tue Feb 11 11:09:46 2020 -0700 Updated submodule commit 3aa8cd4f38897c95f2fef5bff1fbc930ce0bba41 Author: Dustin Swales Date: Tue Feb 11 11:08:25 2020 -0700 Updated submodule commit c1cec1142babd2d549858346df9fccd7ff13320e Author: Dustin Swales Date: Tue Feb 11 10:57:40 2020 -0700 Switched to rte-rrtmgp dtc/branch. commit 3491dcdf52b32dd066a2d17bf145630a26bdf994 Author: Dustin Swales Date: Tue Feb 11 10:55:46 2020 -0700 Switched to rte-rrtmgp dtc/branch. commit b67bc2db8adb1e7252d0c2b3ad14ef5bc242b790 Author: Dustin Swales Date: Mon Feb 10 16:34:52 2020 -0700 Removed mpi calls during initialization. Reading data ona ll processors. Started from 3dfb4c9b21a9ac44e304ef8a593d1fa88846d49a commit 3dfb4c9b21a9ac44e304ef8a593d1fa88846d49a Author: Dustin Swales Date: Mon Feb 10 16:27:32 2020 -0700 Cleaned up _init routines. commit d3517899d5f0684c2c15f039c439cb5a31b4657e Author: Dustin Swales Date: Thu Jan 30 15:47:43 2020 -0700 Move allocation statement into master processor only. commit e7c6c8ec9b84b9b773463333f711f867cfe22c27 Author: Dustin Swales Date: Thu Jan 30 15:24:37 2020 -0700 Try different broadcast call for character arrays. commit be43ed8319d25de7f9146bfde679a7c32250df8c Author: Dustin Swales Date: Thu Jan 30 14:46:01 2020 -0700 Added a second mpi barrier. commit 33158c7f80cec30c72d6cc169ce39550500de278 Author: Dustin Swales Date: Thu Jan 30 14:09:54 2020 -0700 Added mpi barrier. communicator working, i think. commit 3e79d0279453ef0c007461c13dfe7cc8690c6379 Author: Dustin Swales Date: Thu Jan 30 13:27:36 2020 -0700 Move allocation statements. commit 09b3c3b78a6f492934f91b504366a8167d5df44a Author: Dustin Swales Date: Tue Jan 28 14:09:37 2020 -0700 Added print statements to Thompson init routines. commit ab612f4b312c830de0b5abdc9d63d49b2f9f3f8d Author: Dustin Swales Date: Tue Jan 28 12:44:25 2020 -0700 More diagnostic print statements. commit af24b718d61526ce5a3836d835a9b953ed979d89 Author: Dustin Swales Date: Tue Jan 28 12:03:10 2020 -0700 Added some diagnostic print statements. Remvoe barrier commands. commit e40e0f500db5e63cd458acb9333c72a98f7645ad Author: Dustin Swales Date: Tue Jan 28 11:40:53 2020 -0700 Added some diagnostic print statements. commit d42469b35632eed39692f1132c874dab6468ab1e Author: Dustin Swales Date: Tue Jan 28 11:12:32 2020 -0700 Change data type to double-precision. commit 28269a94fcb85ebbfc1c9678b7b93c69642a4ed8 Author: Dustin Swales Date: Tue Jan 28 10:35:04 2020 -0700 Modification to LW gas optics init(). One more time. commit c5ce144525abb51605c204b125db1496c5ef983d Author: Dustin Swales Date: Tue Jan 28 10:05:25 2020 -0700 Modification to LW gas optics init(). Add mpi_barrier commit f6c4e82fea3adb58eb843b3fa502f44a7734e19c Author: Dustin Swales Date: Tue Jan 28 09:33:50 2020 -0700 Modification to LW gas optics init(). commit f38ef59b00f4b18504bbf9ef68542d1074027cff Author: Dustin Swales Date: Mon Jan 27 16:26:39 2020 -0700 Some changes to MPI calls in inti() routines. commit bb03ad3fed2fb904d517d8f13f8d9989f8dab879 Author: Dustin Swales Date: Mon Jan 27 15:47:19 2020 -0700 Omission from previous commit. commit 28243f13ba5d9766a0b2c01d2de08de47502bbb3 Author: Dustin Swales Date: Mon Jan 27 15:25:20 2020 -0700 Remove bcast condition on precision. commit 01725b47395eff38951691d621ea49ec825f21b8 Author: Dustin Swales Date: Mon Jan 27 14:48:48 2020 -0700 Omission from previous commit. commit c0aab421b1c50f0d9de5a05c2653977b732d38d1 Author: Dustin Swales Date: Mon Jan 27 14:18:20 2020 -0700 Some changes to MPI calls in inti() routines. New grouping. commit fbb009f595f3a686523ed19af6daae868b9c9322 Author: Dustin Swales Date: Mon Jan 27 12:36:55 2020 -0700 Some changes to MPI calls in inti() routines. Again and again... commit 6e0c346cbe12c682b6273843d72ecc4081240088 Author: Dustin Swales Date: Mon Jan 27 11:01:50 2020 -0700 Some changes to MPI calls in inti() routines. Again... commit 0992def87d74fa13c41e6bf2e28335e021451129 Author: Dustin Swales Date: Mon Jan 27 10:21:38 2020 -0700 Some changes to MPI calls in inti() routines. commit dd9d5ce39a82abd336f1b2a27bce06dc949cbb9f Author: Dustin Swales Date: Tue Jan 21 15:54:36 2020 -0700 Removed diagnostic print statements. commit 320907ff03f5545a3825fb50efbfff803d1eb14b Author: Dustin Swales Date: Tue Jan 21 15:43:21 2020 -0700 Bug fix. commit 64691a6e755b3286f6b49518e99a64831f2459bd Author: Dustin Swales Date: Tue Jan 14 10:54:02 2020 -0700 Added by-band lw fluxes to diagnostic output. New namelist parameter for RRTMGP: number of gaussian angles for quadrature calculation. commit 6c8ecdd910d935a526ac430405ec914b1491aa0a Author: Dustin Swales Date: Mon Jan 13 12:49:13 2020 -0700 Try overwriting cloud optical depth in bands1-2. commit 5812151340d1263f1a7e0372dc5fb3b1c816e35c Author: Dustin Swales Date: Tue Jan 7 11:21:44 2020 -0700 Added some more diagnostics. commit 203cd4ac6d3d4b0d92e9f558bd13611a3e2ccbf4 Author: Dustin Swales Date: Tue Jan 7 10:08:21 2020 -0700 Needed to add MPI commands to open diagnostic output file. commit b6792036ac56e939121e049a8c11e3658a3e4492 Author: Dustin Swales Date: Mon Jan 6 14:40:49 2020 -0700 Fixed error in previous commit. commit 04ad9ed3a5f08f9f9b8c3888a73184a5b11c1e60 Author: Dustin Swales Date: Mon Jan 6 13:40:06 2020 -0700 Added longitude/latitude to output stream. Needed to sort through MPI output. commit 5542acaf51a9460fab4723c20622bb6f97853656 Author: Dustin Swales Date: Mon Jan 6 11:22:38 2020 -0700 Added diagnostics for LW clouds. commit ec093b215fa3f60f0032f3b2bb311e0b75a83b29 Author: Dustin Swales Date: Fri Jan 3 14:58:39 2020 -0700 Reverted some recent changes. commit 323e6f992c3ccb750b6fea1762d0a2e0a270fcc7 Author: Dustin Swales Date: Fri Jan 3 14:17:52 2020 -0700 Added number_of_gaussian angles to LW calculation. commit a564c8b379708caa55a7484038574fc5b1245838 Author: Dustin Swales Date: Thu Jan 2 12:02:56 2020 -0700 Moved aggregation into conditional loop. LW only. commit 2e161eba6e74476729385177e4ebb02ae2491a8c Author: Dustin Swales Date: Tue Dec 31 11:34:47 2019 -0700 Moved GFS_rrtmgp_lw_pre.F90 to rrtmgp_lw_pre.F90 commit edcb6726a9e223fd55f472f0e3d7649331c266d0 Author: Dustin Swales Date: Tue Dec 31 08:47:37 2019 -0700 Added diffusivity angle adjustment to LW. commit 28bea10e6c892d020c19604973de5203d9658fb4 Author: Dustin Swales Date: Thu Dec 19 16:00:00 2019 -0700 Removed diagnostic cloud outputs. commit b2d42f39cd3a6e5564219ca68be7604c2ad81f46 Author: Dustin Swales Date: Thu Dec 19 14:20:35 2019 -0700 Fix rounding error in G cloud-sampling test. Add diagnostics for cloud microphysics commit 4d3515dcda2f0b16c0ef7528e6760fa29bbbb343 Author: Dustin Swales Date: Tue Dec 17 11:08:09 2019 -0700 Round cloud-fractions to avoid McICA sampling error. In RRTMG as well. commit 5b02c9eb3fd929be59e1ca65451e1a1a74292dda Author: Dustin Swales Date: Tue Dec 17 10:18:24 2019 -0700 Round cloud-fractions to avoid McICA sampling error. commit e30305d8b7d87d4193c3a7049e4709aa5f97b744 Author: Dustin Swales Date: Mon Dec 16 15:53:19 2019 -0700 Fixed error in .meta file. commit 1526e7dcb457d05adc789c2f7a7c3a135f853d9f Author: Dustin Swales Date: Mon Dec 16 14:10:54 2019 -0700 Treat surface albedo exactly as in RRTMG. For SW bands 1-9, use nIR; For band 10, use average of nIR and uvVIS; For bands 11-24, use uvVIS. commit e105f48a986fdca2cc6b55e57d3c0dda4ae8bfbc Author: Dustin Swales Date: Mon Dec 16 13:50:35 2019 -0700 Revert "Delta-scale SW before incrementing aerosol optics." This reverts commit 122a750b58724330e244bb9814f0f66a7b22502d. commit 81abe37aba9e22ba3fae072b045dab715b7e8851 Author: Dustin Swales Date: Mon Dec 16 13:50:10 2019 -0700 Revert "Revert "Removed MPI for testing in UFS."" This reverts commit 8c5ead8cb39979350ab71e9a0b0ee22510e447eb. commit 8c5ead8cb39979350ab71e9a0b0ee22510e447eb Author: Dustin Swales Date: Mon Dec 16 13:48:41 2019 -0700 Revert "Removed MPI for testing in UFS." This reverts commit 4dcb001d753b0515dd0163dc02fff271380698b2. commit 122a750b58724330e244bb9814f0f66a7b22502d Author: Dustin Swales Date: Mon Dec 16 12:29:31 2019 -0700 Delta-scale SW before incrementing aerosol optics. commit 4dcb001d753b0515dd0163dc02fff271380698b2 Author: Dustin Swales Date: Mon Dec 16 11:56:21 2019 -0700 Removed MPI for testing in UFS. commit 86a24827b1a8d92b766a8fe422c401d4891ae19b Author: Dustin Swales Date: Mon Dec 16 11:04:06 2019 -0700 Fixed MPI calls in lw cloud optics. commit 8c46c345e8cfa24a5adc5708cad80392c62c6023 Author: Dustin Swales Date: Fri Dec 13 15:10:42 2019 -0700 Some more cleanup and documenting. Added initialization routine for cloud-sampling routines. commit 0ea0a12bae5e469095635c03e893a7135cf33967 Author: Dustin Swales Date: Fri Dec 13 13:44:15 2019 -0700 Turned MPI on for rrtmgp gas-optics, omission from last commit. commit 9ec9667452f6090c5fafc6ad8668e7bcfd011029 Author: Dustin Swales Date: Fri Dec 13 13:05:16 2019 -0700 Turned MPI on for rrtmgp gas-optics commit 1943d14264ac1623bd219a03b87ccc1f79297075 Author: Dustin Swales Date: Fri Dec 13 09:53:55 2019 -0700 Removed all instances of GFS derived data types from rrtmgp scheme level code. commit def30ce6634e68ccfc8e6e188f11b748e7fb6fb1 Author: Dustin Swales Date: Thu Dec 12 17:09:10 2019 -0700 Started removing GFS DDTs from RRTMGP scheme. commit 9a47ad3fe56cdc479d644df6f1d8a9dc51a468c9 Author: Dustin Swales Date: Thu Dec 12 14:19:48 2019 -0700 Added aerosol and cloud-sampling schemes. commit 9bd2dbb122546d1367e286b4c500e1f9ced702f4 Author: Dustin Swales Date: Wed Dec 11 16:07:46 2019 -0700 Express layer-thinkness in meters? commit ddebe4554926ddae4f74b406b5e743f400b63a49 Author: Dustin Swales Date: Wed Dec 11 14:33:40 2019 -0700 Alebdos (nIR and uvvis) are being averaged in rrtmg, did same in rrtmgp. Sneaky commit ac6d7a5cc33ecc8e04727ccc54a519649e6ce991 Author: Dustin Swales Date: Wed Dec 11 10:38:43 2019 -0700 Moved some interstitial firelds out of GFS_interstitial_type into flat fields. commit b16c6c76f4db31453ecf621e66211d33d37f0d8d Author: Dustin Swales Date: Wed Dec 11 09:19:43 2019 -0700 Removed MPI calls. commit 6cdd545a425f717a1fed528eaef31c48509f2dcb Author: Dustin Swales Date: Tue Dec 10 15:25:31 2019 -0700 Try calling mpi_barrier just before gas_optics%load commit a59b8981e618851303fe224ea8d803a14b101e64 Author: Dustin Swales Date: Tue Dec 10 14:46:50 2019 -0700 Added some print statements commit 92817d25049588af50f7c750e80af3885d9c0698 Author: Dustin Swales Date: Tue Dec 10 13:56:38 2019 -0700 Removed mpi calls in lw gas optics. Test reading in data on all processors. commit dcb8e4643479ef2d6c7c8427e1cc171a1ac1d69e Author: Dustin Swales Date: Tue Dec 10 11:05:25 2019 -0700 Add print statements, check LW optical-depth on all processors. commit 782ecb0bfff3f97736c2c5a4c8676f8afb9d718a Author: Dustin Swales Date: Tue Dec 10 10:12:41 2019 -0700 Reverted broadcast call for scalars commit 25974eb2fb2a0de4f5935d3bd862da353cc9c618 Author: Dustin Swales Date: Tue Dec 10 09:49:32 2019 -0700 Cleaned up, added some diagnostics to test MPI in UFS. commit 229ca5905567b6ee3224be17db89ab054d881ec8 Author: Dustin Swales Date: Mon Dec 9 16:25:31 2019 -0700 Revert to original mpi_bcast for character arrays. commit 0a726fd3c3a46b68ec76eee40bd847b22b8bfef5 Author: Dustin Swales Date: Mon Dec 9 16:02:30 2019 -0700 Try using string length provided in file for broadcsting strings. commit a25d7142c7f200b57e73fe18a091bcb4c4179668 Author: Dustin Swales Date: Mon Dec 9 15:21:43 2019 -0700 Changed MPI_BCAST() for character arrays. commit 72093456eb9f67a8b875100766befeeb6380ae6e Author: Dustin Swales Date: Mon Dec 9 14:34:52 2019 -0700 Add mpi_barrier() calls to all initialization routines commit e858d73db6a8434b502d16b866df0bcb38b849d9 Author: Dustin Swales Date: Mon Dec 9 13:39:57 2019 -0700 Add mpi_barrier() calls to SW gas optics initialization routine commit fbd398f361fc86fd15e053936f567936bf70d70a Author: Dustin Swales Date: Mon Dec 9 12:17:02 2019 -0700 Added ifdef(mpi) around declaration in initialization routines. commit 1bc898da3e2e6628a7551f973ed041b28073a881 Author: Dustin Swales Date: Mon Dec 9 11:56:26 2019 -0700 Added some print statements to diagnose MPI init. commit f471f795b9013ca224319ec94cb027aa7dc91e5b Author: Dustin Swales Date: Mon Dec 9 11:49:32 2019 -0700 Added some print statements to diagnose MPI init. commit 26cc6b1340dd7bec3bf85f79c30ded2faf6a024a Author: Dustin Swales Date: Fri Dec 6 11:00:33 2019 -0700 Cleaned up daytime masking in SW calculation commit e93fc1b647df2d7f2575d76ecc6e09dc6c858396 Author: Dustin Swales Date: Thu Dec 5 15:05:11 2019 -0700 Some housekeeping commit e905e96a10c1d07997f32486daee29545a6049d9 Author: Dustin Swales Date: Thu Dec 5 13:59:49 2019 -0700 Add loop over solar scaling commit 71b6a374f9ee1133576aa3f89a37f0e4248f5b70 Author: Dustin Swales Date: Wed Dec 4 12:43:32 2019 -0700 Change to diagnostic outputs for RRTMGP. commit 993508daad3917ac0d67dc8afa737fe92b6329e8 Merge: f895fc0 10191cd Author: dustinswales Date: Wed Dec 4 09:51:31 2019 -0700 Merge pull request #9 from dustinswales/rrtmgp-dev Created new rrtmgp-dev(2) branch. Something got corrupted. commit 10191cd672f7da36202b5e5b2e29c96c69f6aeca Merge: c62f631 7041bd2 Author: Dustin Swales Date: Tue Dec 3 12:12:55 2019 -0700 Merge branch 'dtc/develop' of https://github.com/NCAR/ccpp-physics into rrtmgp-dev commit c62f6312fb34bd1b9acc27c432403169c8a8efc7 Merge: 2752142 0f796d9 Author: Dustin Swales Date: Tue Dec 3 19:04:48 2019 +0000 Merge branch 'rrtmgp-dev' of https://github.com/dustinswales/ccpp-physics into rrtmgp-dev commit 2752142a09002b57da48c8f21e94e7e1c9a8a0d9 Author: Dustin Swales Date: Tue Dec 3 19:03:57 2019 +0000 Cleaned up a tad. Added some diagnostics for debuggind in SCM. commit 0f796d919bef9d11b65a7797af123eeb1e5d1e63 Merge: d2799f4 904a433 Author: Dustin Swales Date: Wed Nov 20 16:19:04 2019 -0700 Merge branch 'master' of https://github.com/NCAR/ccpp-physics into rrtmgp-dev commit d2799f4f37b60be3b7a3a3ed2ee24d4c93067402 Merge: 50b82a5 a7c38a6 Author: Dustin Swales Date: Wed Nov 20 15:53:00 2019 -0700 Merge branch 'dtc/develop' of https://github.com/NCAR/ccpp-physics into rrtmgp-dev commit 50b82a57dc0b660adf1825f4f5982172c70104ae Author: Dustin Swales Date: Wed Nov 20 10:50:34 2019 -0700 Delta-scaling added to SW calculation. commit 54e00662f4af5abb518cd3b526438258b58dc6b0 Author: Dustin Swales Date: Thu Nov 7 10:59:19 2019 -0700 Added solar constant adjustment factor to incident SW TOA flux. GP SW downward fluxes now agree with baseline G downward fluxes. commit 69bf6216846ea067b81dfea6d7656afd84a5afe1 Merge: b7aa280 59717c5 Author: Dustin Swales Date: Tue Nov 5 12:01:04 2019 -0700 Merge remote branch 'grant-fork/cires_ugwp_namelist_fix' into rrtmgp-dev commit b7aa280e7cfb64b65b5619911eb8d91b4f90049b Merge: b6cc944 78a8ed2 Author: Dustin Swales Date: Tue Nov 5 10:03:44 2019 -0700 Merge branch 'rrtmgp-dev' of https://github.com/dustinswales/ccpp-physics into rrtmgp-dev commit 78a8ed263f43955704f43cdc84f985b4451d074a Author: Dustin Swales Date: Mon Nov 4 23:19:06 2019 +0000 Made some changes. Moved fields into Interstitial type. Results still differ from baseline RRTMG. commit b6cc9448f65c8843b99cb8692303fdeddb076e3f Merge: 1f57f68 fe6c9ae Author: Dustin Swales Date: Fri Nov 1 10:35:35 2019 -0600 Merge branch 'rrtmgp-dev' of https://github.com/dustinswales/ccpp-physics into rrtmgp-dev commit fe6c9aeb5b0cdad9cf3d711c7268e7ee81706698 Author: Dustin Swales Date: Tue Oct 29 14:17:19 2019 +0000 Moved RRTMGP active gases from GFS_radtend_type to GFS_control_type. commit 1f57f6813dcf1aae13175eefe22056ac6712886e Merge: f35effe cfafb29 Author: Dustin Swales Date: Mon Oct 28 11:05:42 2019 -0600 Merge branch 'gmtb/develop' of https://github.com/NCAR/ccpp-physics into rrtmgp-dev commit f35effe345487621f30aeaa9d8f56c09d9344c13 Author: Dustin Swales Date: Fri Oct 25 22:06:21 2019 +0000 Some more changes in MPI commands within initialization commit 6126278f2879e155396c58b31d4c7ad8ffc3a8e7 Author: Dustin Swales Date: Fri Oct 25 17:32:46 2019 +0000 Fixed typo in MPI_BCAST() calls commit 2f23b9322841879cee20e412eedaf1f427ec679b Author: Dustin Swales Date: Thu Oct 17 19:11:05 2019 +0000 Remove deprecated code commit 04bdd4fde2f2d7110982c8e420cba8045bc8f1fd Author: Dustin Swales Date: Thu Oct 17 18:18:28 2019 +0000 Modified calls to radiaiton routines. commit 816ba3f2ab5c86a1524eba9de2c20f76086a2dbe Author: Dustin Swales Date: Wed Oct 16 22:30:12 2019 +0000 Fixed a bug commit 8bb1e85ca50022547a74f54ea01197e364cd8e82 Merge: 0b79698 9d6dd01 Author: Dustin Swales Date: Tue Oct 15 18:19:58 2019 +0000 Synced w/ upstream gmtb/develop commit 0b79698508a943c472340b812e82459e5a07c554 Author: Dustin Swales Date: Wed Oct 9 18:01:33 2019 +0000 Switched rte-rrtmgp submodule bracnh commit ac3006455f9c343f03bc204d10d9ccb08392499b Author: Dustin Swales Date: Wed Oct 9 17:54:02 2019 +0000 updated .gitmodules commit eba4af6bfbae1f1b2d36f140607f099a1ef9cc49 Author: Dustin Swales Date: Wed Oct 9 17:38:22 2019 +0000 Added RRTMGP as submodule commit 209b572774321cb824d8ab136291d64c39276a1d Merge: 87d19cf ecb641e Author: dustinswales Date: Wed Oct 9 11:14:24 2019 -0600 Merge pull request #8 from NCAR/gmtb/develop Sync with upstream Gmtb/develop commit 87d19cf0ceef826dd0336028bcd05a45d367d7e5 Merge: 4520c5d 9d6b208 Author: dustinswales Date: Wed Oct 9 10:57:16 2019 -0600 Merge pull request #7 from dustinswales/master Sync with master commit 9d6b208eae4be79edffbc8db20b737885912c824 Merge: 77bfcc2 ce641c9 Author: dustinswales Date: Wed Oct 9 10:55:46 2019 -0600 Merge pull request #6 from NCAR/master Sync with upstream master commit 4520c5df700ae787183414b23fd21625c9ea1dab Merge: 5ebe4c0 3958a87 Author: Dustin Swales Date: Tue Oct 8 20:15:13 2019 +0000 Merge branch 'rrtmgp-dev' of https://github.com/dustinswales/ccpp-physics into rrtmgp-dev commit 3958a870e7bf851456cfe80ffc8c7ebb7643045b Author: Dustin Swales Date: Mon Oct 7 15:06:55 2019 -0600 Changes were made to use RRTMGP for SW calculation, and RRTMG for the LW calculation. commit 34d5fe1584e8f2fd0f013fb4799e58441473c7e4 Author: Dustin Swales Date: Thu Sep 26 14:22:39 2019 -0600 Working commit e35f1b9c6f653aa18e0dce6c97eb95a8ddb7bc7a Merge: 4b61376 5cb9f93 Author: dustinswales Date: Wed Sep 25 09:17:22 2019 -0600 Merge pull request #5 from grantfirl/ticket_2050 Ticket 2050 fix commit 5cb9f93ff5a9de81fb0a0e937fdc0f10de6bb1ac Author: Grant Firl Date: Tue Sep 24 17:59:06 2019 -0600 change RRTMGP scheme metadata to use instances of DDTs rather than the type definition commit 4b61376adab644be38453bb3cd427b355c2b801e Author: Dustin Swales Date: Tue Sep 24 16:29:48 2019 -0600 Getting closer... commit f5562ee5c658119530b5f90e01c388e6840b499d Author: Dustin Swales Date: Tue Sep 24 09:55:14 2019 -0600 Fixed some bugs in argument tables. commit c668a6aa3b1af6f4858d6017577b347ee0c9185e Author: Dustin Swales Date: Mon Sep 23 10:56:22 2019 -0600 Modified arg_tables. Added .meta files commit 2ead7272da521a06bfb38805f75ffae53b9b72ec Author: Dustin Swales Date: Thu Sep 19 11:54:25 2019 -0600 Update .gitignore commit d6946ed8eccc87a080936da4500ed1bccbce3456 Author: Dustin Swales Date: Thu Sep 19 11:40:36 2019 -0600 Updated rrtmgp external commit fa9b30eaa187236b7366a3c2fb85d30f26c7b8ba Merge: 206a950 77bfcc2 Author: Dustin Swales Date: Thu Sep 19 11:31:35 2019 -0600 Merge branch 'master' into rrtmgp-dev commit 77bfcc2b2c14802a2b0e10df2a1d8c74750e2412 Merge: be12710 12c416a Author: dustinswales Date: Thu Sep 19 11:23:28 2019 -0600 Merge pull request #1 from NCAR/master Sync master branch of local fork with NCAR/ccpp-physics commit 5ebe4c00a7851b6d57a556adc8a2ce2b916cc2ab Merge: 7f8fc0b 243abfc Author: Dustin Swales Date: Mon Jul 1 18:23:43 2019 +0000 Synced w/ NCAR/ccpp-physics:master commit 7f8fc0b7fed7a60b17c48e0ac1d65572b3f43967 Author: Dustin Swales Date: Mon Jul 1 18:13:46 2019 +0000 Correction to MPI calls. commit f7915b9ff0d5ee993ccea474e7389ad5b7e86324 Author: Dustin Swales Date: Thu Jun 27 18:16:17 2019 +0000 Synced with NCAR repo. commit fa055745b654ce70e3be4a6f305d2ab6e02e7527 Author: Dustin Swales Date: Wed Jun 26 21:50:30 2019 +0000 Added rte-rrtmgp repository. commit 206a950623bd562f1aae4cb3d74f062ec4360aa1 Author: Dustin Swales Date: Mon Jun 24 12:17:11 2019 -0600 Added piece for GFDL MP. Not curretnly exercised. commit 0a100cb5d374d175222b8de578bdb0692807ee1c Merge: c445658 be12710 Author: Dustin Swales Date: Thu Jun 20 11:32:45 2019 -0600 Synced w/ master/ commit c445658417197b59c08e4d287a1aa88f4c041800 Author: Dustin Swales Date: Thu Jun 20 09:23:00 2019 -0600 Fixed a few bugs, some housekeeping. commit 9e5405c33e51962594cfd39762fa23eb9e548d5f Author: Dustin Swales Date: Thu Jun 13 16:29:43 2019 -0600 Fixed indexing error for output fluxes. commit c9a357a9d3b3bcc732b4211d3caa88d9bbf5757a Author: Dustin Swales Date: Wed Jun 12 09:39:56 2019 -0600 Added calls to compute_bc() in LW and SW gas_optics. Small bug found in mo_compute_bc. Work in progress. commit 044c88090bc90abada0eb6934260f5c005a8b0b7 Author: Dustin Swales Date: Tue Jun 11 09:28:20 2019 -0600 Renamed two modules. commit b882dffc9c043973d3809653163b7c8628f3ff8c Author: Dustin Swales Date: Mon Jun 10 17:17:06 2019 -0600 Added gas_optics_sw_run() and gas_optics_lw_run() routines. commit 52cb3a0c664485a650a14bce9bb70b390cbb9c14 Author: Dustin Swales Date: Fri Jun 7 11:33:25 2019 -0600 Fixed potential issue in Thompson MP scheme. Cleaned up a tad. commit 893ce888562ad7bda6392838e5406873f1c99107 Author: Dustin Swales Date: Thu Jun 6 16:16:17 2019 -0600 Some housekeeping. commit 6e2c8bdabcd53657852a1e905995131215ab5518 Author: Dustin Swales Date: Thu Jun 6 10:24:02 2019 -0600 Some cleaning up since last commit. commit a4bdffeaab6b44b9237af0836d99d288fdd947c5 Author: Dustin Swales Date: Wed Jun 5 16:45:48 2019 -0600 Major reorganization. Added schemes for cloud-optics and gas optics. Added RRTMGP active gases to gfs_physics_nml. commit f86636b604e28bde74600de0654da8183337c655 Author: Dustin Swales Date: Mon Jun 3 16:25:05 2019 -0600 Split up init into gas and cloud _init routines. Renamed some variables to be more clear. commit 4e0cfc85d8629d0130d22913e6c03030010114de Author: Dustin Swales Date: Fri May 31 15:27:09 2019 -0600 Added back option to call RRTMG cloud_optics(). commit 57be5513e59dbf9064dd71f01da9d6f43ac89c1d Author: Dustin Swales Date: Fri May 31 14:25:56 2019 -0600 Added new GFS_rrtmgp_XX_post.F90 for both SW and LW. commit ef4ed600037058c72a8081b6b89b4b333d507c89 Author: Dustin Swales Date: Fri May 31 11:54:56 2019 -0600 Moved microphysics from GFS_rrtmgp_pre_run() into its own routine, cloud_microphysics(). commit f5dc37a072cc7c68487657d4f70a787b2c13c60a Author: Dustin Swales Date: Thu May 30 16:46:06 2019 -0600 Remover extra-layer from GFS_rrtmgp_pre_run(). commit 1386e5816e5e1602ce3c1490bb49ac6d86412ea7 Author: Dustin Swales Date: Wed May 29 17:05:59 2019 -0600 More organizational changes to RRTMGP. commit 129b829e2d1cd8cd837526d75423172510d37878 Author: Dustin Swales Date: Tue May 28 10:04:25 2019 -0600 In progress... commit a60e1e1fa4388e222dbc9771a20d315290ce7493 Author: Dustin Swales Date: Tue May 21 16:23:01 2019 -0600 RRTMGP DDTs working! commit 9157959def8d8e4a5263a04361646bb746740c2d Author: Dustin Swales Date: Thu May 16 17:29:33 2019 -0600 Move computation of RRTMGP cloud optics to suite level, only for LW. commit f99255df6af91ae5f9345484949c3f6f8b8cad75 Author: Dustin Swales Date: Thu May 16 15:26:34 2019 -0600 Commit for Robert to view. commit 3beeb50f57710c07697c72e65df4f0018b8f1a20 Author: Dustin Swales Date: Mon May 13 11:55:41 2019 -0600 Changes for RRTMGP DDTs to be used in CCPP. commit e0ca27264d26464241429da466ca5bf49ca20c9a Author: Dustin Swales Date: Fri May 10 10:58:06 2019 -0600 Added metadata tables for DDTs. In CCPP/physics, started seperating pieces from suite-level to scheme level. commit 25b237274ae59fd2af3a185708ec019c3bd41ab9 Author: Dustin Swales Date: Thu May 9 15:19:04 2019 -0600 Added metadata tables to DDT definitions. commit 232545f63715b03064d687bdc6811d5974672e6c Author: Dustin Swales Date: Wed May 8 14:02:45 2019 -0600 Added _type to all instances of ty_gas_optics_rrtmgp commit 81f256d0f58353a656acc678593a776e2bbe6586 Author: Dustin Swales Date: Wed May 8 13:48:36 2019 -0600 Add rte-rrtmgp DDTs to CCPP commit 0a40aaa2ce2bc66c636fa7dcbcbe23b316dc253b Author: Dustin Swales Date: Tue May 7 15:54:57 2019 -0600 Moved to using extension/mo_rrtmgp_clr_all_sky.F90 routines to compute fluxes. commit 6557c76fe80f88c5af896548d4a5bab2e9c90e6e Author: Dustin Swales Date: Tue May 7 15:12:14 2019 -0600 Moved RRTMGP code to suite-level. commit 33e087f9eadc95faffeee35ea7b248d2b23f15e8 Author: Dustin Swales Date: Thu May 2 15:23:26 2019 -0600 Cleaned up, added detailed comments, vectorized loops. commit 8bbbd5b179d39380413fe7488b7bd0797cccfe75 Author: Dustin Swales Date: Thu May 2 11:34:46 2019 -0600 Cleaned up RRTGMP_pre a bit. Modified all calculations to use Pa instead of mb. commit 6c55b934838296fbb44580ddd847681aab2286f8 Author: Dustin Swales Date: Thu May 2 10:04:49 2019 -0600 Fixed allocation for RRTMGP aerosol/cloudy optical property DDT. Adjusted SW aerosol band ordering in GFS_rrtmgp_pre.F90. commit d14dba342a7c4f53cafa9632931d3893eb013790 Author: Dustin Swales Date: Wed May 1 16:05:13 2019 -0600 Fixd bug left in from last commit commit c089f10991dd72ed0a897ecdb9349e0a0307f7d7 Author: Dustin Swales Date: Wed May 1 15:29:19 2019 -0600 Same stuff as previous commit, but for SW. commit cf6bd6628be76bc64b788e270832d7586ce4357c Author: Dustin Swales Date: Wed May 1 09:15:21 2019 -0600 Revised LW flux calculation. commit e92cd8cb84673298c12269cddec0a0d33aa835d8 Author: Dustin Swales Date: Tue Apr 30 14:53:24 2019 -0600 Housekeeping in LW. Remove diffusivity angle adjustment, Added RRTMG draw_samples, Cleaned up aerosol increment, Passing random number to RRTMGP cloud sampling. commit 3c861b04be307f0cb0ee2786f4cb9fc497dce008 Author: Dustin Swales Date: Mon Apr 29 17:29:51 2019 -0600 LW RRTMGP cloud-optics working. Also, RRTMGP cloud sampling has been implemented (in progress). commit 67c2e26ed271aa2bdbe32548f443f6a916464f95 Author: Dustin Swales Date: Wed Apr 24 10:53:16 2019 -0600 Working./gmtb_scm twpice_control_RRTMGP_cloud commit 5ddf44d3950e86d994e26c58687bb184f67c11d4 Author: Dustin Swales Date: Thu Apr 18 15:41:45 2019 -0600 SW all-sky calculation working. Microphysics needs some attention. commit b4510ef93be07dd0d24b49b2a842799fbb588c87 Author: Dustin Swales Date: Tue Apr 16 12:26:03 2019 -0600 Added SW clear-sky calculation. commit 78ab01ec89f1b883105e12eb6684524219c021f2 Author: Dustin Swales Date: Tue Apr 16 12:20:17 2019 -0600 Added SW clear-sky calculation. commit 9414a90790aa4669cef3b21a256595ce540661f6 Author: Dustin Swales Date: Tue Apr 16 12:15:03 2019 -0600 Added ability to provide cloudy profile to radiation (RRTMG and RRTMGP). commit 80e70c19a89ee4d9ddd6bd0d869f0cee80992fe6 Author: Dustin Swales Date: Fri Mar 22 15:32:19 2019 -0600 Added diffusivity angle correction to optical-depths. commit 824009254877c1ac359b974ac1449506a98cf3a2 Author: Dustin Swales Date: Thu Mar 21 16:57:34 2019 -0600 Ported RRTMGP development from release repo. LW is working. --- .gitmodules | 4 + physics/GFS_rrtmgp_lw_post.F90 | 235 +++ physics/GFS_rrtmgp_lw_post.meta | 208 +++ physics/GFS_rrtmgp_pre.F90 | 783 ++++++++ physics/GFS_rrtmgp_pre.meta | 375 ++++ physics/GFS_rrtmgp_setup.F90 | 609 +++++++ physics/GFS_rrtmgp_setup.meta | 343 ++++ physics/GFS_rrtmgp_sw_post.F90 | 307 ++++ physics/GFS_rrtmgp_sw_post.meta | 267 +++ physics/GFS_rrtmgp_sw_pre.F90 | 155 ++ physics/GFS_rrtmgp_sw_pre.meta | 194 ++ physics/radlw_param.meta | 6 + physics/radsw_param.meta | 6 + physics/rrtmg_lw_cloud_optics.F90 | 821 +++++++++ physics/rrtmg_sw_cloud_optics.F90 | 2412 +++++++++++++++++++++++++ physics/rrtmgp_aux.F90 | 33 + physics/rrtmgp_lw_aerosol_optics.F90 | 97 + physics/rrtmgp_lw_aerosol_optics.meta | 166 ++ physics/rrtmgp_lw_cloud_optics.F90 | 374 ++++ physics/rrtmgp_lw_cloud_optics.meta | 309 ++++ physics/rrtmgp_lw_cloud_sampling.F90 | 126 ++ physics/rrtmgp_lw_cloud_sampling.meta | 114 ++ physics/rrtmgp_lw_gas_optics.F90 | 402 +++++ physics/rrtmgp_lw_gas_optics.meta | 210 +++ physics/rrtmgp_lw_pre.F90 | 86 + physics/rrtmgp_lw_pre.meta | 134 ++ physics/rrtmgp_lw_rte.F90 | 172 ++ physics/rrtmgp_lw_rte.meta | 200 ++ physics/rrtmgp_sw_aerosol_optics.F90 | 115 ++ physics/rrtmgp_sw_aerosol_optics.meta | 182 ++ physics/rrtmgp_sw_cloud_optics.F90 | 367 ++++ physics/rrtmgp_sw_cloud_optics.meta | 278 +++ physics/rrtmgp_sw_cloud_sampling.F90 | 133 ++ physics/rrtmgp_sw_cloud_sampling.meta | 130 ++ physics/rrtmgp_sw_gas_optics.F90 | 371 ++++ physics/rrtmgp_sw_gas_optics.meta | 244 +++ physics/rrtmgp_sw_rte.F90 | 218 +++ physics/rrtmgp_sw_rte.meta | 252 +++ physics/rte-rrtmgp | 1 + 39 files changed, 11439 insertions(+) create mode 100644 .gitmodules create mode 100644 physics/GFS_rrtmgp_lw_post.F90 create mode 100644 physics/GFS_rrtmgp_lw_post.meta create mode 100644 physics/GFS_rrtmgp_pre.F90 create mode 100644 physics/GFS_rrtmgp_pre.meta create mode 100644 physics/GFS_rrtmgp_setup.F90 create mode 100644 physics/GFS_rrtmgp_setup.meta create mode 100644 physics/GFS_rrtmgp_sw_post.F90 create mode 100644 physics/GFS_rrtmgp_sw_post.meta create mode 100644 physics/GFS_rrtmgp_sw_pre.F90 create mode 100644 physics/GFS_rrtmgp_sw_pre.meta create mode 100644 physics/rrtmg_lw_cloud_optics.F90 create mode 100644 physics/rrtmg_sw_cloud_optics.F90 create mode 100644 physics/rrtmgp_aux.F90 create mode 100644 physics/rrtmgp_lw_aerosol_optics.F90 create mode 100644 physics/rrtmgp_lw_aerosol_optics.meta create mode 100644 physics/rrtmgp_lw_cloud_optics.F90 create mode 100644 physics/rrtmgp_lw_cloud_optics.meta create mode 100644 physics/rrtmgp_lw_cloud_sampling.F90 create mode 100644 physics/rrtmgp_lw_cloud_sampling.meta create mode 100644 physics/rrtmgp_lw_gas_optics.F90 create mode 100644 physics/rrtmgp_lw_gas_optics.meta create mode 100644 physics/rrtmgp_lw_pre.F90 create mode 100644 physics/rrtmgp_lw_pre.meta create mode 100644 physics/rrtmgp_lw_rte.F90 create mode 100644 physics/rrtmgp_lw_rte.meta create mode 100644 physics/rrtmgp_sw_aerosol_optics.F90 create mode 100644 physics/rrtmgp_sw_aerosol_optics.meta create mode 100644 physics/rrtmgp_sw_cloud_optics.F90 create mode 100644 physics/rrtmgp_sw_cloud_optics.meta create mode 100644 physics/rrtmgp_sw_cloud_sampling.F90 create mode 100644 physics/rrtmgp_sw_cloud_sampling.meta create mode 100644 physics/rrtmgp_sw_gas_optics.F90 create mode 100644 physics/rrtmgp_sw_gas_optics.meta create mode 100644 physics/rrtmgp_sw_rte.F90 create mode 100644 physics/rrtmgp_sw_rte.meta create mode 160000 physics/rte-rrtmgp 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/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90 new file mode 100644 index 000000000..38b9530b0 --- /dev/null +++ b/physics/GFS_rrtmgp_lw_post.F90 @@ -0,0 +1,235 @@ +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, hlw0, 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) + + ! 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) + real(kind_phys), dimension(size(Grid%xlon,1), Model%levs), optional, intent(inout) :: & + hlw0 ! Longwave clear-sky heating rate (K/sec) + 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_clrskylw_hr, 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_clrskylw_hr = present(hlw0) + 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 (l_clrskylw_hr) 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..3eb1e0953 --- /dev/null +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -0,0 +1,208 @@ +[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 +[hlw0] + standard_name = RRTMGP_lw_heating_rate_clear_sky + long_name = RRTMGP longwave clear sky heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + 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/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 new file mode 100644 index 000000000..cb2b79410 --- /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.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..42ce8662c --- /dev/null +++ b/physics/GFS_rrtmgp_setup.F90 @@ -0,0 +1,609 @@ +!> \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.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 + print *, ' Error -- IAER flag is incorrect, Abort' + stop 7777 + 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.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.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..7d4e6ba6b --- /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.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,& + hsw0, 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 rates (K/s) + + ! Outputs (mandatory) + character(len=*), intent(out) :: & + errmsg + integer, intent(out) :: & + errflg + + ! Outputs (optional) + real(kind_phys), dimension(nCol, Model%levs), optional, intent(inout) :: & + hsw0 ! Shortwave clear-sky heating-rate (K/sec) + 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_clrskysw_hr, 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_clrskysw_hr = present(hsw0) + 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 (l_clrskysw_HR) then + 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) + 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..a933cba89 --- /dev/null +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -0,0 +1,267 @@ +[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 +[hsw0] + standard_name = RRTMGP_sw_heating_rate_clear_sky + long_name = RRTMGP shortwave clear sky heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + 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/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/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_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_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/rrtmgp_aux.F90 b/physics/rrtmgp_aux.F90 new file mode 100644 index 000000000..0ee837b97 --- /dev/null +++ b/physics/rrtmgp_aux.F90 @@ -0,0 +1,33 @@ +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 rrtmgp_aux_init() + end subroutine rrtmgp_aux_init + ! + subroutine rrtmgp_aux_run() + end subroutine rrtmgp_aux_run + ! + subroutine rrtmgp_aux_finalize() + end subroutine rrtmgp_aux_finalize + + ! ######################################################################################### + ! 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..a77b00759 --- /dev/null +++ b/physics/rrtmgp_lw_aerosol_optics.F90 @@ -0,0 +1,97 @@ +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 + + 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, p_lev, p_lay, p_lk, & + tv_lay, relhum, lsmask, tracer, 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 + 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+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, 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..ea123e236 --- /dev/null +++ b/physics/rrtmgp_lw_aerosol_optics.meta @@ -0,0 +1,166 @@ +[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 +[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 +[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..f9ee9b987 --- /dev/null +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -0,0 +1,374 @@ +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 + + 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 (rrtmgp_cld_optics .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(mpicomm, mpirank, mpiroot) + ! Inputs + integer, intent(in) :: & + mpicomm, & ! MPI communicator + mpirank, & ! Current MPI rank + mpiroot ! Master MPI rank + + 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..bae5ef74f --- /dev/null +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -0,0 +1,309 @@ +[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 +[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 \ No newline at end of file diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 new file mode 100644 index 000000000..51f512853 --- /dev/null +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -0,0 +1,126 @@ +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 + +contains + + ! ######################################################################################### + ! SUBROUTINE mcica_init + ! ######################################################################################### +!! \section arg_table_rrtmgp_lw_cloud_sampling_init +!! \htmlinclude rrtmgp_lw_cloud_sampling.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.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..b6300089f --- /dev/null +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -0,0 +1,402 @@ +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 +#ifdef MPI + use mpi +#endif + +contains + + ! ######################################################################################### + ! SUBROUTINE rrtmgp_sw_gas_optics_init + ! ######################################################################################### +!! \section arg_table_rrtmgp_lw_gas_optics_init +!! \htmlinclude rrtmgp_lw_gas_optics.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 +#ifdef MPI + integer :: mpierr +#endif + + ! Initialize + errmsg = '' + errflg = 0 + + write(*,"(a52,3i20)") 'rrtmgp_lw_gas_optics.F90:_init(): RRTMGP MPI ranks: ',mpirank,mpiroot,mpicomm + + ! 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 + 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 + +#ifdef MPI + ! Wait for processor 0 to catch up... + call MPI_BARRIER(mpicomm, mpierr) + ! Broadcast data + write (*,*) 'Broadcasting RRTMGP longwave k-distribution data ... ' + call MPI_BCAST(ntemps, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(npress, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nminorabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nextrabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nmixingfracs, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nlayers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nbnds, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(ngpts, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(npairs, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(ncontributors_lower, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(ncontributors_upper, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nminor_absorber_intervals_lower, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(nminor_absorber_intervals_upper, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(ninternalSourcetemps, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BARRIER(mpicomm, mpierr) + call MPI_BCAST(minor_limits_gpt_upper, size(minor_limits_gpt_upper), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(minor_limits_gpt_lower, size(minor_limits_gpt_lower), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(kminor_start_upper, size(kminor_start_upper), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(kminor_start_lower, size(kminor_start_lower), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(key_species, size(key_species), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BARRIER(mpicomm, mpierr) + call MPI_BCAST(band2gpt, size(band2gpt), MPI_INTEGER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(band_lims, size(band_lims), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(press_ref, size(press_ref), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(temp_ref, size(temp_ref), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(kminor_lower, size(kminor_lower), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(kminor_upper, size(kminor_upper), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BARRIER(mpicomm, mpierr) + call MPI_BCAST(scaling_gas_lower, size(scaling_gas_lower), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(scaling_gas_upper, size(scaling_gas_upper), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(vmr_ref, size(vmr_ref), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(kmajor, size(kmajor), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(temp_ref_p, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(temp_ref_t, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(press_ref_trop, 1, MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BARRIER(mpicomm, mpierr) + call MPI_BCAST(totplnk, size(totplnk), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(planck_frac, size(planck_frac), MPI_REAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(gas_names, size(gas_names), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(gas_minor, size(gas_minor), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(identifier_minor, size(identifier_minor), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(minor_gases_lower, size(minor_gases_lower), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call MPI_BARRIER(mpicomm, mpierr) + call MPI_BCAST(minor_gases_upper, size(minor_gases_upper), MPI_CHARACTER, mpiroot, mpicomm, mpierr) + call MPI_BCAST(minor_scales_with_density_lower, nminor_absorber_intervals_lower, MPI_LOGICAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(scale_by_complement_lower, nminor_absorber_intervals_lower, MPI_LOGICAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(minor_scales_with_density_upper, nminor_absorber_intervals_upper, MPI_LOGICAL, mpiroot, mpicomm, mpierr) + call MPI_BCAST(scale_by_complement_upper, nminor_absorber_intervals_upper, MPI_LOGICAL, mpiroot, mpicomm, mpierr) + ! Don't advance until data broadcast complete on all processors + call MPI_BARRIER(mpicomm, mpierr) +#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.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..0be239671 --- /dev/null +++ b/physics/rrtmgp_lw_pre.F90 @@ -0,0 +1,86 @@ +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 + + 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.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 + + ! 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..94c9b741e --- /dev/null +++ b/physics/rrtmgp_lw_rte.F90 @@ -0,0 +1,172 @@ +! ########################################################################################### +! ########################################################################################### +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 + + 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.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, hlw0, 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) + real(kind_phys), dimension(ncol,nLev), optional, intent(inout) :: & + hlw0 ! Clear-sky heating rate (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_ClrSky_HR, 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_ClrSky_HR = present(hlw0) + 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 + if (l_ClrSky_HR) then + 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) + endif + + ! + ! 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..e85a607fa --- /dev/null +++ b/physics/rrtmgp_lw_rte.meta @@ -0,0 +1,200 @@ +[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 +[hlw0] + standard_name = RRTMGP_lw_heating_rate_clear_sky + long_name = RRTMGP longwave clear sky heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = in + optional = T +[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..d6413c368 --- /dev/null +++ b/physics/rrtmgp_sw_aerosol_optics.F90 @@ -0,0 +1,115 @@ +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 + + 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.html +!! + subroutine rrtmgp_sw_aerosol_optics_run(doSWrad, nCol, nLev, nTracer, nDay, idxday, p_lev,& + p_lay, p_lk, tv_lay, relhum, lsmask, tracer, 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 + 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+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, 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..20240327f --- /dev/null +++ b/physics/rrtmgp_sw_aerosol_optics.meta @@ -0,0 +1,182 @@ +[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 +[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 +[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 \ No newline at end of file diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 new file mode 100644 index 000000000..99dcef2a5 --- /dev/null +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -0,0 +1,367 @@ +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 + + 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..cc998b755 --- /dev/null +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -0,0 +1,133 @@ +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 + +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..a0691e940 --- /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 + +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 + + write(*,"(a52,3i20)") 'rrtmgp_sw_gas_optics.F90:_init(): RRTMGP MPI ranks: ',mpirank,mpiroot,mpicomm + + ! 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 + 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..96bfa94ea --- /dev/null +++ b/physics/rrtmgp_sw_rte.F90 @@ -0,0 +1,218 @@ +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 + + 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, hsw0, 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), optional, intent(inout) :: & + hsw0 ! Clear-sky heating rate (K/sec) + 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_ClrSky_HR=.false., 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_ClrSky_HR = present(hsw0) + 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()) + if (l_ClrSky_HR) then + 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) + endif + + ! 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(idxday(1:nday),iSFC,:),dim=2) + scmpsw(idxday(1:nday))%nirdf = sum(flux_allsky%bnd_flux_dn(idxday(1:nday),iSFC,:),dim=2) - & + sum(flux_allsky%bnd_flux_dn_dir(idxday(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..8ae7421c3 --- /dev/null +++ b/physics/rrtmgp_sw_rte.meta @@ -0,0 +1,252 @@ +[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 +[hsw0] + standard_name = RRTMGP_sw_heating_rate_clear_sky + long_name = shortwave clear sky heating rate + units = K s-1 + dimensions = (horizontal_dimension,vertical_dimension) + type = real + kind = kind_phys + intent = inout + optional = T +[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 From 580c258e1d20e530012dde4935ab23d8f8d2f40b Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 19 Mar 2020 10:26:06 -0600 Subject: [PATCH 11/44] Bugfixes and cmake build system updates required for RRTMGP --- CMakeLists.txt | 32 +++++++++++++++++++++-------- physics/rrtmgp_lw_cloud_optics.F90 | 11 +++------- physics/rrtmgp_lw_cloud_optics.meta | 24 ---------------------- 3 files changed, 26 insertions(+), 41 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index b8d3c3e18..0a1658b22 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -95,23 +95,39 @@ 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 @@ -398,9 +414,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/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index f9ee9b987..077982e6e 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -17,7 +17,7 @@ module rrtmgp_lw_cloud_optics !! \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, & + 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 @@ -363,12 +363,7 @@ end subroutine rrtmgp_lw_cloud_optics_run !! \section arg_table_rrtmgp_lw_cloud_optics_finalize !! \htmlinclude rrtmgp_lw_cloud_optics.html !! - subroutine rrtmgp_lw_cloud_optics_finalize(mpicomm, mpirank, mpiroot) - ! Inputs - integer, intent(in) :: & - mpicomm, & ! MPI communicator - mpirank, & ! Current MPI rank - mpiroot ! Master MPI rank - + 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 index bae5ef74f..cebbfc700 100644 --- a/physics/rrtmgp_lw_cloud_optics.meta +++ b/physics/rrtmgp_lw_cloud_optics.meta @@ -283,27 +283,3 @@ [ccpp-arg-table] name = rrtmgp_lw_cloud_optics_finalize type = scheme -[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 \ No newline at end of file From d72b21205b593546db65e04a8fb6761d56fa70f5 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 19 Mar 2020 13:35:14 -0600 Subject: [PATCH 12/44] physics/rrtmgp_lw_gas_optics.F90: manual merge of code in @dustinswales branch rrtmgp-dev2-no-mpi_bcast (turn off MPI broadcasting) --- physics/rrtmgp_lw_gas_optics.F90 | 68 +------------------------------- 1 file changed, 2 insertions(+), 66 deletions(-) diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index b6300089f..8797973f3 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -8,9 +8,6 @@ module rrtmgp_lw_gas_optics use mo_compute_bc, only: compute_bc use rrtmgp_aux, only: check_error_msg use netcdf -#ifdef MPI - use mpi -#endif contains @@ -105,9 +102,6 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp 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 -#ifdef MPI - integer :: mpierr -#endif ! Initialize errmsg = '' @@ -119,7 +113,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp lw_gas_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_lw_file_gas) ! On master processor only... - if (mpirank .eq. mpiroot) then +! if (mpirank .eq. mpiroot) then ! Open file status = nf90_open(trim(lw_gas_props_file), NF90_WRITE, ncid) @@ -260,65 +254,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp ! Close file status = nf90_close(ncid) - endif - -#ifdef MPI - ! Wait for processor 0 to catch up... - call MPI_BARRIER(mpicomm, mpierr) - ! Broadcast data - write (*,*) 'Broadcasting RRTMGP longwave k-distribution data ... ' - call MPI_BCAST(ntemps, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(npress, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(nabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(nminorabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(nextrabsorbers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(nmixingfracs, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(nlayers, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(nbnds, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(ngpts, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(npairs, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(ncontributors_lower, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(ncontributors_upper, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(nminor_absorber_intervals_lower, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(nminor_absorber_intervals_upper, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(ninternalSourcetemps, 1, MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BARRIER(mpicomm, mpierr) - call MPI_BCAST(minor_limits_gpt_upper, size(minor_limits_gpt_upper), MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(minor_limits_gpt_lower, size(minor_limits_gpt_lower), MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(kminor_start_upper, size(kminor_start_upper), MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(kminor_start_lower, size(kminor_start_lower), MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(key_species, size(key_species), MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BARRIER(mpicomm, mpierr) - call MPI_BCAST(band2gpt, size(band2gpt), MPI_INTEGER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(band_lims, size(band_lims), MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(press_ref, size(press_ref), MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(temp_ref, size(temp_ref), MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(kminor_lower, size(kminor_lower), MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(kminor_upper, size(kminor_upper), MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BARRIER(mpicomm, mpierr) - call MPI_BCAST(scaling_gas_lower, size(scaling_gas_lower), MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(scaling_gas_upper, size(scaling_gas_upper), MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(vmr_ref, size(vmr_ref), MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(kmajor, size(kmajor), MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(temp_ref_p, 1, MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(temp_ref_t, 1, MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(press_ref_trop, 1, MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BARRIER(mpicomm, mpierr) - call MPI_BCAST(totplnk, size(totplnk), MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(planck_frac, size(planck_frac), MPI_REAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(gas_names, size(gas_names), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(gas_minor, size(gas_minor), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(identifier_minor, size(identifier_minor), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(minor_gases_lower, size(minor_gases_lower), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call MPI_BARRIER(mpicomm, mpierr) - call MPI_BCAST(minor_gases_upper, size(minor_gases_upper), MPI_CHARACTER, mpiroot, mpicomm, mpierr) - call MPI_BCAST(minor_scales_with_density_lower, nminor_absorber_intervals_lower, MPI_LOGICAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(scale_by_complement_lower, nminor_absorber_intervals_lower, MPI_LOGICAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(minor_scales_with_density_upper, nminor_absorber_intervals_upper, MPI_LOGICAL, mpiroot, mpicomm, mpierr) - call MPI_BCAST(scale_by_complement_upper, nminor_absorber_intervals_upper, MPI_LOGICAL, mpiroot, mpicomm, mpierr) - ! Don't advance until data broadcast complete on all processors - call MPI_BARRIER(mpicomm, mpierr) -#endif +! endif ! Initialize gas concentrations and gas optics class call check_error_msg('lw_gas_optics_init',gas_concentrations%init(active_gases_array)) From b745df89386b95b6279fb6de714b0e2bd8e4983b Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Thu, 19 Mar 2020 16:55:22 -0400 Subject: [PATCH 13/44] commited on MG3_v1 on 03/19/2020 --- physics/aerinterp.F90 | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/physics/aerinterp.F90 b/physics/aerinterp.F90 index 8c7046d37..e1263e93c 100644 --- a/physics/aerinterp.F90 +++ b/physics/aerinterp.F90 @@ -179,7 +179,13 @@ SUBROUTINE read_aerdata (me, master, iflip, idate ) 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) From fe43bca36956a5f7974dbe0a5f8a06a28eacb326 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 19 Mar 2020 15:44:04 -0600 Subject: [PATCH 14/44] Bugfix in physics/rrtmgp_lw_cloud_optics.F90, add 'implicit none' to all rrtmgp_*.F90 files --- physics/rrtmgp_lw_aerosol_optics.F90 | 3 +++ physics/rrtmgp_lw_cloud_optics.F90 | 7 +++++-- physics/rrtmgp_lw_cloud_sampling.F90 | 2 ++ physics/rrtmgp_lw_gas_optics.F90 | 2 ++ physics/rrtmgp_lw_pre.F90 | 7 ++++++- physics/rrtmgp_lw_rte.F90 | 3 +++ physics/rrtmgp_sw_aerosol_optics.F90 | 3 +++ physics/rrtmgp_sw_cloud_optics.F90 | 3 +++ physics/rrtmgp_sw_cloud_sampling.F90 | 2 ++ physics/rrtmgp_sw_gas_optics.F90 | 2 ++ physics/rrtmgp_sw_rte.F90 | 2 ++ 11 files changed, 33 insertions(+), 3 deletions(-) diff --git a/physics/rrtmgp_lw_aerosol_optics.F90 b/physics/rrtmgp_lw_aerosol_optics.F90 index a77b00759..eb23ba21a 100644 --- a/physics/rrtmgp_lw_aerosol_optics.F90 +++ b/physics/rrtmgp_lw_aerosol_optics.F90 @@ -10,7 +10,10 @@ module rrtmgp_lw_aerosol_optics 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 ! ######################################################################################### diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index 077982e6e..1738f895d 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -8,7 +8,10 @@ module rrtmgp_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 ! ######################################################################################### @@ -268,7 +271,7 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, nCol, nLev, cld_optics_scheme, nr ! Inputs logical, intent(in) :: & - doLWrad ! Logical flag for longwave radiation call + doLWrad ! Logical flag for longwave radiation call integer, intent(in) :: & nCol, & ! Number of horizontal gridpoints nLev, & ! Number of vertical levels @@ -327,7 +330,7 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, nCol, nLev, cld_optics_scheme, nr lw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys ! Compute cloud-optics for RTE. - if (rrtmgp_cld_optics .gt. 0) then + 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 diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index 51f512853..dca566923 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -8,6 +8,8 @@ module rrtmgp_lw_cloud_sampling use rrtmgp_aux, only: check_error_msg use netcdf + implicit none + contains ! ######################################################################################### diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index 8797973f3..ffe68184e 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -9,6 +9,8 @@ module rrtmgp_lw_gas_optics use rrtmgp_aux, only: check_error_msg use netcdf + implicit none + contains ! ######################################################################################### diff --git a/physics/rrtmgp_lw_pre.F90 b/physics/rrtmgp_lw_pre.F90 index 0be239671..d93b6a619 100644 --- a/physics/rrtmgp_lw_pre.F90 +++ b/physics/rrtmgp_lw_pre.F90 @@ -13,8 +13,10 @@ module rrtmgp_lw_pre 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 ! ######################################################################################### @@ -59,6 +61,9 @@ subroutine rrtmgp_lw_pre_run (doLWrad, nCol, xlon, xlat, slmsk, zorl, snowd, snc real(kind_phys), dimension(nCol), intent(out) :: & semis + ! Local variables + integer :: iBand + ! Initialize CCPP error handling variables errmsg = '' errflg = 0 diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index 94c9b741e..80848a363 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -11,7 +11,10 @@ module rrtmgp_lw_rte 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 ! ######################################################################################### diff --git a/physics/rrtmgp_sw_aerosol_optics.F90 b/physics/rrtmgp_sw_aerosol_optics.F90 index d6413c368..6207a22d8 100644 --- a/physics/rrtmgp_sw_aerosol_optics.F90 +++ b/physics/rrtmgp_sw_aerosol_optics.F90 @@ -10,7 +10,10 @@ module rrtmgp_sw_aerosol_optics 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 ! ######################################################################################### diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 99dcef2a5..79e439030 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -9,7 +9,10 @@ module rrtmgp_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 diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index cc998b755..0c839afb2 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -8,6 +8,8 @@ module rrtmgp_sw_cloud_sampling use rrtmgp_aux, only: check_error_msg use netcdf + implicit none + contains ! ######################################################################################### diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index a0691e940..a57e2fca8 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -9,6 +9,8 @@ module rrtmgp_sw_gas_optics use mo_compute_bc, only: compute_bc use netcdf + implicit none + contains ! ######################################################################################### diff --git a/physics/rrtmgp_sw_rte.F90 b/physics/rrtmgp_sw_rte.F90 index 96bfa94ea..0654331b7 100644 --- a/physics/rrtmgp_sw_rte.F90 +++ b/physics/rrtmgp_sw_rte.F90 @@ -10,6 +10,8 @@ module rrtmgp_sw_rte 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 From 24ce08dca3894ccc233a7d0955790fb62983b6f8 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 19 Mar 2020 20:39:24 -0600 Subject: [PATCH 15/44] Remove debug print statements --- physics/rrtmgp_lw_gas_optics.F90 | 4 +--- physics/rrtmgp_sw_gas_optics.F90 | 4 +--- 2 files changed, 2 insertions(+), 6 deletions(-) diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index ffe68184e..c94df2a2f 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -109,8 +109,6 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp errmsg = '' errflg = 0 - write(*,"(a52,3i20)") 'rrtmgp_lw_gas_optics.F90:_init(): RRTMGP MPI ranks: ',mpirank,mpiroot,mpicomm - ! Filenames are set in the physics_nml lw_gas_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_lw_file_gas) @@ -184,7 +182,7 @@ subroutine rrtmgp_lw_gas_optics_init(rrtmgp_root_dir, rrtmgp_lw_file_gas, rrtmgp allocate(planck_frac(ngpts, nmixingfracs, npress+1, ntemps)) ! Read in fields from file - write (*,*) 'Reading RRTMGP longwave k-distribution data ... ' + 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) diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index a57e2fca8..7945f43fe 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -107,8 +107,6 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp errmsg = '' errflg = 0 - write(*,"(a52,3i20)") 'rrtmgp_sw_gas_optics.F90:_init(): RRTMGP MPI ranks: ',mpirank,mpiroot,mpicomm - ! Filenames are set in the gphysics_nml sw_gas_props_file = trim(rrtmgp_root_dir)//trim(rrtmgp_sw_file_gas) @@ -181,7 +179,7 @@ subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, rrtmgp allocate(temp4(nminor_absorber_intervals_upper)) ! Read in fields from file - write (*,*) 'Reading RRTMGP shortwave k-distribution data ... ' + 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) From a0bb378ef6d2f57a2b04b65b579fc1b608286f53 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 20 Mar 2020 14:09:14 -0600 Subject: [PATCH 16/44] physics/rrtmgp_sw_rte.F90: bugfix from @dustinswales --- physics/rrtmgp_sw_rte.F90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/physics/rrtmgp_sw_rte.F90 b/physics/rrtmgp_sw_rte.F90 index 0654331b7..71b7e20ee 100644 --- a/physics/rrtmgp_sw_rte.F90 +++ b/physics/rrtmgp_sw_rte.F90 @@ -204,9 +204,9 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t 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(idxday(1:nday),iSFC,:),dim=2) - scmpsw(idxday(1:nday))%nirdf = sum(flux_allsky%bnd_flux_dn(idxday(1:nday),iSFC,:),dim=2) - & - sum(flux_allsky%bnd_flux_dn_dir(idxday(1:nday),iSFC,:),dim=2) + 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 From e8bca85238aae901e3c7ed97e6f0684b252e0385 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 23 Mar 2020 18:41:15 +0000 Subject: [PATCH 17/44] Cleanup RRTMGP optional argument logic. --- physics/GFS_rrtmgp_lw_post.F90 | 12 +++++------- physics/GFS_rrtmgp_lw_post.meta | 9 --------- physics/GFS_rrtmgp_sw_post.F90 | 12 +++++------- physics/GFS_rrtmgp_sw_post.meta | 9 --------- physics/rrtmgp_lw_rte.F90 | 29 ++++++++++++----------------- physics/rrtmgp_lw_rte.meta | 9 --------- physics/rrtmgp_sw_rte.F90 | 31 +++++++++++++------------------ physics/rrtmgp_sw_rte.meta | 9 --------- 8 files changed, 35 insertions(+), 85 deletions(-) diff --git a/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90 index 38b9530b0..103d88274 100644 --- a/physics/GFS_rrtmgp_lw_post.F90 +++ b/physics/GFS_rrtmgp_lw_post.F90 @@ -33,7 +33,7 @@ end subroutine GFS_rrtmgp_lw_post_init 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, hlw0, errmsg, errflg) + flxprf_lw, errmsg, errflg) ! Inputs type(GFS_control_type), intent(in) :: & @@ -66,7 +66,8 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statei 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) + hlwc, & ! Longwave all-sky heating-rate (K/sec) + hlw0 ! Longwave clear-sky heating-rate (K/sec) ! Outputs (mandatory) character(len=*), intent(out) :: & @@ -81,8 +82,6 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statei Diag ! Fortran DDT: FV3-GFS diagnotics data ! Outputs (optional) - real(kind_phys), dimension(size(Grid%xlon,1), Model%levs), optional, intent(inout) :: & - hlw0 ! Longwave clear-sky heating rate (K/sec) 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) @@ -92,7 +91,7 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statei ! Local variables integer :: i, j, k, iSFC, iTOA, itop, ibtc - logical :: l_clrskylw_hr, l_fluxeslw2d, top_at_1 + logical :: l_fluxeslw2d, top_at_1 real(kind_phys) :: tem0d, tem1, tem2 ! Initialize CCPP error handling variables @@ -102,7 +101,6 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statei if (.not. Model%lslwr) return ! Are any optional outputs requested? - l_clrskylw_hr = present(hlw0) l_fluxeslw2d = present(flxprf_lw) ! ####################################################################################### @@ -122,7 +120,7 @@ subroutine GFS_rrtmgp_lw_post_run (Model, Grid, Radtend, Coupling, Diag, Statei ! ####################################################################################### if (Model%lslwr) then ! Clear-sky heating-rate (optional) - if (l_clrskylw_hr) then + 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) diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta index 3eb1e0953..dbe96120d 100644 --- a/physics/GFS_rrtmgp_lw_post.meta +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -180,15 +180,6 @@ type = proflw_type intent = inout optional = T -[hlw0] - standard_name = RRTMGP_lw_heating_rate_clear_sky - long_name = RRTMGP longwave clear sky heating rate - units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = T [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 index 7d4e6ba6b..a5e9de512 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -30,7 +30,7 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein 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,& - hsw0, errmsg, errflg) + errmsg, errflg) ! Inputs type(GFS_control_type), intent(in) :: & @@ -77,7 +77,8 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein 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 rates (K/s) + hswc, & ! All-sky heating rate (K/s) + hsw0 ! Clear-sky heating rate (K/s) ! Outputs (mandatory) character(len=*), intent(out) :: & @@ -86,8 +87,6 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein errflg ! Outputs (optional) - real(kind_phys), dimension(nCol, Model%levs), optional, intent(inout) :: & - hsw0 ! Shortwave clear-sky heating-rate (K/sec) type(profsw_type), dimension(nCol, Model%levs+1), intent(inout), optional :: & flxprf_sw ! 2D radiative fluxes, components: ! upfxc - total sky upward flux (W/m2) @@ -106,7 +105,7 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein 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_clrskysw_hr, l_fluxessw2d, top_at_1, l_sfcFluxessw1D + logical :: l_fluxessw2d, top_at_1, l_sfcFluxessw1D ! Initialize CCPP error handling variables errmsg = '' @@ -116,7 +115,6 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein if (nDay .gt. 0) then ! Are any optional outputs requested? - l_clrskysw_hr = present(hsw0) l_fluxessw2d = present(flxprf_sw) l_sfcfluxessw1D = present(scmpsw) @@ -136,7 +134,7 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein ! Compute SW heating-rates ! ####################################################################################### ! Clear-sky heating-rate (optional) - if (l_clrskysw_HR) then + if (Model%swhtr) then 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) diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta index a933cba89..a817d9332 100644 --- a/physics/GFS_rrtmgp_sw_post.meta +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -239,15 +239,6 @@ type = profsw_type intent = inout optional = T -[hsw0] - standard_name = RRTMGP_sw_heating_rate_clear_sky - long_name = RRTMGP shortwave clear sky heating rate - units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = T [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index 80848a363..0fbe68d5a 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -32,7 +32,7 @@ end subroutine rrtmgp_lw_rte_init 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, hlw0, hlwb, errmsg, errflg) + fluxlwUP_clrsky, fluxlwDOWN_clrsky, hlwb, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -75,8 +75,6 @@ subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_g ! 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) - real(kind_phys), dimension(ncol,nLev), optional, intent(inout) :: & - hlw0 ! Clear-sky heating rate (K/sec) ! Local variables integer :: & @@ -86,7 +84,7 @@ subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_g 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_ClrSky_HR, l_AllSky_HR_byband, top_at_1 + l_AllSky_HR_byband, top_at_1 ! Initialize CCPP error handling variables errmsg = '' @@ -98,7 +96,6 @@ subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_g 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_ClrSky_HR = present(hlw0) l_AllSky_HR_byband = present(hlwb) ! Initialize RRTMGP DDT containing 2D(3D) fluxes @@ -121,18 +118,16 @@ subroutine rrtmgp_lw_rte_run(doLWrad, nCol, nLev, p_lay, t_lay, p_lev, skt, lw_g enddo ! Call RTE solver - if (l_ClrSky_HR) then - 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) - endif + 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 diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index e85a607fa..a8426bc15 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -118,15 +118,6 @@ type = ty_source_func_lw intent = in optional = F -[hlw0] - standard_name = RRTMGP_lw_heating_rate_clear_sky - long_name = RRTMGP longwave clear sky heating rate - units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = in - optional = T [hlwb] standard_name = RRTMGP_lw_heating_rate_spectral long_name = RRTMGP longwave total sky heating rate (spectral) diff --git a/physics/rrtmgp_sw_rte.F90 b/physics/rrtmgp_sw_rte.F90 index 71b7e20ee..98f95a1bd 100644 --- a/physics/rrtmgp_sw_rte.F90 +++ b/physics/rrtmgp_sw_rte.F90 @@ -32,7 +32,7 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t 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, hsw0, hswb, errmsg, errflg) + fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, hswb, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -70,8 +70,6 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t 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), optional, intent(inout) :: & - hsw0 ! Clear-sky heating rate (K/sec) real(kind_phys), dimension(ncol,NLev,sw_gas_props%get_nband()), intent(inout), optional :: & hswb ! All-sky heating rate, by band (K/sec) @@ -105,7 +103,7 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t 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_ClrSky_HR=.false., l_AllSky_HR_byband=.false., l_scmpsw=.false., top_at_1 + logical :: l_AllSky_HR_byband=.false., l_scmpsw=.false., top_at_1 integer :: iGas,iSFC,iTOA,iBand ! Initialize CCPP error handling variables @@ -133,7 +131,6 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t endif ! Are any optional outputs requested? Need to know now to compute correct fluxes. - l_ClrSky_HR = present(hsw0) l_AllSky_HR_byband = present(hswb) l_scmpsw = present(scmpsw) if ( l_scmpsw ) then @@ -173,19 +170,17 @@ subroutine rrtmgp_sw_rte_run(doSWrad, nCol, nLev, nDay, idxday, coszen, p_lay, t 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()) - if (l_ClrSky_HR) then - 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) - endif + 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) diff --git a/physics/rrtmgp_sw_rte.meta b/physics/rrtmgp_sw_rte.meta index 8ae7421c3..629ede530 100644 --- a/physics/rrtmgp_sw_rte.meta +++ b/physics/rrtmgp_sw_rte.meta @@ -215,15 +215,6 @@ kind = kind_phys intent = inout optional = F -[hsw0] - standard_name = RRTMGP_sw_heating_rate_clear_sky - long_name = shortwave clear sky heating rate - units = K s-1 - dimensions = (horizontal_dimension,vertical_dimension) - type = real - kind = kind_phys - intent = inout - optional = T [hswb] standard_name = RRTMGP_sw_heating_rate_spectral long_name = shortwave total sky heating rate (spectral) From 1e43ed68c372cfbe30702ad038f3b74f1db132b0 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 25 Mar 2020 11:14:18 -0600 Subject: [PATCH 18/44] physics/GFS_rrtmgp_sw_post.F90: bugfix, reset heating rate arrays --- physics/GFS_rrtmgp_sw_post.F90 | 2 ++ 1 file changed, 2 insertions(+) diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 index a5e9de512..cf477467a 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -135,6 +135,7 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein ! ####################################################################################### ! 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) @@ -144,6 +145,7 @@ subroutine GFS_rrtmgp_sw_post_run (Model, Grid, Diag, Radtend, Coupling, Statein 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) From 47713ac7cd1cd75cc9f74ca6dc109f8af29a0d5e Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Wed, 25 Mar 2020 16:01:37 -0400 Subject: [PATCH 19/44] bugs fixed in MG3_v1 m_micro.F90 --- physics/m_micro.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/m_micro.F90 b/physics/m_micro.F90 index a2eb5296f..83ff8d554 100644 --- a/physics/m_micro.F90 +++ b/physics/m_micro.F90 @@ -182,8 +182,8 @@ subroutine m_micro_run( im, ix, lm, flipv, dt_i & & fourb3=4.0/3.0, RL_cub=1.0e-15, nmin=1.0 integer, parameter :: ncolmicro = 1 - integer,intent(in) :: im, ix,lm, ipr, kdt, fprcp, pdfflag - logical,intent(in) :: flipv, skip_macro, lprnt + integer,intent(in) :: im, ix,lm, kdt, fprcp, pdfflag + logical,intent(in) :: flipv, skip_macro integer,intent(in) :: iccn real (kind=kind_phys), intent(in):: dt_i, alf_fac, qc_min(2) From ba6150331327c1344b347c3fd71f4429f9ad7ffc Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 26 Mar 2020 10:08:49 -0600 Subject: [PATCH 20/44] Bugfixes and updates based on code review --- physics/GFS_rrtmgp_pre.F90 | 2 +- physics/GFS_rrtmgp_setup.F90 | 17 +++++++++-------- physics/GFS_rrtmgp_sw_post.F90 | 2 +- physics/rrtmgp_aux.F90 | 10 ---------- physics/rrtmgp_lw_cloud_sampling.F90 | 4 ++-- physics/rrtmgp_lw_gas_optics.F90 | 4 ++-- physics/rrtmgp_lw_pre.F90 | 2 +- physics/rrtmgp_lw_rte.F90 | 2 +- physics/rrtmgp_sw_aerosol_optics.F90 | 2 +- 9 files changed, 18 insertions(+), 27 deletions(-) diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index cb2b79410..1344f269c 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -182,7 +182,7 @@ end subroutine GFS_rrtmgp_pre_init ! SUBROUTINE GFS_rrtmgp_pre_run ! ######################################################################################### !> \section arg_table_GFS_rrtmgp_pre_run -!! \htmlinclude GFS_rrtmgp_pre.html +!! \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 diff --git a/physics/GFS_rrtmgp_setup.F90 b/physics/GFS_rrtmgp_setup.F90 index 42ce8662c..45bc4397b 100644 --- a/physics/GFS_rrtmgp_setup.F90 +++ b/physics/GFS_rrtmgp_setup.F90 @@ -37,7 +37,7 @@ module GFS_rrtmgp_setup !> \defgroup GFS_rrtmgp_setup GFS RRTMGP Scheme Setup !! @{ !! \section arg_table_GFS_rrtmgp_setup_init -!! \htmlinclude GFS_rrtmgp_setup.html +!! \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, & @@ -91,8 +91,9 @@ subroutine GFS_rrtmgp_setup_init (Model, si, levr, ictm, isol, ico2, & endif iaermdl = iaer/1000 ! control flag for aerosol scheme selection if ( iaermdl < 0 .or. (iaermdl>2 .and. iaermdl/=5) ) then - print *, ' Error -- IAER flag is incorrect, Abort' - stop 7777 + errmsg = trim(errmsg) // ' Error -- IAER flag is incorrect, Abort' + errflg = 1 + return endif !if ( ntcw > 0 ) then @@ -135,7 +136,7 @@ subroutine GFS_rrtmgp_setup_init (Model, si, levr, ictm, isol, ico2, & end subroutine GFS_rrtmgp_setup_init !> \section arg_table_GFS_rrtmgp_setup_run -!! \htmlinclude GFS_rrtmgp_setup.html +!! \htmlinclude GFS_rrtmgp_setup_run.html !! subroutine GFS_rrtmgp_setup_run (idate, jdate, deltsw, deltim, lsswr, me, & slag, sdec, cdec, solcon, errmsg, errflg) @@ -171,10 +172,10 @@ subroutine GFS_rrtmgp_setup_run (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.html - !! + +!> \section arg_table_GFS_rrtmgp_setup_finalize +!! \htmlinclude GFS_rrtmgp_setup_finalize.html +!! subroutine GFS_rrtmgp_setup_finalize (errmsg, errflg) implicit none diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 index cf477467a..4e9f8a33f 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -24,7 +24,7 @@ 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.html +!! \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, & diff --git a/physics/rrtmgp_aux.F90 b/physics/rrtmgp_aux.F90 index 0ee837b97..d39705e7a 100644 --- a/physics/rrtmgp_aux.F90 +++ b/physics/rrtmgp_aux.F90 @@ -7,16 +7,6 @@ module rrtmgp_aux rrtmgp_minP, & ! Minimum pressure allowed in RRTMGP rrtmgp_minT ! Minimum temperature allowed in RRTMGP contains - ! - subroutine rrtmgp_aux_init() - end subroutine rrtmgp_aux_init - ! - subroutine rrtmgp_aux_run() - end subroutine rrtmgp_aux_run - ! - subroutine rrtmgp_aux_finalize() - end subroutine rrtmgp_aux_finalize - ! ######################################################################################### ! SUBROUTINE check_error_msg ! ######################################################################################### diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index dca566923..e42336923 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -16,7 +16,7 @@ module rrtmgp_lw_cloud_sampling ! SUBROUTINE mcica_init ! ######################################################################################### !! \section arg_table_rrtmgp_lw_cloud_sampling_init -!! \htmlinclude rrtmgp_lw_cloud_sampling.html +!! \htmlinclude rrtmgp_lw_cloud_sampling_init.html !! subroutine rrtmgp_lw_cloud_sampling_init(lw_gas_props, ipsdlw0) ! Inputs @@ -35,7 +35,7 @@ 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.html +!! \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) diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index c94df2a2f..408cc48f5 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -17,7 +17,7 @@ module rrtmgp_lw_gas_optics ! SUBROUTINE rrtmgp_sw_gas_optics_init ! ######################################################################################### !! \section arg_table_rrtmgp_lw_gas_optics_init -!! \htmlinclude rrtmgp_lw_gas_optics.html +!! \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) @@ -272,7 +272,7 @@ 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.html +!! \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) diff --git a/physics/rrtmgp_lw_pre.F90 b/physics/rrtmgp_lw_pre.F90 index d93b6a619..1148c6705 100644 --- a/physics/rrtmgp_lw_pre.F90 +++ b/physics/rrtmgp_lw_pre.F90 @@ -29,7 +29,7 @@ end subroutine rrtmgp_lw_pre_init ! SUBROUTINE rrtmgp_lw_pre_run ! ######################################################################################### !> \section arg_table_rrtmgp_lw_pre_run -!! \htmlinclude rrtmgp_lw_pre.html +!! \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) diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index 0fbe68d5a..583fa9ee2 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -27,7 +27,7 @@ end subroutine rrtmgp_lw_rte_init ! SUBROUTINE rrtmgp_lw_rte_run ! ######################################################################################### !! \section arg_table_rrtmgp_lw_rte_run -!! \htmlinclude rrtmgp_lw_rte.html +!! \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, & diff --git a/physics/rrtmgp_sw_aerosol_optics.F90 b/physics/rrtmgp_sw_aerosol_optics.F90 index 6207a22d8..effbfae72 100644 --- a/physics/rrtmgp_sw_aerosol_optics.F90 +++ b/physics/rrtmgp_sw_aerosol_optics.F90 @@ -26,7 +26,7 @@ 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.html +!! \htmlinclude rrtmgp_sw_aerosol_optics_run.html !! subroutine rrtmgp_sw_aerosol_optics_run(doSWrad, nCol, nLev, nTracer, nDay, idxday, p_lev,& p_lay, p_lk, tv_lay, relhum, lsmask, tracer, lon, lat, lw_gas_props, sw_gas_props, & From 5a1160b6ef01659464168dee035f87459c0a334f Mon Sep 17 00:00:00 2001 From: "ligia.bernardet" Date: Tue, 31 Mar 2020 11:25:58 -0600 Subject: [PATCH 21/44] Update README file --- README.md | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 534b01a90..7047ccf3a 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]. + +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/) From b95bcb3f3bbf5a610002f9c1f1eabb75dda80c12 Mon Sep 17 00:00:00 2001 From: "ligia.bernardet" Date: Tue, 31 Mar 2020 12:55:10 -0600 Subject: [PATCH 22/44] Update README file again --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 7047ccf3a..c1964c445 100644 --- a/README.md +++ b/README.md @@ -11,8 +11,8 @@ Please see more information about the CCPP at the locations below. - [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]. +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/) +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/) From 7fef26f375c407a3b176861dfb865b8ae7f546cb Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 1 Apr 2020 10:03:27 -0600 Subject: [PATCH 23/44] Clean up of radiation tendencies standard names as described in issue https://github.com/NCAR/ccpp-physics/issues/179 --- physics/GFS_PBL_generic.meta | 4 ++-- physics/GFS_suite_interstitial.meta | 4 ++-- physics/dcyc2.meta | 8 ++++---- physics/m_micro.meta | 4 ++-- physics/module_MYNNPBL_wrapper.meta | 4 ++-- physics/moninedmf.meta | 4 ++-- physics/moninedmf_hafs.meta | 4 ++-- physics/radlw_main.meta | 4 ++-- physics/radsw_main.meta | 4 ++-- physics/rrtmg_lw_post.meta | 4 ++-- physics/rrtmg_sw_post.meta | 4 ++-- physics/satmedmfvdif.meta | 4 ++-- physics/satmedmfvdifq.meta | 4 ++-- physics/ysuvdif.meta | 4 ++-- 14 files changed, 30 insertions(+), 30 deletions(-) diff --git a/physics/GFS_PBL_generic.meta b/physics/GFS_PBL_generic.meta index 51764e04d..e130ed1a7 100644 --- a/physics/GFS_PBL_generic.meta +++ b/physics/GFS_PBL_generic.meta @@ -747,7 +747,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 +756,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_suite_interstitial.meta b/physics/GFS_suite_interstitial.meta index 9cda625ab..5c206ef30 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/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/m_micro.meta b/physics/m_micro.meta index 749b627f7..9daa8e969 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) diff --git a/physics/module_MYNNPBL_wrapper.meta b/physics/module_MYNNPBL_wrapper.meta index da09c0089..27b186bd3 100644 --- a/physics/module_MYNNPBL_wrapper.meta +++ b/physics/module_MYNNPBL_wrapper.meta @@ -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/moninedmf.meta b/physics/moninedmf.meta index 6a6ccd183..25fddea02 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) diff --git a/physics/moninedmf_hafs.meta b/physics/moninedmf_hafs.meta index 0e0ed15ad..13bf39396 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) diff --git a/physics/radlw_main.meta b/physics/radlw_main.meta index 73977e5cb..e91fc10df 100644 --- a/physics/radlw_main.meta +++ b/physics/radlw_main.meta @@ -257,7 +257,7 @@ intent = in optional = F [hlwc] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step + standard_name = tendency_of_air_temperature_due_to_longwave_heating_on_radiation_time_step_and_radiation_levels long_name = longwave total sky heating rate units = K s-1 dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) @@ -291,7 +291,7 @@ intent = inout optional = F [hlw0] - standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step + standard_name = tendency_of_air_temperature_due_to_longwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels long_name = longwave clear sky heating rate units = K s-1 dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) diff --git a/physics/radsw_main.meta b/physics/radsw_main.meta index c5cbe768a..c8074cf47 100644 --- a/physics/radsw_main.meta +++ b/physics/radsw_main.meta @@ -318,7 +318,7 @@ intent = in optional = F [hswc] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_on_radiation_time_step_and_radiation_levels long_name = shortwave total sky heating rate units = K s-1 dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) @@ -352,7 +352,7 @@ intent = inout optional = F [hsw0] - standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step + standard_name = tendency_of_air_temperature_due_to_shortwave_heating_assuming_clear_sky_on_radiation_time_step_and_radiation_levels long_name = shortwave clear sky heating rate units = K s-1 dimensions = (horizontal_dimension,adjusted_vertical_layer_dimension_for_radiation) diff --git a/physics/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_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/satmedmfvdif.meta b/physics/satmedmfvdif.meta index dcf307e55..e127f14e5 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) diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index d6b1d66ea..4e9b05239 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) diff --git a/physics/ysuvdif.meta b/physics/ysuvdif.meta index da01b0a41..12819dee5 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) From dc8a5cc5e02a55778570926bb5bfaba97611afe6 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Wed, 1 Apr 2020 16:31:38 -0600 Subject: [PATCH 24/44] Bugfix in physics/mp_thompson.F90: aerosol arrays may not be allocated, use assumed size arrays --- physics/mp_thompson.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) 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 From 3d64654aff54e50bdac27f25af9712050b5531d9 Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Thu, 2 Apr 2020 14:19:00 +0000 Subject: [PATCH 25/44] put gctrt in .no.flxform to avoid debug error for csawmgshoc --- physics/cs_conv.F90 | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) 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 From 4680d9dc36312dd69b0e082e32986a4dcd8f7377 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 2 Apr 2020 17:02:34 -0600 Subject: [PATCH 26/44] CMakeLists.txt: remove unnecessary include directories that are not required and cause a second compile step to recompile everything in ccpp-physics --- CMakeLists.txt | 12 +----------- 1 file changed, 1 insertion(+), 11 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 0a1658b22..725a1f947 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -84,17 +84,6 @@ else(STATIC) option(BUILD_SHARED_LIBS "Build a shared library" ON) endif(STATIC) -#------------------------------------------------------------------------------ -# 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}) @@ -357,6 +346,7 @@ elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "PGI") endif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") if (PROJECT STREQUAL "CCPP-SCM") + message(FATAL_ERROR "SHOULDN'T BE HERE!!!") INCLUDE_DIRECTORIES(${CMAKE_BINARY_DIR}/ccpp/framework/src) endif (PROJECT STREQUAL "CCPP-SCM") From 4dc748c0d2761398c4255514a8083ea9e1f6fb92 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 3 Apr 2020 14:54:42 -0600 Subject: [PATCH 27/44] Remove unneeded code for SCM, including an unintentionally left FATAL_ERROR exception --- CMakeLists.txt | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 725a1f947..0bd3ffeda 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -33,13 +33,6 @@ 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 OpenMP flags for C/C++/Fortran if (OPENMP) @@ -345,13 +338,7 @@ 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") - message(FATAL_ERROR "SHOULDN'T BE HERE!!!") - 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 From c1fb9ccb98cab43e9006aa3457e1e4a9a393f59d Mon Sep 17 00:00:00 2001 From: "anning.cheng" Date: Mon, 6 Apr 2020 20:56:48 +0000 Subject: [PATCH 28/44] changes make changing INPUT/cam5_* to cam5_* in iccninterp --- physics/iccninterp.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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) From d9fae0e98b7b87420e5448d39a1bc4648856b448 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 9 Apr 2020 20:18:55 -0600 Subject: [PATCH 29/44] Update CMakeLists.txt: require cmake 3.0, remove legacy syntax for policy CMP0048 --- CMakeLists.txt | 22 +++++----------------- 1 file changed, 5 insertions(+), 17 deletions(-) diff --git a/CMakeLists.txt b/CMakeLists.txt index 0bd3ffeda..9765fa25e 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -5,22 +5,14 @@ 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) @@ -29,10 +21,6 @@ endif(POLICY CMP0042) set(PACKAGE "ccpp-physics") set(AUTHORS "Grant J. Firl" "Dom Heinzeller") -#------------------------------------------------------------------------------ -# Enable Fortran -enable_language(Fortran) - #------------------------------------------------------------------------------ # Set OpenMP flags for C/C++/Fortran if (OPENMP) From 80c6fdb88236c3f1ef81be7fc69a6dbc3844e6c2 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Thu, 9 Apr 2020 20:19:20 -0600 Subject: [PATCH 30/44] physics/ugwp_driver_v0.F: comment out unnecessary prints to stdout that pollute the model output --- physics/ugwp_driver_v0.F | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/physics/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index 4edd84a7a..ff6e30b83 100644 --- a/physics/ugwp_driver_v0.F +++ b/physics/ugwp_driver_v0.F @@ -1839,16 +1839,16 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! !--------------------------------------------------------------------------- ! - if (kdt == 1 .and. mpi_id == master) then - print *, 'vgw done ' -! - print *, maxval(pdudt)*86400., minval(pdudt)*86400, 'vgw ax' - print *, maxval(pdvdt)*86400., minval(pdvdt)*86400, 'vgw ay' - print *, maxval(dked)*1., minval(dked)*1, 'vgw keddy m2/sec' - print *, maxval(pdtdt)*86400., minval(pdtdt)*86400,'vgw eps' -! -! print *, ' ugwp -heating rates ' - endif +! if (kdt == 1 .and. mpi_id == master) then +! print *, 'vgw done ' +!! +! print *, maxval(pdudt)*86400., minval(pdudt)*86400, 'vgw ax' +! print *, maxval(pdvdt)*86400., minval(pdvdt)*86400, 'vgw ay' +! print *, maxval(dked)*1., minval(dked)*1, 'vgw keddy m2/sec' +! print *, maxval(pdtdt)*86400., minval(pdtdt)*86400,'vgw eps' +!! +!! print *, ' ugwp -heating rates ' +! endif return end subroutine fv3_ugwp_solv2_v0 From 7726128fbea84800f7b324a9d136a6c1e1876b85 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 10 Apr 2020 14:19:00 -0600 Subject: [PATCH 31/44] Apply missing updates for MG-IN-CCN changes --- physics/GFS_phys_time_vary.fv3.F90 | 3 +- physics/GFS_phys_time_vary.scm.F90 | 3 +- physics/GFS_rrtmg_post.F90 | 18 ++-- physics/aerinterp.F90 | 73 ++++++++------- physics/radiation_aerosols.f | 142 ++++++++++++++--------------- 5 files changed, 123 insertions(+), 116 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 56b4c86a4..915b4fd48 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -167,7 +167,8 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e ! 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) + if (errflg/=0) return endif else ! Update the value of ntrcaer in aerclm_def with the value defined diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index 095dac2c7..01b48f5d7 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -110,7 +110,8 @@ subroutine GFS_phys_time_vary_init (Grid, Model, Interstitial, Tbd, errmsg, errf ! 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 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/aerinterp.F90 b/physics/aerinterp.F90 index e1263e93c..d6bf822f7 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,13 +15,16 @@ module aerinterp contains - SUBROUTINE read_aerdata (me, master, iflip, idate ) + 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, ndims, dim1, dim2, dim3, hmx integer :: i, j, k, n, ii, imon, klev @@ -49,9 +52,10 @@ SUBROUTINE read_aerdata (me, master, iflip, idate ) !! =================================================================== fname=trim("aeroclim.m"//'01'//".nc") inquire (file = fname, exist = file_exist) - if (.not. file_exist ) then - print *, 'fname not found, abort' - stop 8888 + if (.not. file_exist) then + errmsg = errmsg // ' error in read_aerdata: file ' // trim(fname) // ' not found' + errflg = 1 + return endif call nf_open(fname , nf90_NOWRITE, ncid) @@ -95,12 +99,12 @@ SUBROUTINE read_aerdata (me, master, iflip, idate ) 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) + aer_lon(i+hmx) = aer_loni(i) + aer_lon(i) = aer_loni(i+hmx) enddo do i = 1, latsaer - aer_lat(i) = aer_lati(i) + aer_lat(i) = aer_lati(i) enddo call nf_close(ncid) @@ -120,23 +124,18 @@ SUBROUTINE read_aerdata (me, master, iflip, idate ) do imon = 1, timeaer write(mn,'(i2.2)') imon fname=trim("aeroclim.m"//mn//".nc") - if (me == master) print *, "aerosol climo:", fname, & - "for imon:",imon,idate - inquire (file = fname, exist = file_exist) - if ( file_exist ) then - if (me == master) print *, & - "aerosol climo found; proceed the run" - else - print *,"Error! aerosol climo not found; abort the run" - stop 555 + if (.not. file_exist) then + errmsg = 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) + call nf_get_var(ncid, varid, buff) do j = 1, latsaer do i = 1, lonsaer @@ -144,7 +143,7 @@ SUBROUTINE read_aerdata (me, master, iflip, idate ) 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 !k-loop enddo !i-loop (lon) ! extract pres_tmp to fill aer_pres (in Pa) @@ -153,7 +152,7 @@ SUBROUTINE read_aerdata (me, master, iflip, idate ) klev = k else ! data from sfc to top klev = ( dim3 - k ) + 1 - endif + 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) @@ -170,13 +169,13 @@ SUBROUTINE read_aerdata (me, master, iflip, idate ) call nf_get_var(ncid, varid, buffx) do j = 1, latsaer - do k = 1, levsaer + 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 + 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 @@ -200,7 +199,7 @@ SUBROUTINE read_aerdata (me, master, iflip, idate ) deallocate (buff, pres_tmp) deallocate (buffx) - END SUBROUTINE read_aerdata + END SUBROUTINE read_aerdata ! !********************************************************************** ! @@ -235,7 +234,7 @@ SUBROUTINE setindxaer(npts,dlat,jindx1,jindx2,ddy,dlon, & else ddy(j) = 1.0 endif - + ENDDO DO J=1,npts @@ -255,7 +254,7 @@ SUBROUTINE setindxaer(npts,dlat,jindx1,jindx2,ddy,dlon, & ddx(j) = 1.0 endif ENDDO - + RETURN END SUBROUTINE setindxaer ! @@ -271,7 +270,7 @@ 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) @@ -318,7 +317,7 @@ 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 (n2 > 12) n2 = n2 -12 ! DO L=1,levsaer @@ -330,18 +329,18 @@ 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)) + +TEMI*DDY(j)*aer_pres(I1,J2,L,n2)+DDX(j)*TEMJ*aer_pres(I2,J1,L,n2)) ENDDO ENDDO @@ -349,11 +348,11 @@ SUBROUTINE aerinterpol(me,master,npts,IDATE,FHOUR,jindx1,jindx2, & ! 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,1)) then + if(prsl(j,L).ge.aerpres(j,1)) then DO ii=1, ntrcaer aerout(j,L,ii)=aerpm(j,1,ii) !! sfc level ENDDO - else if(prsl(j,L).le.aerpres(j,levsaer)) then + else if(prsl(j,L).le.aerpres(j,levsaer)) then DO ii=1, ntrcaer aerout(j,L,ii)=aerpm(j,levsaer,ii) !! toa top ENDDO @@ -372,11 +371,11 @@ SUBROUTINE aerinterpol(me,master,npts,IDATE,FHOUR,jindx1,jindx2, & DO ii = 1, ntrcaer aerout(j,L,ii)= aerpm(j,i1,ii)*tx1 + aerpm(j,i2,ii)*tx2 ENDDO - endif + endif ENDDO !L-loop ENDDO !J-loop ! - RETURN + RETURN END SUBROUTINE aerinterpol end module aerinterp diff --git a/physics/radiation_aerosols.f b/physics/radiation_aerosols.f index 45a909ca8..f732c37ef 100644 --- a/physics/radiation_aerosols.f +++ b/physics/radiation_aerosols.f @@ -101,7 +101,7 @@ ! 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 ! +! with new spectral band mapping method ! ! ! ! references for opac climatological aerosols: ! ! hou et al. 2002 (ncep office note 441) ! @@ -142,15 +142,15 @@ !! !!\n References: !! - OPAC climatological aerosols: -!! Hou et al. 2002 \cite hou_et_al_2002; Hess et al. 1998 +!! 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 +!! 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 @@ -200,12 +200,12 @@ module module_radiation_aerosols ! ! --- module control parameters set in subroutine "aer_init" !> number of actual bands for sw aerosols; calculated according to !! laswflg setting - integer, save :: NSWBND = NBDSW + integer, save :: NSWBND = NBDSW !> number of actual bands for lw aerosols; calculated according to !! lalwflg and lalw1bd settings - integer, save :: NLWBND = NBDLW + integer, save :: NLWBND = NBDLW !> total number of bands for sw+lw aerosols - integer, save :: NSWLWBD = NBDSW+NBDLW + integer, save :: NSWLWBD = NBDSW+NBDLW ! LW aerosols effect control flag ! =.true.:aerosol effect is included in LW radiation ! =.false.:aerosol effect is not included in LW radiation @@ -415,11 +415,11 @@ module module_radiation_aerosols ! integer, parameter :: KAERBNDI=56 !> num of rh levels for rh-dep components integer, parameter :: KRHLEV =36 -!> num of gocart rh indep aerosols +!> num of gocart rh indep aerosols integer, parameter :: KCM1 = 5 -!> num of gocart rh dep aerosols +!> num of gocart rh dep aerosols integer, parameter :: KCM2 = 10 -!> num of gocart aerosols +!> num of gocart aerosols integer, parameter :: KCM = KCM1 + KCM2 real (kind=kind_phys), dimension(KRHLEV) :: rhlev_grt & @@ -462,7 +462,7 @@ module module_radiation_aerosols ! ! ======================================================================= ! --------------------------------------------------------------------- ! -! section-5 : module variables for aod diagnostic ! +! 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: @@ -783,11 +783,11 @@ subroutine set_spectrum ! ! ! ==================== defination of variables =================== ! ! ! -!> - inputs: (module constants) -!! - NWVTOT: total num of wave numbers used in sw spectrum -!! - NWVTIR: total num of wave numbers used in the ir region -!! -!> - outputs: (in-scope variables) +!> - inputs: (module constants) +!! - NWVTOT: total num of wave numbers used in sw spectrum +!! - NWVTIR: total num of wave numbers used in the ir region +!! +!> - outputs: (in-scope variables) !! - solfwv(NWVTOT): solar flux for each individual wavenumber !! (\f$W/m^2\f$) !! - eirfwv(NWVTIR): ir flux(273k) for each individual wavenumber @@ -905,7 +905,7 @@ end subroutine aer_init !!@} -!> This subroutine is the opac-climatology aerosol initialization +!> 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 !! \f$(w/m^2)\f$ @@ -1098,7 +1098,7 @@ subroutine set_aercoef ! !===> ... begin here ! -!> -# Reading climatological aerosols optical data from aeros_file, +!> -# Reading climatological aerosols optical data from aeros_file, !! including: inquire (file=aeros_file, exist=file_exist) @@ -1143,56 +1143,56 @@ subroutine set_aercoef endif !> - ending wave num for 61 aerosol spectral bands - read(NIAERCM,21) cline + read(NIAERCM,21) cline 21 format(a80) read(NIAERCM,22) iendwv(:) 22 format(13i6) !> - atmos scale height for 5 domains, 7 profs - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,24) haer(:,:) 24 format(20f4.1) !> - reference pressure for 5 domains, 7 profs - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,26) prsref(:,:) 26 format(10f7.2) !> - rh independent ext coef for 61 bands, 6 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhidext0(:,:) 28 format(8e10.3) !> - rh independent sca coef for 61 bands, 6 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhidsca0(:,:) !> - rh independent ssa coef for 61 bands, 6 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhidssa0(:,:) !> - rh independent asy coef for 61 bands, 6 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhidasy0(:,:) !> - rh dependent ext coef for 61 bands, 8 rh lev, 4 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhdpext0(:,:,:) !> - rh dependent sca coef for 61 bands, 8 rh lev, 4 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhdpsca0(:,:,:) !> - rh dependent ssa coef for 61 bands, 8 rh lev, 4 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhdpssa0(:,:,:) !> - rh dependent asy coef for 61 bands, 8 rh lev, 4 species - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) rhdpasy0(:,:,:) !> - stratospheric background aeros for 61 bands - read(NIAERCM,21) cline + read(NIAERCM,21) cline read(NIAERCM,28) straext0(:) close (NIAERCM) @@ -1759,16 +1759,16 @@ subroutine aer_update & endif !> -# Call trop_update() to update monthly tropospheric aerosol data. - if ( lalwflg .or. laswflg ) then + if ( lalwflg .or. laswflg ) then - if ( iaermdl == 0 .or. iaermdl==5 ) then ! opac-climatology scheme + 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. - if ( lavoflg ) then + if ( lavoflg ) then call volc_update endif @@ -2364,7 +2364,7 @@ subroutine setaer & !> -# Compute stratosphere volcanic forcing: !! - select data in 4 lat bands, interpolation at the boundaries -!! - Find lower boundary of stratosphere: polar, fixed at 25000pa +!! - Find lower boundary of stratosphere: polar, fixed at 25000pa !! (250mb); tropic, fixed at 15000pa (150mb); mid-lat, interpolation !! - SW: add volcanic aerosol optical depth to the background value !! - Smoothing profile at boundary if needed @@ -2678,13 +2678,13 @@ 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 General Algorithm +!!\section gel_aer_pro General Algorithm !> @{ !----------------------------------- - subroutine aer_property & + subroutine aer_property & & ( prsi,prsl,prslk,tvly,rhlay,dz,hz,tracer, & ! --- inputs: - & alon,alat,slmsk, laersw,laerlw, & - & IMAX,NLAY,NLP1, & + & alon,alat,slmsk, laersw,laerlw, & + & IMAX,NLAY,NLP1, & & aerosw,aerolw,aerodp & ! --- outputs: & ) @@ -3103,9 +3103,9 @@ subroutine aer_property & contains ! ================= -!> This subroutine computes aerosols optical properties in NSWLWBD +!> 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 +!! troposphere, aerosol distribution at each grid point is composed !! from up to six components out of ten different substances. !-------------------------------- subroutine radclimaer @@ -3415,7 +3415,7 @@ end subroutine aer_property !! 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 +!!\param eirfwv (NWVTIR), IR flux(273k) for each individual wavenumber !! \f$(w/m^2)\f$ !!\param me print message control flag !! @@ -3423,7 +3423,7 @@ end subroutine aer_property !! @{ !----------------------------------- subroutine gocart_aerinit & - & ( solfwv, eirfwv, me & + & ( solfwv, eirfwv, me & & ) ! ================================================================== ! @@ -3459,8 +3459,8 @@ subroutine gocart_aerinit & implicit none ! --- inputs: - real (kind=kind_phys), dimension(:) :: solfwv ! one wvn sol flux - real (kind=kind_phys), dimension(:) :: eirfwv ! one wvn ir flux + real (kind=kind_phys), dimension(:) :: solfwv ! one wvn sol flux + real (kind=kind_phys), dimension(:) :: eirfwv ! one wvn ir flux integer, intent(in) :: me @@ -3489,7 +3489,7 @@ subroutine gocart_aerinit & 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 + real (kind=kind_phys) :: sumsol, sumir, sumsol_du, sumir_du integer :: i, j, k, mb, ib, ii, iix, iw, iw1, iw2 @@ -3564,7 +3564,7 @@ subroutine gocart_aerinit & do while ( iw1 > iendwv(ii) ) if ( ii == kaerbndd ) exit ii = ii + 1 - enddo + enddo sumsol = f_zero nv1(ib) = ii @@ -3572,7 +3572,7 @@ subroutine gocart_aerinit & do while ( iw1 > iendwv_du(iix) ) if ( iix == kaerbndi ) exit iix = iix + 1 - enddo + enddo sumsol_du = f_zero nv1_du(ib) = iix @@ -3643,7 +3643,7 @@ subroutine gocart_aerinit & ! -- for rd-dependent do while ( iw1 > iendwv(ii) ) - if ( ii == kaerbndd ) exit + if ( ii == kaerbndd ) exit ii = ii + 1 enddo sumir = f_zero @@ -3651,7 +3651,7 @@ subroutine gocart_aerinit & ! -- for rd-independent do while ( iw1 > iendwv_du(iix) ) - if ( iix == kaerbndi ) exit + if ( iix == kaerbndi ) exit iix = iix + 1 enddo sumir_du = f_zero @@ -3723,8 +3723,8 @@ subroutine gocart_aerinit & ! print *, ssarhd_grt(i,:,ib) ! print *, ' asyrhd for rhlev:',i ! print *, asyrhd_grt(i,:,ib) -! enddo -! enddo +! enddo +! enddo ! print *, ' wvnlw1 :',wvnlw1 ! print *, ' wvnlw2 :',wvnlw2 ! do ib = 1, NLWBND @@ -3768,7 +3768,7 @@ subroutine rd_gocart_luts ! 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 ! +! 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 ! @@ -3792,7 +3792,7 @@ subroutine rd_gocart_luts ! --- locals: integer :: iradius, ik, ibeg - integer, parameter :: numspc = 5 ! # of aerosol species + integer, parameter :: numspc = 5 ! # of aerosol species ! - input tabulated aerosol optical spectral data from GSFC real, dimension(kaerbndd) :: lambda ! wavelength (m) for non-dust @@ -3920,7 +3920,7 @@ subroutine rd_gocart_luts wavelength(j) = 1.e6 * lambda(i) enddo do k = 1, iradius - ik = ibeg + k - 1 + ik = ibeg + k - 1 do i = 1, kaerbndd ii = kaerbndd -i + 1 do j = 1, krhlev @@ -4008,7 +4008,7 @@ subroutine optavg_gocart !===> ... begin here ! ! --- ... loop for each sw radiation spectral band - + if ( laswflg ) then do nb = 1, nswbnd rsolbd = f_one / solbnd_du(nb) @@ -4175,8 +4175,8 @@ end subroutine gocart_aerinit !!\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 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 @@ -4192,7 +4192,7 @@ end subroutine gocart_aerinit !!\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 +!!\section gel_go_aer_pro General Algorithm !! @{ !----------------------------------- subroutine aer_property_gocart & @@ -4288,7 +4288,7 @@ subroutine aer_property_gocart & lab_do_IMAXg : do i = 1, IMAX ! --- initialize tauae, ssaae, asyae - do m = 1, NSWLWBD + do m = 1, NSWLWBD do k = 1, NLAY tauae(k,m) = f_zero ssaae(k,m) = f_one @@ -4307,17 +4307,17 @@ subroutine aer_property_gocart & spcodp(m) = f_zero enddo - do k = 1, NLAY - rh1(k) = rhlay(i,k) ! + 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) + aerms(k,m) = aerfld(i,k,m)*rho ! dry mass (kg/m3) enddo -! +! ! --- calculate sw/lw aerosol optical properties for the ! corresponding frequency bands @@ -4440,14 +4440,14 @@ subroutine aeropt 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) + 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) @@ -4457,7 +4457,7 @@ subroutine aeropt 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 +! --- update aod from individual species if ( ib==nv_aod ) then spcodp(1) = spcodp(1) + tau endif @@ -4476,7 +4476,7 @@ subroutine aeropt 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) + 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) + & @@ -4493,7 +4493,7 @@ subroutine aeropt 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 +! --- update aod from individual species if ( ib==nv_aod ) then spcodp(ktrc) = spcodp(ktrc) + tau endif From 6dcbd09ddfe2c4af7881f5450e96d5ef1a373713 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Sat, 11 Apr 2020 06:20:49 -0600 Subject: [PATCH 32/44] Bugfix in physics/GFS_surface_composites.F90 when fractional landmask is true --- physics/GFS_surface_composites.F90 | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index b6d833796..7cd552e69 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) From 86cdd35a84c29cdea87883bd624f4366692cd34e Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 13 Apr 2020 08:10:20 -0600 Subject: [PATCH 33/44] physics/GFS_phys_time_vary.scm.F90: bugfix for OpenMP regions; physics/rrtmgp_?w_aerosol_optics.*: pass in aerosol tracer concentrations for MG --- physics/GFS_phys_time_vary.fv3.F90 | 13 ++++++++++--- physics/GFS_phys_time_vary.scm.F90 | 2 +- physics/aerinterp.F90 | 11 +++++++---- physics/rrtmgp_lw_aerosol_optics.F90 | 13 ++++++++----- physics/rrtmgp_lw_aerosol_optics.meta | 17 +++++++++++++++++ physics/rrtmgp_sw_aerosol_optics.F90 | 15 +++++++++------ physics/rrtmgp_sw_aerosol_optics.meta | 19 ++++++++++++++++++- physics/ugwp_driver_v0.F | 20 ++++++++++---------- 8 files changed, 80 insertions(+), 30 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 915b4fd48..6e51e4aa8 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -61,10 +61,14 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e integer :: nb, nblks, nt integer :: i, j, ix logical :: non_uniform_blocks + character(len=len(errmsg)) :: errmsg2 + integer :: errflg2 ! Initialize CCPP error handling variables errmsg = '' errflg = 0 + errmsg2 = '' + errflg2 = 0 if (is_initialized) return @@ -97,7 +101,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e end if !$OMP parallel num_threads(nthrds) default(none) & -!$OMP private (nt,nb) & +!$OMP private (nt,nb,errmsg2,errflg2) & !$OMP shared (Model,Data,Interstitial,errmsg,errflg) & !$OMP shared (levozp,oz_coeff,oz_pres) & !$OMP shared (levh2o,h2o_coeff,h2o_pres) & @@ -167,8 +171,11 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e ! 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,errmsg,errflg) - if (errflg/=0) return + call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate,errmsg2,errflg2) + if (errflg2/=0) then + errflg = max(errflg,errflg2) + errmsg = trim(errmsg) // ' ' // trim(errmsg2) + end if endif else ! Update the value of ntrcaer in aerclm_def with the value defined diff --git a/physics/GFS_phys_time_vary.scm.F90 b/physics/GFS_phys_time_vary.scm.F90 index 01b48f5d7..5fcc9ed84 100644 --- a/physics/GFS_phys_time_vary.scm.F90 +++ b/physics/GFS_phys_time_vary.scm.F90 @@ -111,7 +111,7 @@ subroutine GFS_phys_time_vary_init (Grid, Model, Interstitial, Tbd, errmsg, errf ntrcaer = size(Tbd%aer_nm, dim=3) ! Read aerosol climatology call read_aerdata (Model%me,Model%master,Model%iflip,Model%idate,errmsg,errflg) - if (errflg/=0) return + if (errflg/=0) return endif else ! Update the value of ntrcaer in aerclm_def with the value defined diff --git a/physics/aerinterp.F90 b/physics/aerinterp.F90 index d6bf822f7..9e73ff8c4 100644 --- a/physics/aerinterp.F90 +++ b/physics/aerinterp.F90 @@ -22,8 +22,8 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) !--- in/out integer, intent(in) :: me, master, iflip, idate(4) - character(len=*), intent(inout) :: errmsg - integer, intent(inout) :: errflg + character(len=*), intent(out) :: errmsg + integer, intent(out) :: errflg !--- locals integer :: ncid, varid, ndims, dim1, dim2, dim3, hmx @@ -38,6 +38,9 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) real(kind=kind_io8),allocatable,dimension(:) :: aer_lati real(kind=kind_io8),allocatable,dimension(:) :: aer_loni ! + ! Initialize CCPP error handling variables + errmsg = '' + errflg = 0 !! =================================================================== if (me == master) then if ( iflip == 0 ) then ! data from toa to sfc @@ -53,7 +56,7 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) fname=trim("aeroclim.m"//'01'//".nc") inquire (file = fname, exist = file_exist) if (.not. file_exist) then - errmsg = errmsg // ' error in read_aerdata: file ' // trim(fname) // ' not found' + errmsg = 'Error in read_aerdata: file ' // trim(fname) // ' not found' errflg = 1 return endif @@ -126,7 +129,7 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) fname=trim("aeroclim.m"//mn//".nc") inquire (file = fname, exist = file_exist) if (.not. file_exist) then - errmsg = errmsg // ' error in read_aerdata: file ' // trim(fname) // ' not found' + errmsg = 'Error in read_aerdata: file ' // trim(fname) // ' not found' errflg = 1 return endif diff --git a/physics/rrtmgp_lw_aerosol_optics.F90 b/physics/rrtmgp_lw_aerosol_optics.F90 index eb23ba21a..2047deaf4 100644 --- a/physics/rrtmgp_lw_aerosol_optics.F90 +++ b/physics/rrtmgp_lw_aerosol_optics.F90 @@ -28,9 +28,9 @@ end subroutine rrtmgp_lw_aerosol_optics_init !! \section arg_table_rrtmgp_lw_aerosol_optics_run !! \htmlinclude rrtmgp_lw_aerosol_optics.html !! - subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nTracer, p_lev, p_lay, p_lk, & - tv_lay, relhum, lsmask, tracer, lon, lat, lw_gas_props, sw_gas_props, & - aerodp, lw_optical_props_aerosol, errmsg, errflg) + 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) :: & @@ -38,7 +38,8 @@ subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nTracer, p_lev, p_l integer, intent(in) :: & nCol, & ! Number of horizontal grid points nLev, & ! Number of vertical layers - nTracer ! Number of tracers + nTracer, & ! Number of tracers + nTracerAer ! Number of aerosol tracers real(kind_phys), dimension(nCol), intent(in) :: & lon, & ! Longitude lat, & ! Latitude @@ -50,6 +51,8 @@ subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nTracer, p_lev, p_l 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) :: & @@ -80,7 +83,7 @@ subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nTracer, p_lev, p_l 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, lon, lat, ncol, nLev, & + 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] diff --git a/physics/rrtmgp_lw_aerosol_optics.meta b/physics/rrtmgp_lw_aerosol_optics.meta index ea123e236..305151270 100644 --- a/physics/rrtmgp_lw_aerosol_optics.meta +++ b/physics/rrtmgp_lw_aerosol_optics.meta @@ -33,6 +33,14 @@ 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 @@ -96,6 +104,15 @@ 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 diff --git a/physics/rrtmgp_sw_aerosol_optics.F90 b/physics/rrtmgp_sw_aerosol_optics.F90 index effbfae72..4bb034279 100644 --- a/physics/rrtmgp_sw_aerosol_optics.F90 +++ b/physics/rrtmgp_sw_aerosol_optics.F90 @@ -28,10 +28,10 @@ end subroutine rrtmgp_sw_aerosol_optics_init !! \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, nDay, idxday, p_lev,& - p_lay, p_lk, tv_lay, relhum, lsmask, tracer, lon, lat, lw_gas_props, sw_gas_props, & - aerodp, sw_optical_props_aerosol, errmsg, errflg) - + 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 @@ -39,7 +39,8 @@ subroutine rrtmgp_sw_aerosol_optics_run(doSWrad, nCol, nLev, nTracer, nDay, idxd nCol, & ! Number of horizontal grid points nDay, & ! Number of daylit points nLev, & ! Number of vertical layers - nTracer ! Number of tracers + 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) :: & @@ -53,6 +54,8 @@ subroutine rrtmgp_sw_aerosol_optics_run(doSWrad, nCol, nLev, nTracer, nDay, idxd 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) :: & @@ -84,7 +87,7 @@ subroutine rrtmgp_sw_aerosol_optics_run(doSWrad, nCol, nLev, nTracer, nDay, idxd 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, lon, lat, nCol, nLev, & + 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 diff --git a/physics/rrtmgp_sw_aerosol_optics.meta b/physics/rrtmgp_sw_aerosol_optics.meta index 20240327f..1aaabf4f1 100644 --- a/physics/rrtmgp_sw_aerosol_optics.meta +++ b/physics/rrtmgp_sw_aerosol_optics.meta @@ -33,6 +33,14 @@ 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 @@ -112,6 +120,15 @@ 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 @@ -179,4 +196,4 @@ dimensions = () type = integer intent = out - optional = F \ No newline at end of file + optional = F diff --git a/physics/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index ff6e30b83..4edd84a7a 100644 --- a/physics/ugwp_driver_v0.F +++ b/physics/ugwp_driver_v0.F @@ -1839,16 +1839,16 @@ subroutine fv3_ugwp_solv2_v0(klon, klev, dtime, ! !--------------------------------------------------------------------------- ! -! if (kdt == 1 .and. mpi_id == master) then -! print *, 'vgw done ' -!! -! print *, maxval(pdudt)*86400., minval(pdudt)*86400, 'vgw ax' -! print *, maxval(pdvdt)*86400., minval(pdvdt)*86400, 'vgw ay' -! print *, maxval(dked)*1., minval(dked)*1, 'vgw keddy m2/sec' -! print *, maxval(pdtdt)*86400., minval(pdtdt)*86400,'vgw eps' -!! -!! print *, ' ugwp -heating rates ' -! endif + if (kdt == 1 .and. mpi_id == master) then + print *, 'vgw done ' +! + print *, maxval(pdudt)*86400., minval(pdudt)*86400, 'vgw ax' + print *, maxval(pdvdt)*86400., minval(pdvdt)*86400, 'vgw ay' + print *, maxval(dked)*1., minval(dked)*1, 'vgw keddy m2/sec' + print *, maxval(pdtdt)*86400., minval(pdtdt)*86400,'vgw eps' +! +! print *, ' ugwp -heating rates ' + endif return end subroutine fv3_ugwp_solv2_v0 From 316f464277397ee55cbc8e03e89720c404a2a74a Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 13 Apr 2020 14:33:24 -0600 Subject: [PATCH 34/44] physics/GFS_phys_time_vary.fv3.F90, physics/aerinterp.F90: bugfix for use of CCPP error handling variables in OpenMP threaded environments --- physics/GFS_phys_time_vary.fv3.F90 | 13 ++----------- physics/aerinterp.F90 | 7 ++----- 2 files changed, 4 insertions(+), 16 deletions(-) diff --git a/physics/GFS_phys_time_vary.fv3.F90 b/physics/GFS_phys_time_vary.fv3.F90 index 6e51e4aa8..bed8e14e1 100644 --- a/physics/GFS_phys_time_vary.fv3.F90 +++ b/physics/GFS_phys_time_vary.fv3.F90 @@ -61,14 +61,9 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e integer :: nb, nblks, nt integer :: i, j, ix logical :: non_uniform_blocks - character(len=len(errmsg)) :: errmsg2 - integer :: errflg2 - ! Initialize CCPP error handling variables errmsg = '' errflg = 0 - errmsg2 = '' - errflg2 = 0 if (is_initialized) return @@ -101,7 +96,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e end if !$OMP parallel num_threads(nthrds) default(none) & -!$OMP private (nt,nb,errmsg2,errflg2) & +!$OMP private (nt,nb) & !$OMP shared (Model,Data,Interstitial,errmsg,errflg) & !$OMP shared (levozp,oz_coeff,oz_pres) & !$OMP shared (levh2o,h2o_coeff,h2o_pres) & @@ -171,11 +166,7 @@ subroutine GFS_phys_time_vary_init (Data, Model, Interstitial, nthrds, errmsg, e ! 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,errmsg2,errflg2) - if (errflg2/=0) then - errflg = max(errflg,errflg2) - errmsg = trim(errmsg) // ' ' // trim(errmsg2) - end if + 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 diff --git a/physics/aerinterp.F90 b/physics/aerinterp.F90 index 9e73ff8c4..e7cd6ca20 100644 --- a/physics/aerinterp.F90 +++ b/physics/aerinterp.F90 @@ -22,8 +22,8 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) !--- in/out integer, intent(in) :: me, master, iflip, idate(4) - character(len=*), intent(out) :: errmsg - integer, intent(out) :: errflg + character(len=*), intent(inout) :: errmsg + integer, intent(inout) :: errflg !--- locals integer :: ncid, varid, ndims, dim1, dim2, dim3, hmx @@ -38,9 +38,6 @@ SUBROUTINE read_aerdata (me, master, iflip, idate, errmsg, errflg) real(kind=kind_io8),allocatable,dimension(:) :: aer_lati real(kind=kind_io8),allocatable,dimension(:) :: aer_loni ! - ! Initialize CCPP error handling variables - errmsg = '' - errflg = 0 !! =================================================================== if (me == master) then if ( iflip == 0 ) then ! data from toa to sfc From 0472bef58e667fd87b44bcb7753eaef2aae89712 Mon Sep 17 00:00:00 2001 From: "Jun.Wang" Date: Sat, 18 Apr 2020 03:44:41 +0000 Subject: [PATCH 35/44] add chsp changes from Jongil Han Co-authored-by: Jongil Han --- physics/module_sf_noahmplsm.f90 | 79 ++++++++--------------- physics/satmedmfvdifq.F | 4 +- physics/sfc_diff.f | 24 ++++--- physics/sfc_noahmp_drv.f | 32 +++------- physics/sfc_noahmp_drv.meta | 8 --- physics/sflx.f | 108 ++++++++++++++++---------------- 6 files changed, 106 insertions(+), 149 deletions(-) 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/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 30e195cde..d465b7c5e 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -212,7 +212,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) @@ -222,7 +222,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/sfc_diff.f b/physics/sfc_diff.f index 60d5ceeea..3427fbb75 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(i,1)*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(i,1)*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..770a9d56e 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,7 @@ 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 ! ! ! ! input/outputs from and to the calling program: ! ! cmc - real, canopy moisture content 1 ! @@ -1393,6 +1374,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 @@ -1632,7 +1615,7 @@ 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) @@ -1662,7 +1645,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 +2319,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 +2379,7 @@ 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 ! ! ! ! input/outputs from and to the calling program: ! ! prcp1 - real, effective precip 1 ! @@ -2442,6 +2426,7 @@ 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 +2743,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 +3264,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 +3299,8 @@ 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 ! ! ! ! input/outputs: ! ! stc - real, soil temp nsoil ! @@ -3332,7 +3321,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 +3379,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 +4046,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 +4083,8 @@ 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 ! ! ! ! input/outputs: ! ! sh2o - real, unfrozen soil moisture nsoil ! @@ -4110,6 +4104,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 +4127,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 +4224,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 +4270,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 +4318,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 +4378,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 +4793,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 +4838,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 +4851,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 ! From 0e0c20ef41b0308189a92ca5832a8441b2e2659a Mon Sep 17 00:00:00 2001 From: "Jun.Wang" Date: Mon, 20 Apr 2020 02:49:57 +0000 Subject: [PATCH 36/44] fix ustar --- physics/sfc_diff.f | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 3427fbb75..4312796e9 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -228,7 +228,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! czilc = 10.0 ** (- 4. * z0max) ! Trier et al. (2011, WAF) ztmax = z0max * exp( - czilc * ca - & * 258.2 * sqrt(ustar(i,1)*z0max) ) + & * 258.2 * sqrt(ustar_lnd(i,1)*z0max) ) ! mg, sfc-perts: add surface perturbations to ztmax/z0max ratio over land @@ -272,7 +272,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! & * 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(i,1)*z0max) ) + & * 258.2 * sqrt(ustar_ice(i,1)*z0max) ) ztmax = max(ztmax, 1.0e-6) ! From 69d3298764a4089028835475a7bcf8bcdcfcca56 Mon Sep 17 00:00:00 2001 From: "Jun.Wang" Date: Mon, 20 Apr 2020 03:48:34 +0000 Subject: [PATCH 37/44] fix syntax error in ccpp --- physics/sfc_diff.f | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/sfc_diff.f b/physics/sfc_diff.f index 4312796e9..c2ebf8257 100644 --- a/physics/sfc_diff.f +++ b/physics/sfc_diff.f @@ -228,7 +228,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! czilc = 10.0 ** (- 4. * z0max) ! Trier et al. (2011, WAF) ztmax = z0max * exp( - czilc * ca - & * 258.2 * sqrt(ustar_lnd(i,1)*z0max) ) + & * 258.2 * sqrt(ustar_lnd(i)*z0max) ) ! mg, sfc-perts: add surface perturbations to ztmax/z0max ratio over land @@ -272,7 +272,7 @@ subroutine sfc_diff_run (im,rvrdm1,eps,epsm1,grav, & !intent(in) ! & * 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,1)*z0max) ) + & * 258.2 * sqrt(ustar_ice(i)*z0max) ) ztmax = max(ztmax, 1.0e-6) ! From a66d980301d4e62dd9c92f31a3bd92b8ed0939ea Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Mon, 20 Apr 2020 09:53:54 -0600 Subject: [PATCH 38/44] Remove CCPP dynamic build from physics --- CMakeLists.txt | 53 ++++++---------------------- pgifix.py | 93 -------------------------------------------------- 2 files changed, 11 insertions(+), 135 deletions(-) delete mode 100755 pgifix.py diff --git a/CMakeLists.txt b/CMakeLists.txt index 9765fa25e..7bd357d46 100644 --- a/CMakeLists.txt +++ b/CMakeLists.txt @@ -19,7 +19,7 @@ endif(POLICY CMP0042) #------------------------------------------------------------------------------ set(PACKAGE "ccpp-physics") -set(AUTHORS "Grant J. Firl" "Dom Heinzeller") +set(AUTHORS "Grant Firl" "Dom Heinzeller" "Man Zhang" "Laurie Carson") #------------------------------------------------------------------------------ # Set OpenMP flags for C/C++/Fortran @@ -58,12 +58,8 @@ 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) #------------------------------------------------------------------------------ # Set the sources: physics type definitions @@ -327,45 +323,18 @@ elseif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "PGI") endif (${CMAKE_Fortran_COMPILER_ID} STREQUAL "GNU") #------------------------------------------------------------------------------ -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 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() From fc840f4f0fa9d7c37ee88dc1c8940121d93cd5e6 Mon Sep 17 00:00:00 2001 From: "Jun.Wang" Date: Tue, 21 Apr 2020 02:49:55 +0000 Subject: [PATCH 39/44] update sflx.f --- physics/sflx.f | 21 ++++++++++++++------- 1 file changed, 14 insertions(+), 7 deletions(-) diff --git a/physics/sflx.f b/physics/sflx.f index 770a9d56e..a0127d844 100644 --- a/physics/sflx.f +++ b/physics/sflx.f @@ -677,7 +677,7 @@ subroutine gfssflx &! --- input ! !jhan urban canopy heat storage effect is included in pbl scheme ! - if((.not.lheatstrg) .and. & + if((.not.lheatstrg) .and. & & (ivegsrc == 1 .and. vegtyp == 13)) then df1 = 3.24*(1.-shdfac) + shdfac*df1*exp(sbeta*shdfac) else @@ -1337,6 +1337,7 @@ subroutine nopac ! 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 ! @@ -1505,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 ) @@ -1522,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: @@ -1550,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 & ! & ) @@ -1576,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 ! @@ -1619,7 +1623,7 @@ subroutine penman 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. @@ -2379,7 +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 ! +! lheatstrg- logical, flag for canopy heat storage 1 ! +! parameterization ! ! ! ! input/outputs from and to the calling program: ! ! prcp1 - real, effective precip 1 ! @@ -3301,6 +3306,7 @@ subroutine shflx & ! 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 ! @@ -4085,6 +4091,7 @@ subroutine hrt & ! 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 ! From 8c47bbf44964df570d0f999f670d8d5dd424a741 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Tue, 21 Apr 2020 16:41:05 -0600 Subject: [PATCH 40/44] Add missing code updates from IPD GFS_physics_driver.F90 to CCPP --- physics/GFS_PBL_generic.F90 | 66 +++++++++++++-- physics/GFS_PBL_generic.meta | 125 ++++++++++++++++++++++++++++ physics/gcm_shoc.meta | 4 +- physics/module_MYJPBL_wrapper.meta | 4 +- physics/module_MYNNPBL_wrapper.meta | 4 +- physics/moninedmf.meta | 4 +- physics/moninedmf_hafs.meta | 4 +- physics/moninshoc.meta | 4 +- physics/satmedmfvdif.meta | 4 +- physics/satmedmfvdifq.meta | 4 +- physics/sflx.f | 2 + physics/shalcnv.meta | 4 +- physics/shinhongvdif.meta | 4 +- physics/ysuvdif.meta | 4 +- 14 files changed, 206 insertions(+), 31 deletions(-) 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 5f4362103..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 @@ -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/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/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 27b186bd3..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) diff --git a/physics/moninedmf.meta b/physics/moninedmf.meta index 25fddea02..09abe71a0 100644 --- a/physics/moninedmf.meta +++ b/physics/moninedmf.meta @@ -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 13bf39396..d600c8eac 100644 --- a/physics/moninedmf_hafs.meta +++ b/physics/moninedmf_hafs.meta @@ -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/satmedmfvdif.meta b/physics/satmedmfvdif.meta index e127f14e5..c33e4b85f 100644 --- a/physics/satmedmfvdif.meta +++ b/physics/satmedmfvdif.meta @@ -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.meta b/physics/satmedmfvdifq.meta index 4e9b05239..26667a627 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -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/sflx.f b/physics/sflx.f index a0127d844..2740a70ff 100644 --- a/physics/sflx.f +++ b/physics/sflx.f @@ -2431,7 +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, & 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/ysuvdif.meta b/physics/ysuvdif.meta index 12819dee5..fe18e6f45 100644 --- a/physics/ysuvdif.meta +++ b/physics/ysuvdif.meta @@ -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) From f57b5c340aac31ab51bd746656e7fca28a950bb1 Mon Sep 17 00:00:00 2001 From: "Jun.Wang" Date: Fri, 24 Apr 2020 20:43:22 +0000 Subject: [PATCH 41/44] add tsfcl change for CCPP --- physics/GFS_surface_composites.F90 | 2 ++ physics/ugwp_driver_v0.F | 21 +++++++++++---------- 2 files changed, 13 insertions(+), 10 deletions(-) diff --git a/physics/GFS_surface_composites.F90 b/physics/GFS_surface_composites.F90 index 7cd552e69..30067976e 100644 --- a/physics/GFS_surface_composites.F90 +++ b/physics/GFS_surface_composites.F90 @@ -441,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) @@ -482,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/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index 4edd84a7a..866689f03 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 debugprint = .false. end module sso_coorde ! ! @@ -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 ' @@ -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' @@ -1411,7 +1412,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 +1840,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 +1973,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) From 366404d1b3f10e3f7df4defd8b5e5e97634335ef Mon Sep 17 00:00:00 2001 From: "Jun.Wang" Date: Sat, 25 Apr 2020 19:58:26 +0000 Subject: [PATCH 42/44] fix synrax error --- physics/ugwp_driver_v0.F | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/physics/ugwp_driver_v0.F b/physics/ugwp_driver_v0.F index 866689f03..6dd03534a 100644 --- a/physics/ugwp_driver_v0.F +++ b/physics/ugwp_driver_v0.F @@ -8,7 +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 debugprint = .false. + logical,parameter :: debugprint = .false. end module sso_coorde ! ! @@ -34,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 @@ -298,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' @@ -1287,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 From ef386967e9cab4a672be603f52a51704f538d226 Mon Sep 17 00:00:00 2001 From: "Man.Zhang" Date: Fri, 8 May 2020 10:59:14 -0600 Subject: [PATCH 43/44] add force_read_ferhires capability in FA --- physics/module_MP_FER_HIRES.F90 | 148 ++++++++++++++++++++++---------- physics/mp_fer_hires.F90 | 28 ++++-- physics/mp_fer_hires.meta | 18 ++++ 3 files changed, 145 insertions(+), 49 deletions(-) diff --git a/physics/module_MP_FER_HIRES.F90 b/physics/module_MP_FER_HIRES.F90 index c758f7951..776898f93 100644 --- a/physics/module_MP_FER_HIRES.F90 +++ b/physics/module_MP_FER_HIRES.F90 @@ -148,23 +148,23 @@ MODULE MODULE_MP_FER_HIRES INTEGER, PRIVATE,PARAMETER :: MY_T1=1, MY_T2=35 REAL,PRIVATE,DIMENSION(MY_T1:MY_T2),SAVE :: MY_GROWTH_NMM ! - REAL, PRIVATE,PARAMETER :: DMImin=.05e-3, DMImax=1.e-3, & + REAL, PRIVATE,PARAMETER :: DMImin=.05e-3, DMImax=1.e-3, & & DelDMI=1.e-6,XMImin=1.e6*DMImin REAL, PUBLIC,PARAMETER :: XMImax=1.e6*DMImax, XMIexp=.0536 INTEGER, PUBLIC,PARAMETER :: MDImin=XMImin, MDImax=XMImax - REAL, PRIVATE,DIMENSION(MDImin:MDImax) :: & + REAL, ALLOCATABLE, DIMENSION(:) :: & & ACCRI,VSNOWI,VENTI1,VENTI2 REAL, PUBLIC,DIMENSION(MDImin:MDImax) :: SDENS !-- For RRTM ! - REAL, PRIVATE,PARAMETER :: DMRmin=.05e-3, DMRmax=1.0e-3, & + REAL, PRIVATE,PARAMETER :: DMRmin=.05e-3, DMRmax=1.0e-3, & & DelDMR=1.e-6, XMRmin=1.e6*DMRmin, XMRmax=1.e6*DMRmax INTEGER, PUBLIC,PARAMETER :: MDRmin=XMRmin, MDRmax=XMRmax ! - REAL, PRIVATE,DIMENSION(MDRmin:MDRmax):: & + REAL, ALLOCATABLE, DIMENSION(:):: & & ACCRR,MASSR,RRATE,VRAIN,VENTR1,VENTR2 ! INTEGER, PRIVATE,PARAMETER :: Nrime=40 - REAL, DIMENSION(2:9,0:Nrime),PRIVATE,SAVE :: VEL_RF + REAL, ALLOCATABLE, DIMENSION(:,:) :: VEL_RF ! INTEGER,PARAMETER :: NX=7501 REAL, PARAMETER :: XMIN=180.0,XMAX=330.0 @@ -226,7 +226,7 @@ MODULE MODULE_MP_FER_HIRES !HWRF & ,NCW=300.E6 !- 100.e6 (maritime), 500.e6 (continental) !--- Other public variables passed to other routines: - REAL, PUBLIC,DIMENSION(MDImin:MDImax) :: MASSI + REAL, ALLOCATABLE ,DIMENSION(:) :: MASSI ! CONTAINS @@ -449,8 +449,9 @@ SUBROUTINE FER_HIRES (DT,RHgrd, & !GFDL => New. Added RHC_col to allow for height- and grid-dependent values for !GFDL the relative humidity threshold for condensation ("RHgrd") !6/11/2010 mod - Use lower RHgrd_out threshold for < 850 hPa +!mz 05/06/2020 - 10km !------------------------------------------------------------ - IF(DX1 .GE. 10 .AND. P_col(L) \section arg_table_mp_fer_hires_finalize Argument Table !! - subroutine mp_fer_hires_finalize () + subroutine mp_fer_hires_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 + + call ferhires_finalize() + + is_initialized = .false. + + end subroutine mp_fer_hires_finalize end module mp_fer_hires diff --git a/physics/mp_fer_hires.meta b/physics/mp_fer_hires.meta index a7a33378a..1782aecf6 100644 --- a/physics/mp_fer_hires.meta +++ b/physics/mp_fer_hires.meta @@ -130,6 +130,24 @@ [ccpp-arg-table] name = mp_fer_hires_finalize type = scheme + +[errmsg] + standard_name = ccpp_error_message + long_name = error message for error handling in CCPP + units = none + dimensions = () + type = character + kind = len=* + intent = out + optional = F +[errflg] + standard_name = ccpp_error_flag + long_name = error flag for error handling in CCPP + units = flag + dimensions = () + type = integer + intent = out + optional = F ######################################################################## [ccpp-arg-table] name = mp_fer_hires_run From d9c5e06bddb2ad529f169b34248a6054a46abf26 Mon Sep 17 00:00:00 2001 From: Dom Heinzeller Date: Fri, 15 May 2020 14:46:12 -0600 Subject: [PATCH 44/44] Update GFS_rrtmgp_pre.F90 with progcld changes, update GFS_rrtmgp_setup.meta with standard name changes --- physics/GFS_rrtmgp_pre.F90 | 44 ++++++++++++++++++++++++++++++++--- physics/GFS_rrtmgp_setup.meta | 16 ++++++------- 2 files changed, 49 insertions(+), 11 deletions(-) diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 1344f269c..0835f9e9b 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -37,7 +37,8 @@ module GFS_rrtmgp_pre progcld1, & ! Zhao/Moorthi's prognostic cloud scheme progcld3, & ! Zhao/Moorthi's prognostic cloud+pdfcld progcld4, & ! GFDL cloud scheme - progcld5, & ! Thompson / WSM6 cloud micrphysics scheme + progcld5, & ! Ferrier Aligo microphysics scheme + progcld6, & ! Thompson cloud microphysics scheme progclduni ! Unified cloud-scheme use surface_perturbation, only: & cdfnor ! Routine to compute CDF (used to compute percentiles) @@ -740,10 +741,47 @@ subroutine cloud_microphysics(Model, Tbd, Grid, Sfcprop, ncol, tracer, p_lay, t_ 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 + ! *) Ferrier-Aligo cloud microphysics scheme + elseif(Model%imp_physics == 15) 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) + 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) + 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 + NCOL, & ! IN - Number of horizontal gridpoints + MODEL%LEVS, & ! IN - Number of model layers + MODEL%LEVS+1, & ! IN - Number of model levels + Model%icloud, & ! IN - cloud effect to the optical depth and cloud fraction in radiation + 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) + ! *) Thompson cloud microphysics scheme + elseif(Model%imp_physics == 8) then + + call progcld6 ( & ! 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) diff --git a/physics/GFS_rrtmgp_setup.meta b/physics/GFS_rrtmgp_setup.meta index e40ad865a..e419c7252 100644 --- a/physics/GFS_rrtmgp_setup.meta +++ b/physics/GFS_rrtmgp_setup.meta @@ -99,32 +99,32 @@ intent = in optional = F [iovr_sw] - standard_name = flag_for_max_random_overlap_clouds_for_shortwave_radiation - long_name = sw: max-random overlap clouds + standard_name = flag_for_cloud_overlapping_method_for_shortwave_radiation + long_name = control flag for cloud overlapping method for SW 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 + standard_name = flag_for_cloud_overlapping_method_for_longwave_radiation + long_name = control flag for cloud overlapping method for LW 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 + standard_name = flag_for_sw_clouds_grid_approximation + long_name = flag for sw clouds 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 + standard_name = flag_for_lw_clouds_sub_grid_approximation + long_name = flag for lw clouds sub-grid approximation units = flag dimensions = () type = integer