From f63c8a3c4a83733b5a8fd8ef81e2199ed2b62565 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 3 Nov 2021 15:10:03 +0000 Subject: [PATCH 01/11] Some cleanup for P8. --- physics/GFS_rrtmgp_cloud_overlap_pre.F90 | 35 +++++++++--------- physics/GFS_rrtmgp_lw_post.F90 | 9 ++++- physics/GFS_rrtmgp_lw_post.meta | 9 +++++ physics/GFS_rrtmgp_pre.F90 | 11 ++++-- physics/GFS_rrtmgp_pre.meta | 2 +- physics/GFS_rrtmgp_sw_post.F90 | 40 ++++++++++---------- physics/GFS_rrtmgp_sw_post.meta | 4 +- physics/GFS_rrtmgp_sw_pre.F90 | 39 +++++++++++--------- physics/GFS_rrtmgp_sw_pre.meta | 47 +++++++++++++++++++----- physics/dcyc2.meta | 4 +- physics/rrtmgp_lw_cloud_sampling.meta | 2 +- physics/rrtmgp_lw_pre.meta | 2 +- physics/rrtmgp_lw_rte.F90 | 11 +++++- physics/rrtmgp_lw_rte.meta | 18 +++++++++ physics/rrtmgp_sw_cloud_optics.meta | 2 +- physics/rrtmgp_sw_cloud_sampling.meta | 2 +- physics/rrtmgp_sw_gas_optics.F90 | 8 +--- physics/rrtmgp_sw_gas_optics.meta | 24 ------------ physics/rrtmgp_sw_rte.meta | 4 +- 19 files changed, 160 insertions(+), 113 deletions(-) diff --git a/physics/GFS_rrtmgp_cloud_overlap_pre.F90 b/physics/GFS_rrtmgp_cloud_overlap_pre.F90 index edd3aab93..b300228c4 100644 --- a/physics/GFS_rrtmgp_cloud_overlap_pre.F90 +++ b/physics/GFS_rrtmgp_cloud_overlap_pre.F90 @@ -83,8 +83,7 @@ subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWra errflg = 0 if (.not. (doSWrad .or. doLWrad)) return - - ! What is vertical ordering? + ! What is vertical ordering? top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) if (top_at_1) then iSFC = nLev @@ -94,27 +93,27 @@ subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWra iTOA = nLev endif - ! - ! Compute layer-thickness between layer boundaries (deltaZ) and layer centers (deltaZc) - ! + ! + ! Compute layer-thickness between layer boundaries (deltaZ) and layer centers (deltaZc) + ! do iCol=1,nCol if (top_at_1) then - ! Layer thickness (km) + ! Layer thickness (km) do iLay=1,nLev deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) * tv_lay(iCol,iLay) enddo - ! Height at layer boundaries + ! Height at layer boundaries hgtb(nLev+1) = 0._kind_phys do iLay=nLev,1,-1 hgtb(iLay)= hgtb(iLay+1) + deltaZ(iCol,iLay) enddo - ! Height at layer centers + ! Height at layer centers do iLay = nLev, 1, -1 pfac = abs(log(p_lev(iCol,iLay+1)) - log(p_lay(iCol,iLay))) / & abs(log(p_lev(iCol,iLay+1)) - log(p_lev(iCol,iLay))) hgtc(iLay) = hgtb(iLay+1) + pfac * (hgtb(iLay) - hgtb(iLay+1)) enddo - ! Layer thickness between centers + ! Layer thickness between centers do iLay = nLev-1, 1, -1 deltaZc(iCol,iLay) = hgtc(iLay) - hgtc(iLay+1) enddo @@ -123,18 +122,18 @@ subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWra do iLay=nLev,1,-1 deltaZ(iCol,iLay) = ((con_rd/con_g)*0.001) * abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) * tv_lay(iCol,iLay) enddo - ! Height at layer boundaries + ! Height at layer boundaries hgtb(1) = 0._kind_phys do iLay=1,nLev hgtb(iLay+1)= hgtb(iLay) + deltaZ(iCol,iLay) enddo - ! Height at layer centers + ! Height at layer centers do iLay = 1, nLev pfac = abs(log(p_lev(iCol,iLay)) - log(p_lay(iCol,iLay) )) / & abs(log(p_lev(iCol,iLay)) - log(p_lev(iCol,iLay+1))) hgtc(iLay) = hgtb(iLay) + pfac * (hgtb(iLay+1) - hgtb(iLay)) enddo - ! Layer thickness between centers + ! Layer thickness between centers do iLay = 2, nLev deltaZc(iCol,iLay) = hgtc(iLay) - hgtc(iLay-1) enddo @@ -142,9 +141,9 @@ subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWra endif enddo - ! - ! Cloud decorrelation length - ! + ! + ! Cloud decorrelation length + ! if (idcor == idcor_hogan) then call cmp_dcorr_lgth(nCol, lat, con_pi, de_lgth) endif @@ -165,9 +164,9 @@ subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWra cloud_overlap_param(:,:) = 0. endif - ! For exponential random overlap... - ! Decorrelate layers when a clear layer follows a cloudy layer to enforce - ! random correlation between non-adjacent blocks of cloudy layers + ! For exponential random overlap... + ! Decorrelate layers when a clear layer follows a cloudy layer to enforce + ! random correlation between non-adjacent blocks of cloudy layers if (iovr == iovr_exprand) then do iLay = 1, nLev do iCol = 1, nCol diff --git a/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90 index ff0346fe4..28bb25cae 100644 --- a/physics/GFS_rrtmgp_lw_post.F90 +++ b/physics/GFS_rrtmgp_lw_post.F90 @@ -27,7 +27,8 @@ end subroutine GFS_rrtmgp_lw_post_init subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag, fhlwr, & p_lev, t_lay, tsfa, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, & fluxlwDOWN_clrsky, raddt, aerodp, cldsa, mtopa, mbota, cld_frac, cldtaulw, fluxr, & - sfcdlw, sfculw, sfcflw, tsflw, htrlw, topflw, flxprf_lw, htrlwc, errmsg, errflg) + sfcdlw, sfculw, sfcflw, tsflw, htrlw, htrlwu, topflw, flxprf_lw, htrlwc, errmsg, & + errflg) ! Inputs integer, intent(in) :: & @@ -72,7 +73,8 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag type(sfcflw_type), dimension(nCol), intent(inout) :: & sfcflw ! LW radiation fluxes at sfc real(kind_phys), dimension(nCol,nLev), intent(inout) :: & - htrlw ! LW all-sky heating rate + htrlw, & ! LW all-sky heating rate + htrlwu ! Heating-rate updated in-between radiation calls. type(topflw_type), dimension(nCol), intent(out) :: & topflw ! lw_fluxes_top_atmosphere character(len=*), intent(out) :: & @@ -163,6 +165,9 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag sfcdlw(:) = sfcflw(:)%dnfxc sfculw(:) = sfcflw(:)%upfxc + ! Heating-rate at radiation timestep, used for adjustment between radiation calls. + htrlwu = htrlw + ! ####################################################################################### ! Save LW diagnostics ! - For time averaged output quantities (including total-sky and clear-sky SW and LW diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta index 5fb4d57bb..0ac3bf322 100644 --- a/physics/GFS_rrtmgp_lw_post.meta +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -233,6 +233,15 @@ kind = kind_phys intent = inout optional = F +[htrlwu] + standard_name = updated_tendency_of_air_temperature_due_to_longwave_heating_on_physics_timestep + long_name = total sky longwave heating rate on physics time step + units = K s-1 + dimensions = (horizontal_loop_extent,vertical_layer_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [topflw] standard_name = lw_fluxes_top_atmosphere long_name = lw radiation fluxes at top diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 2f41321bd..00295f244 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -9,7 +9,7 @@ module GFS_rrtmgp_pre getozn ! Routine to setup ozone ! RRTMGP types use mo_gas_concentrations, only: ty_gas_concs - use radiation_tools, only: check_error_msg,cmp_tlev + use radiation_tools, only: check_error_msg,cmp_tlev real(kind_phys), parameter :: & amd = 28.9644_kind_phys, & ! Molecular weight of dry-air (g/mol) @@ -131,9 +131,9 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f prsl, & ! Pressure at model-layer centers (Pa) tgrs, & ! Temperature at model-layer centers (K) prslk ! Exner function at model layer centers (1) - real(kind_phys), dimension(nCol,nLev+1) :: & + real(kind_phys), dimension(nCol,nLev+1), intent(in) :: & prsi ! Pressure at model-interfaces (Pa) - real(kind_phys), dimension(nCol,nLev,nTracers) :: & + real(kind_phys), dimension(nCol,nLev,nTracers), intent(in) :: & qgrs ! Tracer concentrations (kg/kg) ! Outputs @@ -202,7 +202,7 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f p_lev(1:NCOL,:) = prsi(1:NCOL,:) ! Pressure at layer-center - p_lay(1:NCOL,:) = prsl(1:NCOL,:) + p_lay(1:NCOL,:) = prsl(1:NCOL,:) ! Temperature at layer-center t_lay(1:NCOL,:) = tgrs(1:NCOL,:) @@ -274,7 +274,10 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f 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.) + print*,"istr: ",istr_o2,istr_co2,istr_ch4,istr_n2o,istr_h2o,istr_o3 ! Populate RRTMGP DDT w/ gas-concentrations + gas_concentrations%ncol = nCol + gas_concentrations%nlay = nLev gas_concentrations%gas_name(:) = active_gases_array(:) gas_concentrations%concs(istr_o2)%conc(:,:) = gas_vmr(:,:,4) gas_concentrations%concs(istr_co2)%conc(:,:) = gas_vmr(:,:,1) diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 92c06c45c..bbd278f98 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_rrtmgp_pre type = scheme - dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,physcons.F90,physparam.f,radcons.f90,radiation_aerosols.f + dependencies = funcphys.f90,iounitdef.f,machine.F,module_bfmicrophysics.f,physcons.F90,radcons.f90,radiation_aerosols.f dependencies = radiation_astronomy.f,radiation_clouds.f,radiation_gases.f,radiation_tools.F90,rrtmg_lw_cloud_optics.F90 ######################################################################## diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 index 23a681826..8c1804eb9 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -197,27 +197,28 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky ! Surface down and up spectral component fluxes ! - Save two spectral bands' surface downward and upward fluxes for output. - if (l_scmpsw) then - do i=1,nCol - nirbmdi(i) = scmpsw(i)%nirbm - nirdfdi(i) = scmpsw(i)%nirdf - visbmdi(i) = scmpsw(i)%visbm - visdfdi(i) = scmpsw(i)%visdf - nirbmui(i) = scmpsw(i)%nirbm * sfc_alb_nir_dir(1,i) - nirdfui(i) = scmpsw(i)%nirdf * sfc_alb_nir_dif(1,i) - visbmui(i) = scmpsw(i)%visbm * sfc_alb_uvvis_dir(1,i) - visdfui(i) = scmpsw(i)%visdf * sfc_alb_uvvis_dif(1,i) + if (l_scmpsw) then + do i=1,nCol + nirbmdi(i) = scmpsw(i)%nirbm + nirdfdi(i) = scmpsw(i)%nirdf + visbmdi(i) = scmpsw(i)%visbm + visdfdi(i) = scmpsw(i)%visdf + nirbmui(i) = scmpsw(i)%nirbm * sfc_alb_nir_dir(1,i) + nirdfui(i) = scmpsw(i)%nirdf * sfc_alb_nir_dif(1,i) + visbmui(i) = scmpsw(i)%visbm * sfc_alb_uvvis_dir(1,i) + visdfui(i) = scmpsw(i)%visdf * sfc_alb_uvvis_dif(1,i) enddo else - nirbmdi(:) = 0.0 - nirdfdi(:) = 0.0 - visbmdi(:) = 0.0 - visdfdi(:) = 0.0 - nirbmui(:) = 0.0 - nirdfui(:) = 0.0 - visbmui(:) = 0.0 - visdfui(:) = 0.0 - endif + scmpsw = cmpfsw_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) + nirbmdi(:) = 0.0 + nirdfdi(:) = 0.0 + visbmdi(:) = 0.0 + visdfdi(:) = 0.0 + nirbmui(:) = 0.0 + nirdfui(:) = 0.0 + visbmui(:) = 0.0 + visdfui(:) = 0.0 + endif else ! if_nday_block ! ####################################################################################### ! Dark everywhere @@ -225,6 +226,7 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky htrsw(:,:) = 0.0 sfcfsw = sfcfsw_type( 0.0, 0.0, 0.0, 0.0 ) topfsw = topfsw_type( 0.0, 0.0, 0.0 ) + scmpsw = cmpfsw_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) nirbmdi(:) = 0.0 nirdfdi(:) = 0.0 visbmdi(:) = 0.0 diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta index d9bdc47cd..4f6861696 100644 --- a/physics/GFS_rrtmgp_sw_post.meta +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -128,7 +128,7 @@ intent = in optional = F [sfc_alb_uvvis_dir] - standard_name = surface_albedo_uvvis_dir + standard_name = surface_albedo_uvvis_direct long_name = UVVIS (direct) surface albedo (sfc_alb_uvvis_dir) units = none dimensions = (number_of_shortwave_bands,horizontal_loop_extent) @@ -137,7 +137,7 @@ intent = in optional = F [sfc_alb_uvvis_dif] - standard_name = surface_albedo_uvvis_dif + standard_name = surface_albedo_uvvis_diffuse long_name = UVVIS (diffuse) surface albedo (sfc_alb_uvvis_dif) units = none dimensions = (number_of_shortwave_bands,horizontal_loop_extent) diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 index 19f211d7f..b11542cd6 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -23,8 +23,9 @@ end subroutine GFS_rrtmgp_sw_pre_init !! \htmlinclude GFS_rrtmgp_sw_pre.html !! subroutine GFS_rrtmgp_sw_pre_run(me, nCol, doSWrad, solhr, lon, coslat, sinlat, & - nday, idxday, coszen, coszdg, sfcalb, sfc_alb_nir_dir, sfc_alb_nir_dif, & - sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, errmsg, errflg) + nday, idxday, coszen, coszdg, sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, & + sfc_alb_uvvis_dif, sfc_alb_nir_dir_byband, sfc_alb_nir_dif_byband, & + sfc_alb_uvvis_dir_byband, sfc_alb_uvvis_dif_byband, errmsg, errflg) ! Input integer, intent(in) :: & @@ -40,7 +41,11 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, doSWrad, solhr, lon, coslat, sinlat, coslat, & ! Cosine(latitude) sinlat ! Sine(latitude) - real(kind_phys), dimension(:,:), intent(in) :: sfcalb + real(kind_phys), dimension(:), intent(in) :: & + sfc_alb_nir_dir, & ! + sfc_alb_nir_dif, & ! + sfc_alb_uvvis_dir, & ! + sfc_alb_uvvis_dif ! ! Outputs integer, intent(out) :: & @@ -51,10 +56,10 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, doSWrad, solhr, lon, coslat, sinlat, coszen, & ! Cosine of SZA coszdg ! Cosine of SZA, daytime real(kind_phys), dimension(:,:), 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) + sfc_alb_nir_dir_byband, & ! Surface albedo (direct) + sfc_alb_nir_dif_byband, & ! Surface albedo (diffuse) + sfc_alb_uvvis_dir_byband, & ! Surface albedo (direct) + sfc_alb_uvvis_dif_byband ! Surface albedo (diffuse) character(len=*), intent(out) :: & errmsg ! Error message integer, intent(out) :: & @@ -88,18 +93,18 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, doSWrad, solhr, lon, coslat, sinlat, ! 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) + sfc_alb_nir_dir_byband(iBand,1:nCol) = sfc_alb_nir_dir(1:nCol) + sfc_alb_nir_dif_byband(iBand,1:nCol) = sfc_alb_nir_dif(1:nCol) + sfc_alb_uvvis_dir_byband(iBand,1:nCol) = sfc_alb_uvvis_dir(1:nCol) + sfc_alb_uvvis_dif_byband(iBand,1:nCol) = sfc_alb_uvvis_dif(1:nCol) enddo else - nday = 0 - idxday = 0 - sfc_alb_nir_dir(:,1:nCol) = 0. - sfc_alb_nir_dif(:,1:nCol) = 0. - sfc_alb_uvvis_dir(:,1:nCol) = 0. - sfc_alb_uvvis_dif(:,1:nCol) = 0. + nday = 0 + idxday = 0 + sfc_alb_nir_dir_byband(:,1:nCol) = 0. + sfc_alb_nir_dif_byband(:,1:nCol) = 0. + sfc_alb_uvvis_dir_byband(:,1:nCol) = 0. + sfc_alb_uvvis_dif_byband(:,1:nCol) = 0. endif end subroutine GFS_rrtmgp_sw_pre_run diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index 53831b42a..20de5a1b8 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -101,16 +101,43 @@ kind = kind_phys intent = inout optional = F -[sfcalb] - standard_name = surface_albedo_components - long_name = surface albedo IR/UV/VIS components +[sfc_alb_nir_dir] + standard_name = surface_albedo_due_to_near_IR_direct + long_name = surface albedo due to near IR direct beam units = frac - dimensions = (horizontal_loop_extent,number_of_components_for_surface_albedo) + dimensions = (horizontal_loop_extent) type = real kind = kind_phys intent = in optional = F -[sfc_alb_nir_dir] +[sfc_alb_nir_dif] + standard_name = surface_albedo_due_to_near_IR_diffused + long_name = surface albedo due to near IR diffused beam + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[sfc_alb_uvvis_dir] + standard_name = surface_albedo_due_to_UV_and_VIS_direct + long_name = surface albedo due to UV+VIS direct beam + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[sfc_alb_uvvis_dif] + standard_name = surface_albedo_due_to_UV_and_VIS_diffused + long_name = surface albedo due to UV+VIS diffused beam + units = frac + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in + optional = F +[sfc_alb_nir_dir_byband] standard_name = surface_albedo_nearIR_direct long_name = near-IR (direct) surface albedo (sfc_alb_nir_dir) units = none @@ -119,7 +146,7 @@ kind = kind_phys intent = out optional = F -[sfc_alb_nir_dif] +[sfc_alb_nir_dif_byband] standard_name = surface_albedo_nearIR_diffuse long_name = near-IR (diffuse) surface albedo (sfc_alb_nir_dif) units = none @@ -128,8 +155,8 @@ kind = kind_phys intent = out optional = F -[sfc_alb_uvvis_dir] - standard_name = surface_albedo_uvvis_dir +[sfc_alb_uvvis_dir_byband] + standard_name = surface_albedo_uvvis_direct long_name = UVVIS (direct) surface albedo (sfc_alb_uvvis_dir) units = none dimensions = (number_of_shortwave_bands,horizontal_loop_extent) @@ -137,8 +164,8 @@ kind = kind_phys intent = out optional = F -[sfc_alb_uvvis_dif] - standard_name = surface_albedo_uvvis_dif +[sfc_alb_uvvis_dif_byband] + standard_name = surface_albedo_uvvis_diffuse long_name = UVVIS (diffuse) surface albedo (sfc_alb_uvvis_dif) units = none dimensions = (number_of_shortwave_bands,horizontal_loop_extent) diff --git a/physics/dcyc2.meta b/physics/dcyc2.meta index da9476e84..6a321acc4 100644 --- a/physics/dcyc2.meta +++ b/physics/dcyc2.meta @@ -469,7 +469,7 @@ intent = in optional = F [flux2D_lwUP] - standard_name = RRTMGP_lw_flux_profile_upward_allsky + standard_name = RRTMGP_lw_flux_profile_upward_allsky_on_radiation_timestep long_name = RRTMGP upward longwave all-sky flux profile units = W m-2 dimensions = (horizontal_loop_extent,vertical_interface_dimension) @@ -478,7 +478,7 @@ intent = in optional = F [flux2D_lwDOWN] - standard_name = RRTMGP_lw_flux_profile_downward_allsky + standard_name = RRTMGP_lw_flux_profile_downward_allsky_on_radiation_timestep long_name = RRTMGP downward longwave all-sky flux profile units = W m-2 dimensions = (horizontal_loop_extent,vertical_interface_dimension) diff --git a/physics/rrtmgp_lw_cloud_sampling.meta b/physics/rrtmgp_lw_cloud_sampling.meta index 21cc1eed6..31613d060 100644 --- a/physics/rrtmgp_lw_cloud_sampling.meta +++ b/physics/rrtmgp_lw_cloud_sampling.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmgp_lw_cloud_sampling type = scheme - dependencies = machine.F,mersenne_twister.f,physparam.f,rrtmgp_sampling.F90,radiation_tools.F90 + dependencies = machine.F,mersenne_twister.f,rrtmgp_sampling.F90,radiation_tools.F90 ###################################################### [ccpp-arg-table] diff --git a/physics/rrtmgp_lw_pre.meta b/physics/rrtmgp_lw_pre.meta index 3918f85e4..fbbb6f1ba 100644 --- a/physics/rrtmgp_lw_pre.meta +++ b/physics/rrtmgp_lw_pre.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmgp_lw_pre type = scheme - dependencies = iounitdef.f,machine.F,physparam.f + dependencies = iounitdef.f,machine.F ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index d2878598d..c9c3db1e6 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -31,7 +31,8 @@ end subroutine rrtmgp_lw_rte_init subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, nCol, & nLev, p_lev, sfc_emiss_byband, sources, lw_optical_props_clrsky, & lw_optical_props_clouds, lw_optical_props_aerosol, nGauss_angles, fluxlwUP_allsky, & - fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, fluxlwUP_jac, errmsg, errflg) + fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, fluxlwUP_jac, & + fluxlwUP_radtime, fluxlwDOWN_radtime, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -61,7 +62,9 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, 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) + fluxlwDOWN_clrsky, & ! All-sky flux (W/m2) + fluxlwUP_radtime, & ! Copy of fluxes (Used for coupling) + fluxlwDOWN_radtime character(len=*), intent(out) :: & errmsg ! CCPP error message integer, intent(out) :: & @@ -192,6 +195,10 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, fluxlwUP_allsky = sum(flux_allsky%bnd_flux_up,dim=3) fluxlwDOWN_allsky = sum(flux_allsky%bnd_flux_dn,dim=3) + ! Save fluxes for coupling + fluxlwUP_radtime = fluxlwUP_allsky + fluxlwDOWN_radtime = fluxlwDOWN_allsky + end subroutine rrtmgp_lw_rte_run ! ######################################################################################### diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index 3ffa24a30..7c18117c1 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -114,6 +114,24 @@ type = ty_source_func_lw intent = in optional = F +[fluxlwUP_radtime] + standard_name = RRTMGP_lw_flux_profile_upward_allsky_on_radiation_timestep + long_name = RRTMGP upward longwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = inout + optional = F +[fluxlwDOWN_radtime] + standard_name = RRTMGP_lw_flux_profile_downward_allsky_on_radiation_timestep + long_name = RRTMGP downward longwave all-sky flux profile + units = W m-2 + dimensions = (horizontal_loop_extent,vertical_interface_dimension) + type = real + kind = kind_phys + intent = inout + optional = F [fluxlwUP_allsky] standard_name = RRTMGP_lw_flux_profile_upward_allsky long_name = RRTMGP upward longwave all-sky flux profile diff --git a/physics/rrtmgp_sw_cloud_optics.meta b/physics/rrtmgp_sw_cloud_optics.meta index 3956579a4..65ce7e35f 100644 --- a/physics/rrtmgp_sw_cloud_optics.meta +++ b/physics/rrtmgp_sw_cloud_optics.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmgp_sw_cloud_optics type = scheme - dependencies = machine.F,physparam.f,rrtmg_sw_cloud_optics.F90,radiation_tools.F90 + dependencies = machine.F,rrtmg_sw_cloud_optics.F90,radiation_tools.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_sw_cloud_sampling.meta b/physics/rrtmgp_sw_cloud_sampling.meta index f1452abf8..73be12093 100644 --- a/physics/rrtmgp_sw_cloud_sampling.meta +++ b/physics/rrtmgp_sw_cloud_sampling.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = rrtmgp_sw_cloud_sampling type = scheme - dependencies = machine.F,mersenne_twister.f,physparam.f,rrtmgp_sampling.F90,radiation_tools.F90 + dependencies = machine.F,mersenne_twister.f,rrtmgp_sampling.F90,radiation_tools.F90 ###################################################### [ccpp-arg-table] diff --git a/physics/rrtmgp_sw_gas_optics.F90 b/physics/rrtmgp_sw_gas_optics.F90 index 146d87191..260f65fe7 100644 --- a/physics/rrtmgp_sw_gas_optics.F90 +++ b/physics/rrtmgp_sw_gas_optics.F90 @@ -79,17 +79,14 @@ module rrtmgp_sw_gas_optics !! \section arg_table_rrtmgp_sw_gas_optics_init !! \htmlinclude rrtmgp_sw_gas_optics.html !! - subroutine rrtmgp_sw_gas_optics_init(nCol, nLev, nThreads, rrtmgp_root_dir, & - rrtmgp_sw_file_gas, active_gases_array, mpicomm, mpirank, mpiroot, errmsg, errflg) + subroutine rrtmgp_sw_gas_optics_init(rrtmgp_root_dir, rrtmgp_sw_file_gas, & + active_gases_array, mpicomm, mpirank, mpiroot, 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) :: & - nCol, & ! Number of horizontal gridpoints. - nLev, & ! Number of vertical levels. - nThreads, & ! Number of openMP threads mpicomm, & ! MPI communicator mpirank, & ! Current MPI rank mpiroot ! Master MPI rank @@ -543,7 +540,6 @@ subroutine rrtmgp_sw_gas_optics_run(doSWrad, nCol, nLev, ngptsGPsw, nday, idxday toa_src_sw(:,:) = 0._kind_phys if (nDay .gt. 0) then - !active_gases = gas_concentrations%get_gas_names() ! Allocate space call check_error_msg('rrtmgp_sw_gas_optics_run_alloc_2str',& sw_optical_props_clrsky%alloc_2str(nday, nLev, sw_gas_props)) diff --git a/physics/rrtmgp_sw_gas_optics.meta b/physics/rrtmgp_sw_gas_optics.meta index 7ca3f3951..865b09c60 100644 --- a/physics/rrtmgp_sw_gas_optics.meta +++ b/physics/rrtmgp_sw_gas_optics.meta @@ -7,30 +7,6 @@ [ccpp-arg-table] name = rrtmgp_sw_gas_optics_init type = scheme -[ncol] - standard_name = horizontal_dimension - long_name = horizontal dimension - units = count - dimensions = () - type = integer - intent = in - optional = F -[nLev] - standard_name = vertical_layer_dimension - long_name = number of vertical levels - units = count - dimensions = () - type = integer - intent = in - optional = F -[nThreads] - standard_name = number_of_openmp_threads - long_name = number of OpenMP threads available to scheme - units = count - dimensions = () - type = integer - intent = in - optional = F [rrtmgp_root_dir] standard_name = directory_for_rte_rrtmgp_source_code long_name = directory for rte+rrtmgp source code diff --git a/physics/rrtmgp_sw_rte.meta b/physics/rrtmgp_sw_rte.meta index 5ca34b285..1fa3fef9c 100644 --- a/physics/rrtmgp_sw_rte.meta +++ b/physics/rrtmgp_sw_rte.meta @@ -135,7 +135,7 @@ intent = in optional = F [sfc_alb_uvvis_dir] - standard_name = surface_albedo_uvvis_dir + standard_name = surface_albedo_uvvis_direct long_name = UVVIS (direct) surface albedo (sfc_alb_uvvis_dir) units = none dimensions = (number_of_shortwave_bands,horizontal_loop_extent) @@ -144,7 +144,7 @@ intent = in optional = F [sfc_alb_uvvis_dif] - standard_name = surface_albedo_uvvis_dif + standard_name = surface_albedo_uvvis_diffuse long_name = UVVIS (diffuse) surface albedo (sfc_alb_uvvis_dif) units = none dimensions = (number_of_shortwave_bands,horizontal_loop_extent) From 0a545c622e92e20a9832b72f22238570dcc9c8bd Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 10 Nov 2021 18:51:32 +0000 Subject: [PATCH 02/11] Bug fix for decomposition tests. --- physics/rrtmgp_sw_cloud_sampling.F90 | 37 +--------------------------- 1 file changed, 1 insertion(+), 36 deletions(-) diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index b234ce41a..23d47c919 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -88,9 +88,6 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, idxday, iovr, ! 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)) - sw_optical_props_clouds%tau(:,:,:) = 0._kind_phys - sw_optical_props_clouds%ssa(:,:,:) = 1._kind_phys - sw_optical_props_clouds%g(:,:,:) = 0._kind_phys ! Change random number seed value for each radiation invocation (isubc_sw =1 or 2). if(isubc_sw == 1) then ! advance prescribed permutation seed @@ -99,7 +96,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, idxday, iovr, enddo elseif (isubc_sw == 2) then ! use input array of permutaion seeds do iday = 1, nday - ipseed_sw(iday) = icseed_sw(iday) + ipseed_sw(iday) = icseed_sw(idxday(iday)) enddo endif @@ -121,12 +118,6 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, idxday, iovr, endif enddo - do iday=1,nday - call random_setseed(ipseed_sw(iday),rng_stat) - call random_number(rng2D,rng_stat) - rng3D(:,:,iday) = reshape(source = rng2D,shape=[sw_gas_props%get_ngpt(),nLev]) - enddo - ! Cloud overlap. ! Maximum-random, random, or maximum cloud overlap if (iovr == iovr_maxrand .or. iovr == iovr_max .or. iovr == iovr_rand) then @@ -164,26 +155,6 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, idxday, iovr, ! Allocate space RRTMGP DDTs [nday,nLev,nGpt] call check_error_msg('rrtmgp_sw_cloud_sampling_run', & sw_optical_props_precip%alloc_2str( nday, nLev, sw_gas_props)) - - ! Change random number seed value for each radiation invocation (isubc_sw =1 or 2). - if(isubc_sw == 1) then ! advance prescribed permutation seed - do iday = 1, nday - ipseed_sw(iday) = sw_gas_props%get_ngpt() + iday - enddo - elseif (isubc_sw == 2) then ! use input array of permutaion seeds - do iday = 1, nday - ipseed_sw(iday) = icseed_sw(iday) - enddo - endif - - ! No need to call RNG second time for now, just use the same seeds for precip as clouds. - !! Call RNG. Mersennse Twister accepts 1D array, so loop over columns and collapse along G-points - !! and layers. ([nGpts,nLev,nDay]-> [nGpts*nLev]*nDay) - !do iday=1,nday - ! call random_setseed(ipseed_sw(iday),rng_stat) - ! call random_number(rng1D,rng_stat) - ! rng3D(:,:,iday) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) - !enddo ! Precipitation overlap ! Maximum-random, random or maximum precipitation overlap @@ -192,12 +163,6 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, idxday, iovr, endif ! Exponential decorrelation length overlap if (iovr == iovr_dcorr) then - !! Generate second RNG - !do iday=1,nday - ! call random_setseed(ipseed_sw(iday),rng_stat) - ! call random_number(rng1D,rng_stat) - ! rng3D2(:,:,iday) = reshape(source = rng1D,shape=[sw_gas_props%get_ngpt(),nLev]) - !enddo call sampled_mask(rng3D, precip_frac(idxday(1:nDay),:), precipfracSAMP, & overlap_param = precip_overlap_param(idxday(1:nDay),1:nLev-1),& randoms2 = rng3D2) From 291ab46fc6a206b5e6fadd356b623209e8742a02 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 10 Nov 2021 18:58:51 +0000 Subject: [PATCH 03/11] Meta data fix. --- physics/GFS_rrtmgp_pre.meta | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index bbd278f98..156b7a983 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -318,7 +318,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = in + intent = inout optional = F [tsfg] standard_name = surface_ground_temperature_for_radiation From da806cfbe4a2f80bea4385094897dadf6072f5d5 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 10 Nov 2021 20:51:53 +0000 Subject: [PATCH 04/11] Fix omission from conflict. --- physics/GFS_rrtmgp_sw_pre.meta | 1 - 1 file changed, 1 deletion(-) diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index ff13ab0c3..37afd903f 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -122,7 +122,6 @@ type = real kind = kind_phys intent = in - optional = F [sfc_alb_nir_dir_byband] standard_name = surface_albedo_nearIR_direct long_name = near-IR (direct) surface albedo (sfc_alb_nir_dir) From ec8eb0241f759c9945f7b6aae505550181b47e30 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Thu, 11 Nov 2021 23:33:08 +0000 Subject: [PATCH 05/11] Fix aerosol diagnostics. --- physics/GFS_rrtmgp_lw_post.F90 | 10 +++------- physics/GFS_rrtmgp_lw_post.meta | 8 -------- physics/GFS_rrtmgp_pre.F90 | 1 - physics/GFS_rrtmgp_sw_post.F90 | 12 ++++++------ physics/rrtmgp_lw_aerosol_optics.F90 | 12 ++++++------ physics/rrtmgp_lw_aerosol_optics.meta | 15 +++++++-------- physics/rrtmgp_sw_aerosol_optics.F90 | 10 +++++----- physics/rrtmgp_sw_aerosol_optics.meta | 2 +- 8 files changed, 28 insertions(+), 42 deletions(-) diff --git a/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90 index 28bb25cae..4b7840850 100644 --- a/physics/GFS_rrtmgp_lw_post.F90 +++ b/physics/GFS_rrtmgp_lw_post.F90 @@ -1,12 +1,11 @@ module GFS_rrtmgp_lw_post use machine, only: kind_phys - 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 radiation_tools, only: check_error_msg + use radiation_tools, only: check_error_msg implicit none public GFS_rrtmgp_lw_post_init,GFS_rrtmgp_lw_post_run,GFS_rrtmgp_lw_post_finalize @@ -26,9 +25,8 @@ end subroutine GFS_rrtmgp_lw_post_init !! subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag, fhlwr, & p_lev, t_lay, tsfa, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, & - fluxlwDOWN_clrsky, raddt, aerodp, cldsa, mtopa, mbota, cld_frac, cldtaulw, fluxr, & - sfcdlw, sfculw, sfcflw, tsflw, htrlw, htrlwu, topflw, flxprf_lw, htrlwc, errmsg, & - errflg) + fluxlwDOWN_clrsky, raddt, cldsa, mtopa, mbota, cld_frac, cldtaulw, fluxr, sfcdlw, & + sfculw, sfcflw, tsflw, htrlw, htrlwu, topflw, flxprf_lw, htrlwc, errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -52,8 +50,6 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag fluxlwDOWN_clrsky ! RRTMGP longwave clear-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) ::& diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta index 9bc02cf50..b389f8e4c 100644 --- a/physics/GFS_rrtmgp_lw_post.meta +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -114,14 +114,6 @@ type = real kind = kind_phys intent = in -[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_loop_extent,number_of_species_for_aerosol_optical_depth) - type = real - kind = kind_phys - intent = in [cldsa] standard_name = cloud_area_fraction_for_radiation long_name = fraction of clouds for low, middle, high, total and BL diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 00295f244..bc75a6e24 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -274,7 +274,6 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f 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.) - print*,"istr: ",istr_o2,istr_co2,istr_ch4,istr_n2o,istr_h2o,istr_o3 ! Populate RRTMGP DDT w/ gas-concentrations gas_concentrations%ncol = nCol gas_concentrations%nlay = nLev diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 index 8c1804eb9..1787d4f4f 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -257,12 +257,12 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky ! ####################################################################################### if (save_diag) then do i=1,nCol - fluxr(i,34) = fluxr(i,34) + fhswr*aerodp(i,1) ! total aod at 550nm - fluxr(i,35) = fluxr(i,35) + fhswr*aerodp(i,2) ! DU aod at 550nm - fluxr(i,36) = fluxr(i,36) + fhswr*aerodp(i,3) ! BC aod at 550nm - fluxr(i,37) = fluxr(i,37) + fhswr*aerodp(i,4) ! OC aod at 550nm - fluxr(i,38) = fluxr(i,38) + fhswr*aerodp(i,5) ! SU aod at 550nm - fluxr(i,39) = fluxr(i,39) + fhswr*aerodp(i,6) ! SS aod at 550nm + fluxr(i,34) = aerodp(i,1) ! total aod at 550nm + fluxr(i,35) = aerodp(i,2) ! DU aod at 550nm + fluxr(i,36) = aerodp(i,3) ! BC aod at 550nm + fluxr(i,37) = aerodp(i,4) ! OC aod at 550nm + fluxr(i,38) = aerodp(i,5) ! SU aod at 550nm + fluxr(i,39) = aerodp(i,6) ! SS aod at 550nm if (coszen(i) > 0.) then ! SW all-sky fluxes tem0d = fhswr * coszdg(i) / coszen(i) diff --git a/physics/rrtmgp_lw_aerosol_optics.F90 b/physics/rrtmgp_lw_aerosol_optics.F90 index df0e77163..de42db1cd 100644 --- a/physics/rrtmgp_lw_aerosol_optics.F90 +++ b/physics/rrtmgp_lw_aerosol_optics.F90 @@ -2,7 +2,7 @@ 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 radiation_tools, only: check_error_msg + use radiation_tools, only: check_error_msg use rrtmgp_sw_gas_optics, only: sw_gas_props use rrtmgp_lw_gas_optics, only: lw_gas_props use module_radiation_aerosols, only: & @@ -30,9 +30,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, nTracerAer,& - p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, & - aerodp, lw_optical_props_aerosol, errmsg, errflg) + subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nspc, nTracer, nTracerAer, & + p_lev, p_lay, p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, & + lw_optical_props_aerosol, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -40,6 +40,7 @@ subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nTracer, nTracerAer integer, intent(in) :: & nCol, & ! Number of horizontal grid points nLev, & ! Number of vertical layers + nspc, & ! Number of aerosol optical-depths nTracer, & ! Number of tracers nTracerAer ! Number of aerosol tracers real(kind_phys), dimension(:), intent(in) :: & @@ -59,8 +60,6 @@ subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nTracer, nTracerAer p_lev ! Pressure @ layer-interfaces (Pa) ! Outputs - real(kind_phys), dimension(:,:), intent(inout) :: & - aerodp ! Vertical integrated optical depth for various aerosol species type(ty_optical_props_1scl),intent(inout) :: & lw_optical_props_aerosol ! RRTMGP DDT: Longwave aerosol optical properties (tau) integer, intent(out) :: & @@ -73,6 +72,7 @@ subroutine rrtmgp_lw_aerosol_optics_run(doLWrad, nCol, nLev, nTracer, nTracerAer aerosolslw ! real(kind_phys), dimension(nCol, nLev, sw_gas_props%get_nband(), NF_AESW) :: & aerosolssw + real(kind_phys), dimension(nCol,nspc) :: aerodp integer :: iBand ! Initialize CCPP error handling variables diff --git a/physics/rrtmgp_lw_aerosol_optics.meta b/physics/rrtmgp_lw_aerosol_optics.meta index 843688266..875143df1 100644 --- a/physics/rrtmgp_lw_aerosol_optics.meta +++ b/physics/rrtmgp_lw_aerosol_optics.meta @@ -28,6 +28,13 @@ dimensions = () type = integer intent = in +[nspc] + standard_name = number_of_species_for_aerosol_optical_depth + long_name = number of species for output aerosol optical depth plus total + units = count + dimensions = () + type = integer + intent = in [nTracer] standard_name = number_of_tracers long_name = number of tracers @@ -122,14 +129,6 @@ type = real kind = kind_phys intent = in -[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_loop_extent,number_of_species_for_aerosol_optical_depth) - type = real - kind = kind_phys - intent = inout [lw_optical_props_aerosol] standard_name = longwave_optical_properties_for_aerosols long_name = Fortran DDT containing RRTMGP optical properties diff --git a/physics/rrtmgp_sw_aerosol_optics.F90 b/physics/rrtmgp_sw_aerosol_optics.F90 index 3a74771b7..0ac03bb12 100644 --- a/physics/rrtmgp_sw_aerosol_optics.F90 +++ b/physics/rrtmgp_sw_aerosol_optics.F90 @@ -62,7 +62,7 @@ subroutine rrtmgp_sw_aerosol_optics_run(doSWrad, nCol, nLev, nTracer, nTracerAer p_lev ! Pressure @ layer-interfaces (Pa) ! Outputs - real(kind_phys), dimension(:,:), intent(inout) :: & + real(kind_phys), dimension(:,:), intent(out) :: & 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) @@ -82,12 +82,12 @@ subroutine rrtmgp_sw_aerosol_optics_run(doSWrad, nCol, nLev, nTracer, nTracerAer 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/100., p_lay/100., p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, nCol, nLev, & - nLev+1, .true., .true., aerosolssw2, aerosolslw, aerodp) + ! Call module_radiation_aerosols::setaer(),to setup aerosols property profile + call setaer(p_lev/100., p_lay/100., p_lk, tv_lay, relhum, lsmask, tracer, aerfld, lon, lat, nCol, nLev, & + nLev+1, .true., .true., aerosolssw2, aerosolslw, aerodp) + if (nDay .gt. 0) then ! Store aerosol optical properties ! SW. ! For RRTMGP SW the bands are now ordered from [IR(band) -> nIR -> UV], in RRTMG the diff --git a/physics/rrtmgp_sw_aerosol_optics.meta b/physics/rrtmgp_sw_aerosol_optics.meta index 606b122b5..f56a54467 100644 --- a/physics/rrtmgp_sw_aerosol_optics.meta +++ b/physics/rrtmgp_sw_aerosol_optics.meta @@ -143,7 +143,7 @@ dimensions = (horizontal_loop_extent,number_of_species_for_aerosol_optical_depth) type = real kind = kind_phys - intent = inout + intent = out [sw_optical_props_aerosol] standard_name = shortwave_optical_properties_for_aerosols long_name = Fortran DDT containing RRTMGP optical properties From 2d73a8eded33ebf49b3fe134d8155157596f03b8 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Mon, 15 Nov 2021 23:25:57 +0000 Subject: [PATCH 06/11] Fix issue with surface-albedo in RRTMGP. --- physics/GFS_rrtmgp_pre.F90 | 29 +++++++++++++++----- physics/GFS_rrtmgp_pre.meta | 47 ++++++++++++++++++++++++++++++++ physics/GFS_rrtmgp_sw_pre.F90 | 36 ++++++------------------- physics/GFS_rrtmgp_sw_pre.meta | 49 +--------------------------------- 4 files changed, 78 insertions(+), 83 deletions(-) diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index bc75a6e24..6b8fb6378 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -3,6 +3,8 @@ module GFS_rrtmgp_pre kind_phys ! Working type use funcphys, only: & fpvs ! Function ot compute sat. vapor pressure over liq. + use module_radiation_astronomy, only: & + coszmn use module_radiation_gases, only: & NF_VGAS, & ! Number of active gas species getgases, & ! Routine to setup trace gases @@ -96,11 +98,11 @@ end subroutine GFS_rrtmgp_pre_init !> \section arg_table_GFS_rrtmgp_pre_run !! \htmlinclude GFS_rrtmgp_pre_run.html !! - subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, fhlwr, & - xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, con_eps, con_epsm1, con_fvirt, & - con_epsqs, minGPpres, maxGPpres, minGPtemp, maxGPtemp, raddt, p_lay, t_lay, p_lev, & - t_lev, tsfg, tsfa, qs_lay, q_lay, tv_lay, relhum, tracer, active_gases_array, & - gas_concentrations, tsfc_radtime, errmsg, errflg) + subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, fhlwr, & + xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, coslat, sinlat, con_eps, con_epsm1,& + con_fvirt, con_epsqs, solhr, minGPpres, maxGPpres, minGPtemp, maxGPtemp, raddt, & + p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, qs_lay, q_lay, tv_lay, relhum, tracer, & + active_gases_array, gas_concentrations, tsfc_radtime, coszen, coszdg, errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -122,11 +124,14 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f con_eps, & ! Physical constant: Epsilon (Rd/Rv) con_epsm1, & ! Physical constant: Epsilon (Rd/Rv) minus one con_fvirt, & ! Physical constant: Inverse of epsilon minus one - con_epsqs ! Physical constant: Minimum saturation mixing-ratio (kg/kg) + con_epsqs, & ! Physical constant: Minimum saturation mixing-ratio (kg/kg) + solhr ! Time in hours after 00z at the current timestep real(kind_phys), dimension(nCol), intent(in) :: & xlon, & ! Longitude xlat, & ! Latitude - tsfc ! Surface skin temperature (K) + tsfc, & ! Surface skin temperature (K) + coslat, & ! Cosine(latitude) + sinlat ! Sine(latitude) real(kind_phys), dimension(nCol,nLev), intent(in) :: & prsl, & ! Pressure at model-layer centers (Pa) tgrs, & ! Temperature at model-layer centers (K) @@ -163,6 +168,9 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f active_gases_array ! List of active gases from namelist as array type(ty_gas_concs), intent(inout) :: & gas_concentrations ! RRTMGP DDT: gas volumne mixing ratios + real(kind_phys), dimension(:), intent(inout) :: & + coszen, & ! Cosine of SZA + coszdg ! Cosine of SZA, daytime ! Local variables integer :: i, j, iCol, iBand, iSFC, iTOA, iLay @@ -296,6 +304,13 @@ subroutine GFS_rrtmgp_pre_run(nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhswr, f tsfg(1:NCOL) = tsfc(1:NCOL) tsfa(1:NCOL) = t_lay(1:NCOL,iSFC) + ! ####################################################################################### + ! Compute cosine of zenith angle (only when SW is called) + ! ####################################################################################### + if (lsswr) then + call coszmn (xlon, sinlat, coslat, solhr, nCol, me, coszen, coszdg) + endif + end subroutine GFS_rrtmgp_pre_run ! ######################################################################################### diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index 1ab4bf430..cdd1dd7ce 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -51,6 +51,13 @@ [ccpp-arg-table] name = GFS_rrtmgp_pre_run type = scheme +[me] + standard_name = mpi_rank + long_name = current MPI-rank + units = index + dimensions = () + type = integer + intent = in [ncol] standard_name = horizontal_loop_extent long_name = horizontal dimension @@ -125,6 +132,30 @@ type = real kind = kind_phys intent = in +[coslat] + standard_name = cosine_of_latitude + long_name = cosine of latitude + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[sinlat] + standard_name = sine_of_latitude + long_name = sine of latitude + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = in +[solhr] + standard_name = forecast_utc_hour + long_name = time in hours after 00z at the current timestep + units = h + dimensions = () + type = real + kind = kind_phys + intent = in [prsi] standard_name = air_pressure_at_interface long_name = air pressure at model layer interfaces @@ -356,6 +387,22 @@ dimensions = () type = ty_gas_concs intent = inout +[coszdg] + standard_name = cosine_of_solar_zenith_angle_on_radiation_timestep + long_name = daytime mean cosz over rad call period + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout +[coszen] + standard_name = cosine_of_solar_zenith_angle_for_daytime_points_on_radiation_timestep + long_name = mean cos of zenith angle over rad call period + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys + intent = inout [errmsg] standard_name = ccpp_error_message long_name = error message for error handling in CCPP diff --git a/physics/GFS_rrtmgp_sw_pre.F90 b/physics/GFS_rrtmgp_sw_pre.F90 index b11542cd6..3566575f4 100644 --- a/physics/GFS_rrtmgp_sw_pre.F90 +++ b/physics/GFS_rrtmgp_sw_pre.F90 @@ -1,13 +1,9 @@ module GFS_rrtmgp_sw_pre - use machine, only: & - kind_phys ! Working type - use module_radiation_astronomy, only: & - coszmn ! Function to compute cos(SZA) - use mo_gas_optics_rrtmgp, only: & - ty_gas_optics_rrtmgp + use machine, only: kind_phys + use mo_gas_optics_rrtmgp, only: ty_gas_optics_rrtmgp use rrtmgp_sw_gas_optics, only: sw_gas_props - public GFS_rrtmgp_sw_pre_run, GFS_rrtmgp_sw_pre_init, GFS_rrtmgp_sw_pre_finalize + public GFS_rrtmgp_sw_pre_run, GFS_rrtmgp_sw_pre_init, GFS_rrtmgp_sw_pre_finalize contains ! ######################################################################################### @@ -22,25 +18,18 @@ end subroutine GFS_rrtmgp_sw_pre_init !> \section arg_table_GFS_rrtmgp_sw_pre_run !! \htmlinclude GFS_rrtmgp_sw_pre.html !! - subroutine GFS_rrtmgp_sw_pre_run(me, nCol, doSWrad, solhr, lon, coslat, sinlat, & - nday, idxday, coszen, coszdg, sfc_alb_nir_dir, sfc_alb_nir_dif, sfc_alb_uvvis_dir, & - sfc_alb_uvvis_dif, sfc_alb_nir_dir_byband, sfc_alb_nir_dif_byband, & - sfc_alb_uvvis_dir_byband, sfc_alb_uvvis_dif_byband, errmsg, errflg) + subroutine GFS_rrtmgp_sw_pre_run(nCol, doSWrad, coszen, nday, idxday, sfc_alb_nir_dir, & + sfc_alb_nir_dif, sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, sfc_alb_nir_dir_byband, & + sfc_alb_nir_dif_byband, sfc_alb_uvvis_dir_byband, sfc_alb_uvvis_dif_byband, errmsg, & + errflg) ! Input integer, intent(in) :: & - me, & ! Current MPI rank nCol ! Number of horizontal grid points - logical,intent(in) :: & doSWrad ! Call RRTMGP SW radiation? - real(kind_phys), intent(in) :: & - solhr ! Time in hours after 00z at the current timestep real(kind_phys), dimension(:), intent(in) :: & - lon, & ! Longitude - coslat, & ! Cosine(latitude) - sinlat ! Sine(latitude) - + coszen real(kind_phys), dimension(:), intent(in) :: & sfc_alb_nir_dir, & ! sfc_alb_nir_dif, & ! @@ -52,9 +41,6 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, doSWrad, solhr, lon, coslat, sinlat, nday ! Number of daylit points integer, dimension(:), intent(out) :: & idxday ! Indices for daylit points - real(kind_phys), dimension(:), intent(inout) :: & - coszen, & ! Cosine of SZA - coszdg ! Cosine of SZA, daytime real(kind_phys), dimension(:,:), intent(out) :: & sfc_alb_nir_dir_byband, & ! Surface albedo (direct) sfc_alb_nir_dif_byband, & ! Surface albedo (diffuse) @@ -73,12 +59,6 @@ subroutine GFS_rrtmgp_sw_pre_run(me, nCol, doSWrad, solhr, lon, coslat, sinlat, errflg = 0 if (doSWrad) then - - ! #################################################################################### - ! Compute cosine of zenith angle (only when SW is called) - ! #################################################################################### - call coszmn (lon, sinlat, coslat, solhr, nCol, me, coszen, coszdg) - ! #################################################################################### ! For SW gather daylit points ! #################################################################################### diff --git a/physics/GFS_rrtmgp_sw_pre.meta b/physics/GFS_rrtmgp_sw_pre.meta index 37afd903f..1d9f893b6 100644 --- a/physics/GFS_rrtmgp_sw_pre.meta +++ b/physics/GFS_rrtmgp_sw_pre.meta @@ -7,13 +7,6 @@ [ccpp-arg-table] name = GFS_rrtmgp_sw_pre_run type = scheme -[me] - standard_name = mpi_rank - long_name = current MPI-rank - units = index - dimensions = () - type = integer - intent = in [ncol] standard_name = horizontal_loop_extent long_name = horizontal loop extent @@ -28,38 +21,6 @@ dimensions = () type = logical intent = in -[solhr] - standard_name = forecast_utc_hour - long_name = time in hours after 00z at the current timestep - units = h - dimensions = () - type = real - kind = kind_phys - intent = in -[lon] - standard_name = longitude - long_name = longitude - units = radian - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[coslat] - standard_name = cosine_of_latitude - long_name = cosine of latitude - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in -[sinlat] - standard_name = sine_of_latitude - long_name = sine of latitude - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = in [nday] standard_name = daytime_points_dimension long_name = daytime points dimension @@ -81,15 +42,7 @@ dimensions = (horizontal_loop_extent) type = real kind = kind_phys - intent = inout -[coszdg] - standard_name = cosine_of_solar_zenith_angle_on_radiation_timestep - long_name = daytime mean cosz over rad call period - units = none - dimensions = (horizontal_loop_extent) - type = real - kind = kind_phys - intent = inout + intent = in [sfc_alb_nir_dir] standard_name = surface_albedo_due_to_near_IR_direct long_name = surface albedo due to near IR direct beam From eaefb5032a8afb62aefea1d8cd3152d6a0c29497 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 16 Nov 2021 21:47:03 +0000 Subject: [PATCH 07/11] Updated rte-rrtmgp submodule. Small change to accommodate in.meta files in ccpp-physics. --- physics/GFS_rrtmgp_lw_post.meta | 2 +- physics/GFS_rrtmgp_sw_post.meta | 2 +- physics/rrtmgp_lw_rte.meta | 2 +- physics/rrtmgp_sw_rte.meta | 2 +- physics/rte-rrtmgp | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta index b389f8e4c..65dcd08e7 100644 --- a/physics/GFS_rrtmgp_lw_post.meta +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_rrtmgp_lw_post type = scheme - dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radlw_param.f,rte-rrtmgp/extensions/mo_fluxes_byband.F90,rte-rrtmgp/extensions/mo_fluxes_byband_kernels.F90,radiation_tools.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,rte-rrtmgp/extensions/mo_heating_rates.F90 + dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radlw_param.f,rte-rrtmgp/extensions/mo_fluxes_byband.F90,radiation_tools.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,rte-rrtmgp/extensions/mo_heating_rates.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta index 88ba5460d..93ab07a1d 100644 --- a/physics/GFS_rrtmgp_sw_post.meta +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -1,7 +1,7 @@ [ccpp-table-properties] name = GFS_rrtmgp_sw_post type = scheme - dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radsw_param.f,rte-rrtmgp/extensions/mo_fluxes_byband.F90,rte-rrtmgp/extensions/mo_fluxes_byband_kernels.F90 + dependencies = iounitdef.f,machine.F,radiation_aerosols.f,radsw_param.f,rte-rrtmgp/extensions/mo_fluxes_byband.F90 dependencies = rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,rte-rrtmgp/extensions/mo_heating_rates.F90,radiation_tools.F90 ######################################################################## diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index 3d1b3ca82..33fcdf309 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -2,7 +2,7 @@ name = rrtmgp_lw_rte type = scheme dependencies = machine.F,rte-rrtmgp/rte/mo_rte_lw.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,radiation_tools.F90 - dependencies = rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90,rte-rrtmgp/extensions/mo_fluxes_byband_kernels.F90 + dependencies = rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rrtmgp_sw_rte.meta b/physics/rrtmgp_sw_rte.meta index b7d46dd6b..4abb558f7 100644 --- a/physics/rrtmgp_sw_rte.meta +++ b/physics/rrtmgp_sw_rte.meta @@ -2,7 +2,7 @@ name = rrtmgp_sw_rte type = scheme dependencies = machine.F,radsw_param.f,rte-rrtmgp/rte/mo_rte_sw.F90,rte-rrtmgp/rte/mo_fluxes.F90,rte-rrtmgp/rte/kernels/mo_fluxes_broadband_kernels.F90,radiation_tools.F90 - dependencies = rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90,rte-rrtmgp/extensions/mo_fluxes_byband_kernels.F90 + dependencies = rte-rrtmgp/rte/kernels/mo_rte_solver_kernels.F90,rte-rrtmgp/extensions/mo_fluxes_byband.F90 ######################################################################## [ccpp-arg-table] diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 9c51cb7c3..56c549450 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 9c51cb7c3e227c9e84c2bff29ce4f438c7a54ae6 +Subproject commit 56c549450787cc7f592a66b4005a299244056568 From 5f8de2c72e0e10c705eaed1e94c6f3db165d8bac Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Wed, 17 Nov 2021 15:12:59 +0000 Subject: [PATCH 08/11] Some housekeeping --- physics/GFS_rrtmgp_cloud_overlap_pre.F90 | 15 +-- physics/GFS_rrtmgp_cloud_overlap_pre.meta | 7 ++ physics/GFS_rrtmgp_gfdlmp_pre.F90 | 1 - physics/GFS_rrtmgp_lw_post.F90 | 56 +++-------- physics/GFS_rrtmgp_lw_post.meta | 14 +++ physics/GFS_rrtmgp_pre.F90 | 14 ++- physics/GFS_rrtmgp_pre.meta | 21 +++++ physics/GFS_rrtmgp_sw_post.F90 | 107 +++++++--------------- physics/GFS_rrtmgp_sw_post.meta | 14 +++ physics/rrtmgp_lw_cloud_optics.F90 | 2 +- physics/rrtmgp_lw_cloud_sampling.F90 | 30 +----- physics/rrtmgp_lw_gas_optics.F90 | 9 +- physics/rrtmgp_lw_gas_optics.meta | 10 +- physics/rrtmgp_lw_rte.F90 | 23 +---- physics/rrtmgp_lw_rte.meta | 13 ++- physics/rrtmgp_sw_aerosol_optics.F90 | 2 +- physics/rrtmgp_sw_cloud_optics.F90 | 4 +- physics/rrtmgp_sw_cloud_sampling.F90 | 16 ++-- physics/rrtmgp_sw_rte.F90 | 62 ++++--------- physics/rrtmgp_sw_rte.meta | 20 ++-- 20 files changed, 167 insertions(+), 273 deletions(-) diff --git a/physics/GFS_rrtmgp_cloud_overlap_pre.F90 b/physics/GFS_rrtmgp_cloud_overlap_pre.F90 index b300228c4..f85621d8f 100644 --- a/physics/GFS_rrtmgp_cloud_overlap_pre.F90 +++ b/physics/GFS_rrtmgp_cloud_overlap_pre.F90 @@ -22,7 +22,7 @@ end subroutine GFS_rrtmgp_cloud_overlap_pre_init subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWrad, & julian, lat, p_lev, p_lay, tv_lay, con_pi, con_g, con_rd, con_epsq, dcorr_con, & idcor, iovr, iovr_dcorr, iovr_exp, iovr_exprand, idcor_con, idcor_hogan, & - idcor_oreopoulos, cld_frac, & + idcor_oreopoulos, cld_frac, top_at_1, & de_lgth, cloud_overlap_param, precip_overlap_param, deltaZc, errmsg, errflg) implicit none @@ -40,6 +40,7 @@ subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWra idcor_hogan, & ! Flag for decorrelation-length. (https://rmets.onlinelibrary.wiley.com/doi/full/10.1002/qj.647) idcor_oreopoulos ! Flag for decorrelation-length. (10.5194/acp-12-9097-2012) logical, intent(in) :: & + top_at_1, & ! Vertical ordering flag doSWrad, & ! Call SW radiation? doLWrad ! Call LW radiation real(kind_phys), intent(in) :: & @@ -74,24 +75,14 @@ subroutine GFS_rrtmgp_cloud_overlap_pre_run(nCol, nLev, yearlen, doSWrad, doLWra real(kind_phys) :: tem1,pfac real(kind_phys), dimension(nLev+1) :: hgtb real(kind_phys), dimension(nLev) :: hgtc - integer :: iCol,iLay,l,iSFC,iTOA + integer :: iCol,iLay,l real(kind_phys), dimension(nCol,nLev) :: deltaZ - logical :: top_at_1 ! Initialize CCPP error handling variables errmsg = '' errflg = 0 if (.not. (doSWrad .or. doLWrad)) return - ! What is vertical ordering? - top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) - if (top_at_1) then - iSFC = nLev - iTOA = 1 - else - iSFC = 1 - iTOA = nLev - endif ! ! Compute layer-thickness between layer boundaries (deltaZ) and layer centers (deltaZc) diff --git a/physics/GFS_rrtmgp_cloud_overlap_pre.meta b/physics/GFS_rrtmgp_cloud_overlap_pre.meta index 5a143f1ac..a15f1a8bd 100644 --- a/physics/GFS_rrtmgp_cloud_overlap_pre.meta +++ b/physics/GFS_rrtmgp_cloud_overlap_pre.meta @@ -186,6 +186,13 @@ type = real kind = kind_phys intent = in +[top_at_1] + standard_name = flag_for_vertical_ordering_in_RRTMGP + long_name = flag for vertical ordering in RRTMGP + units = flag + dimensions = () + type = logical + intent = in [de_lgth] standard_name = cloud_decorrelation_length long_name = cloud decorrelation length diff --git a/physics/GFS_rrtmgp_gfdlmp_pre.F90 b/physics/GFS_rrtmgp_gfdlmp_pre.F90 index ccbfd1df8..c6afd6ac0 100644 --- a/physics/GFS_rrtmgp_gfdlmp_pre.F90 +++ b/physics/GFS_rrtmgp_gfdlmp_pre.F90 @@ -98,7 +98,6 @@ subroutine GFS_rrtmgp_gfdlmp_pre_run(nCol, nLev, nTracers, ncnd, i_cldliq, i_cld real(kind_phys), dimension(nCol, nLev, min(4,ncnd)) :: cld_condensate integer :: iCol,iLay,l,ncndl real(kind_phys), dimension(nCol,nLev) :: deltaP,deltaZ - logical :: top_at_1 if (.not. (doSWrad .or. doLWrad)) return diff --git a/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90 index 4b7840850..0396667c4 100644 --- a/physics/GFS_rrtmgp_lw_post.F90 +++ b/physics/GFS_rrtmgp_lw_post.F90 @@ -1,9 +1,6 @@ module GFS_rrtmgp_lw_post use machine, only: kind_phys - 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 module_radlw_parameters, only: topflw_type, sfcflw_type use mo_heating_rates, only: compute_heating_rate use radiation_tools, only: check_error_msg implicit none @@ -24,14 +21,16 @@ end subroutine GFS_rrtmgp_lw_post_init !! \htmlinclude GFS_rrtmgp_lw_post.html !! subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag, fhlwr, & - p_lev, t_lay, tsfa, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, & + p_lev, t_lay, tsfa, fluxlwUP_allsky, fluxlwDOWN_allsky, fluxlwUP_clrsky, iSFC, iTOA,& fluxlwDOWN_clrsky, raddt, cldsa, mtopa, mbota, cld_frac, cldtaulw, fluxr, sfcdlw, & - sfculw, sfcflw, tsflw, htrlw, htrlwu, topflw, flxprf_lw, htrlwc, errmsg, errflg) + sfculw, sfcflw, tsflw, htrlw, htrlwu, topflw, htrlwc, errmsg, errflg) ! Inputs integer, intent(in) :: & nCol, & ! Horizontal loop extent - nLev ! Number of vertical layers + nLev, & ! Number of vertical layers + iSFC, & ! Vertical index for surface level + iTOA ! Vertical index for TOA level logical, intent(in) :: & lslwr, & ! Logical flags for lw radiation calls do_lw_clrsky_hr, & ! Output clear-sky SW heating-rate? @@ -77,20 +76,13 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag errmsg integer, intent(out) :: & errflg - + ! Outputs (optional) - type(proflw_type), dimension(nCol, nLev+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) real(kind_phys),dimension(nCol, nLev),intent(inout),optional :: & htrlwc ! Longwave clear-sky heating-rate (K/sec) ! Local variables - integer :: i, j, k, iSFC, iTOA, itop, ibtc - logical :: l_fluxeslw2d, top_at_1 + integer :: i, j, k, itop, ibtc real(kind_phys) :: tem0d, tem1, tem2 real(kind_phys),dimension(nCol,nLev) :: hlwc @@ -99,22 +91,6 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag errflg = 0 if (.not. lslwr) return - - ! Are any optional outputs requested? - l_fluxeslw2d = present(flxprf_lw) - - ! ####################################################################################### - ! What is vertical ordering? - ! ####################################################################################### - top_at_1 = (p_lev(1,1) .lt. p_lev(1, nLev)) - if (top_at_1) then - iSFC = nLev+1 - iTOA = 1 - else - iSFC = 1 - iTOA = nLev+1 - endif - ! ####################################################################################### ! Compute LW heating-rates. ! ####################################################################################### @@ -136,24 +112,18 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag ! ####################################################################################### ! Save LW outputs. + ! (Copy fluxes from RRTGMP types into model radiation types.) ! ####################################################################################### - ! Copy fluxes from RRTGMP types into model radiation types. - ! Mandatory outputs + ! TOA fluxes topflw(:)%upfxc = fluxlwUP_allsky(:,iTOA) topflw(:)%upfx0 = fluxlwUP_clrsky(:,iTOA) + + ! Surface fluxes sfcflw(:)%upfxc = fluxlwUP_allsky(:,iSFC) sfcflw(:)%upfx0 = fluxlwUP_clrsky(:,iSFC) sfcflw(:)%dnfxc = fluxlwDOWN_allsky(:,iSFC) 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 - + ! Save surface air temp for diurnal adjustment at model t-steps tsflw (:) = tsfa(:) diff --git a/physics/GFS_rrtmgp_lw_post.meta b/physics/GFS_rrtmgp_lw_post.meta index 65dcd08e7..f051141dc 100644 --- a/physics/GFS_rrtmgp_lw_post.meta +++ b/physics/GFS_rrtmgp_lw_post.meta @@ -21,6 +21,20 @@ dimensions = () type = integer intent = in +[iSFC] + standard_name = vertical_index_for_surface_in_RRTMGP + long_name = index for surface layer in RRTMGP + units = flag + dimensions = () + type = integer + intent = in +[iTOA] + standard_name = vertical_index_for_TOA_in_RRTMGP + long_name = index for TOA layer in RRTMGP + units = flag + dimensions = () + type = integer + intent = in [lslwr] standard_name = flag_for_calling_longwave_radiation long_name = logical flags for lw radiation calls diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index 6b8fb6378..d3620a5fd 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -102,7 +102,8 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhsw xlat, xlon, prsl, tgrs, prslk, prsi, qgrs, tsfc, coslat, sinlat, con_eps, con_epsm1,& con_fvirt, con_epsqs, solhr, minGPpres, maxGPpres, minGPtemp, maxGPtemp, raddt, & p_lay, t_lay, p_lev, t_lev, tsfg, tsfa, qs_lay, q_lay, tv_lay, relhum, tracer, & - active_gases_array, gas_concentrations, tsfc_radtime, coszen, coszdg, errmsg, errflg) + active_gases_array, gas_concentrations, tsfc_radtime, coszen, coszdg, top_at_1, iSFC,& + iTOA, errmsg, errflg) ! Inputs integer, intent(in) :: & @@ -145,7 +146,11 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhsw character(len=*), intent(out) :: & errmsg ! Error message integer, intent(out) :: & - errflg ! Error flag + errflg, & ! Error flag + iSFC, & ! Vertical index for surface + iTOA ! Vertical index for TOA + logical, intent(out) :: & + top_at_1 ! Vertical ordering flag real(kind_phys), intent(inout) :: & raddt ! Radiation time-step real(kind_phys), dimension(ncol), intent(inout) :: & @@ -165,7 +170,7 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhsw real(kind_phys), dimension(nCol, nLev, nTracers),intent(inout) :: & tracer ! Array containing trace gases character(len=*), dimension(:), intent(in) :: & - active_gases_array ! List of active gases from namelist as array + active_gases_array ! List of active gases from namelist as array type(ty_gas_concs), intent(inout) :: & gas_concentrations ! RRTMGP DDT: gas volumne mixing ratios real(kind_phys), dimension(:), intent(inout) :: & @@ -173,8 +178,7 @@ subroutine GFS_rrtmgp_pre_run(me, nCol, nLev, nTracers, i_o3, lsswr, lslwr, fhsw coszdg ! Cosine of SZA, daytime ! Local variables - integer :: i, j, iCol, iBand, iSFC, iTOA, iLay - logical :: top_at_1 + integer :: i, j, iCol, iBand, iLay real(kind_phys),dimension(nCol,nLev) :: vmr_o3, vmr_h2o real(kind_phys) :: es, tem1, tem2 real(kind_phys), dimension(nCol,nLev) :: o3_lay diff --git a/physics/GFS_rrtmgp_pre.meta b/physics/GFS_rrtmgp_pre.meta index cdd1dd7ce..af899f528 100644 --- a/physics/GFS_rrtmgp_pre.meta +++ b/physics/GFS_rrtmgp_pre.meta @@ -308,6 +308,27 @@ type = real kind = kind_phys intent = inout +[top_at_1] + standard_name = flag_for_vertical_ordering_in_RRTMGP + long_name = flag for vertical ordering in RRTMGP + units = flag + dimensions = () + type = logical + intent = out +[iSFC] + standard_name = vertical_index_for_surface_in_RRTMGP + long_name = index for surface layer in RRTMGP + units = flag + dimensions = () + type = integer + intent = out +[iTOA] + standard_name = vertical_index_for_TOA_in_RRTMGP + long_name = index for TOA layer in RRTMGP + units = flag + dimensions = () + type = integer + intent = out [tsfc_radtime] standard_name = surface_skin_temperature_on_radiation_timestep long_name = surface skin temperature on radiation timestep diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 index 1787d4f4f..8b8d271f6 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -1,11 +1,9 @@ module GFS_rrtmgp_sw_post use machine, only: kind_phys 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 module_radsw_parameters, only: topfsw_type, sfcfsw_type, cmpfsw_type use mo_heating_rates, only: compute_heating_rate - use radiation_tools, only: check_error_msg + use radiation_tools, only: check_error_msg use rrtmgp_sw_gas_optics, only: sw_gas_props implicit none @@ -29,15 +27,17 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky save_diag, fhswr, coszen, coszdg, t_lay, p_lev, sfc_alb_nir_dir, sfc_alb_nir_dif, & sfc_alb_uvvis_dir, sfc_alb_uvvis_dif, fluxswUP_allsky, & fluxswDOWN_allsky, fluxswUP_clrsky, fluxswDOWN_clrsky, raddt, aerodp, cldsa, mbota, & - mtopa, cld_frac, cldtausw, fluxr, & + mtopa, cld_frac, cldtausw, fluxr, iSFC, iTOA, & nirbmdi, nirdfdi, visbmdi, visdfdi, nirbmui, nirdfui, visbmui, visdfui, sfcnsw, & - sfcdsw, htrsw, sfcfsw, topfsw, htrswc, flxprf_sw, scmpsw, errmsg, errflg) + sfcdsw, htrsw, sfcfsw, topfsw, htrswc, scmpsw, errmsg, errflg) ! Inputs integer, intent(in) :: & nCol, & ! Horizontal loop extent nLev, & ! Number of vertical layers - nDay ! Number of daylit columns + nDay, & ! Number of daylit columns + iSFC, & ! Vertical index for surface level + iTOA ! Vertical index for TOA level integer, intent(in), dimension(nday) :: & idxday ! Index array for daytime points logical, intent(in) :: & @@ -74,9 +74,7 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky real(kind_phys), dimension(nCol,nLev), intent(in) :: & cld_frac, & ! Total cloud fraction in each layer cldtausw ! approx .55mu band layer cloud optical depth - - ! Inputs (optional) - type(cmpfsw_type), dimension(nCol), intent(inout), optional :: & + type(cmpfsw_type), dimension(nCol), intent(in) :: & 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) @@ -111,20 +109,13 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky errflg ! Outputs (optional) - type(profsw_type), dimension(nCol, nLev), 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) real(kind_phys),dimension(nCol, nLev),intent(inout),optional :: & htrswc ! Clear-sky heating rate (K/s) ! Local variables - integer :: i, j, k, iSFC, iTOA, itop, ibtc + integer :: i, j, k, itop, ibtc real(kind_phys) :: tem0d, tem1, tem2 real(kind_phys), dimension(nDay, nLev) :: thetaTendClrSky, thetaTendAllSky - logical :: l_fluxessw2d, top_at_1, l_scmpsw ! Initialize CCPP error handling variables errmsg = '' @@ -133,24 +124,6 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky if (.not. lsswr) return if (nDay .gt. 0) then - ! Are any optional outputs requested? - l_fluxessw2d = present(flxprf_sw) - - ! Are the components of the surface fluxes provided? - l_scmpsw = present(scmpsw) - - ! ####################################################################################### - ! What is 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 - ! ####################################################################################### ! Compute SW heating-rates ! ####################################################################################### @@ -176,49 +149,32 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky ! ####################################################################################### ! Save SW outputs + ! (Copy fluxes from RRTGMP types into model radiation types.) ! ####################################################################################### - ! Copy fluxes from RRTGMP types into model radiation types. - ! Mandatory outputs + + ! TOA fluxes topfsw(:)%upfxc = fluxswUP_allsky(:,iTOA) topfsw(:)%upfx0 = fluxswUP_clrsky(:,iTOA) topfsw(:)%dnfxc = fluxswDOWN_allsky(:,iTOA) + + ! Surface fluxes sfcfsw(:)%upfxc = fluxswUP_allsky(:,iSFC) sfcfsw(:)%upfx0 = fluxswUP_clrsky(:,iSFC) sfcfsw(:)%dnfxc = fluxswDOWN_allsky(:,iSFC) 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 - ! Surface down and up spectral component fluxes ! - Save two spectral bands' surface downward and upward fluxes for output. - if (l_scmpsw) then - do i=1,nCol - nirbmdi(i) = scmpsw(i)%nirbm - nirdfdi(i) = scmpsw(i)%nirdf - visbmdi(i) = scmpsw(i)%visbm - visdfdi(i) = scmpsw(i)%visdf - nirbmui(i) = scmpsw(i)%nirbm * sfc_alb_nir_dir(1,i) - nirdfui(i) = scmpsw(i)%nirdf * sfc_alb_nir_dif(1,i) - visbmui(i) = scmpsw(i)%visbm * sfc_alb_uvvis_dir(1,i) - visdfui(i) = scmpsw(i)%visdf * sfc_alb_uvvis_dif(1,i) - enddo - else - scmpsw = cmpfsw_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) - nirbmdi(:) = 0.0 - nirdfdi(:) = 0.0 - visbmdi(:) = 0.0 - visdfdi(:) = 0.0 - nirbmui(:) = 0.0 - nirdfui(:) = 0.0 - visbmui(:) = 0.0 - visdfui(:) = 0.0 - endif + do i=1,nCol + nirbmdi(i) = scmpsw(i)%nirbm + nirdfdi(i) = scmpsw(i)%nirdf + visbmdi(i) = scmpsw(i)%visbm + visdfdi(i) = scmpsw(i)%visdf + nirbmui(i) = scmpsw(i)%nirbm * sfc_alb_nir_dir(1,i) + nirdfui(i) = scmpsw(i)%nirdf * sfc_alb_nir_dif(1,i) + visbmui(i) = scmpsw(i)%visbm * sfc_alb_uvvis_dir(1,i) + visdfui(i) = scmpsw(i)%visdf * sfc_alb_uvvis_dif(1,i) + enddo else ! if_nday_block ! ####################################################################################### ! Dark everywhere @@ -226,7 +182,6 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky htrsw(:,:) = 0.0 sfcfsw = sfcfsw_type( 0.0, 0.0, 0.0, 0.0 ) topfsw = topfsw_type( 0.0, 0.0, 0.0 ) - scmpsw = cmpfsw_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) nirbmdi(:) = 0.0 nirdfdi(:) = 0.0 visbmdi(:) = 0.0 @@ -270,15 +225,15 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky fluxr(i,3 ) = fluxr(i,3) + sfcfsw(i)%upfxc * tem0d fluxr(i,4 ) = fluxr(i,4) + sfcfsw(i)%dnfxc * tem0d ! total sky sfc sw dn ! SW uv-b fluxes - fluxr(i,21) = fluxr(i,21) + scmpsw(i)%uvbfc * tem0d ! total sky uv-b sw dn - fluxr(i,22) = fluxr(i,22) + scmpsw(i)%uvbf0 * tem0d ! clear sky uv-b sw dn + fluxr(i,21) = fluxr(i,21) + scmpsw(i)%uvbfc * tem0d ! total sky uv-b sw dn + fluxr(i,22) = fluxr(i,22) + scmpsw(i)%uvbf0 * tem0d ! clear sky uv-b sw dn ! SW TOA incoming fluxes - fluxr(i,23) = fluxr(i,23) + topfsw(i)%dnfxc * tem0d ! top sw dn + fluxr(i,23) = fluxr(i,23) + topfsw(i)%dnfxc * tem0d ! top sw dn ! SW SFC flux components - fluxr(i,24) = fluxr(i,24) + visbmdi(i) * tem0d ! uv/vis beam sw dn - fluxr(i,25) = fluxr(i,25) + visdfdi(i) * tem0d ! uv/vis diff sw dn - fluxr(i,26) = fluxr(i,26) + nirbmdi(i) * tem0d ! nir beam sw dn - fluxr(i,27) = fluxr(i,27) + nirdfdi(i) * tem0d ! nir diff sw dn + fluxr(i,24) = fluxr(i,24) + visbmdi(i) * tem0d ! uv/vis beam sw dn + fluxr(i,25) = fluxr(i,25) + visdfdi(i) * tem0d ! uv/vis diff sw dn + fluxr(i,26) = fluxr(i,26) + nirbmdi(i) * tem0d ! nir beam sw dn + fluxr(i,27) = fluxr(i,27) + nirdfdi(i) * tem0d ! nir diff sw dn ! SW clear-sky fluxes fluxr(i,29) = fluxr(i,29) + topfsw(i)%upfx0 * tem0d fluxr(i,31) = fluxr(i,31) + sfcfsw(i)%upfx0 * tem0d diff --git a/physics/GFS_rrtmgp_sw_post.meta b/physics/GFS_rrtmgp_sw_post.meta index 93ab07a1d..a43331c64 100644 --- a/physics/GFS_rrtmgp_sw_post.meta +++ b/physics/GFS_rrtmgp_sw_post.meta @@ -22,6 +22,20 @@ dimensions = () type = integer intent = in +[iSFC] + standard_name = vertical_index_for_surface_in_RRTMGP + long_name = index for surface layer in RRTMGP + units = flag + dimensions = () + type = integer + intent = in +[iTOA] + standard_name = vertical_index_for_TOA_in_RRTMGP + long_name = index for TOA layer in RRTMGP + units = flag + dimensions = () + type = integer + intent = in [nday] standard_name = daytime_points_dimension long_name = daytime points dimension diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index 7be8f7865..5ddcec078 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -5,7 +5,7 @@ module rrtmgp_lw_cloud_optics use mo_optical_props, only: ty_optical_props_1scl, ty_optical_props_2str use mo_rrtmg_lw_cloud_optics, only: rrtmg_lw_cloud_optics use rrtmgp_lw_gas_optics, only: lw_gas_props - use radiation_tools, only: check_error_msg + use radiation_tools, only: check_error_msg use netcdf #ifdef MPI use mpi diff --git a/physics/rrtmgp_lw_cloud_sampling.F90 b/physics/rrtmgp_lw_cloud_sampling.F90 index 8702c20d7..d8d499577 100644 --- a/physics/rrtmgp_lw_cloud_sampling.F90 +++ b/physics/rrtmgp_lw_cloud_sampling.F90 @@ -4,7 +4,7 @@ module rrtmgp_lw_cloud_sampling use mo_optical_props, only: ty_optical_props_2str use rrtmgp_sampling, only: sampled_mask, draw_samples use mersenne_twister, only: random_setseed, random_number, random_stat - use radiation_tools, only: check_error_msg + use radiation_tools, only: check_error_msg use rrtmgp_lw_gas_optics, only: lw_gas_props use netcdf @@ -149,6 +149,7 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, icseed_lw, iovr, ! #################################################################################### ! Next sample the precipitation... + ! (Use same RNGs as was used by the clouds.) ! #################################################################################### lw_optical_props_precip%band2gpt = lw_gas_props%get_band_lims_gpoint() lw_optical_props_precip%band_lims_wvn = lw_gas_props%get_band_lims_wavenumber() @@ -156,26 +157,6 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, icseed_lw, iovr, lw_optical_props_precip%gpt2band(lw_optical_props_precip%band2gpt(1,iBand):lw_optical_props_precip%band2gpt(2,iBand)) = iBand end do - ! Change random number seed value for each radiation invocation (isubc_lw =1 or 2). - if(isubc_lw == 1) then ! advance prescribed permutation seed - do iCol = 1, ncol - ipseed_lw(iCol) = lw_gas_props%get_ngpt() + iCol - enddo - elseif (isubc_lw == 2) then ! use input array of permutaion seeds - do iCol = 1, ncol - ipseed_lw(iCol) = icseed_lw(iCol) - enddo - endif - - ! No need to call RNG second time for now, just use the same seeds for precip as clouds. - !! 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 - ! Precipitation overlap. ! Maximum-random, random or maximum. if (iovr == iovr_maxrand .or. iovr == iovr_rand .or. iovr == iovr_max) then @@ -183,13 +164,6 @@ subroutine rrtmgp_lw_cloud_sampling_run(doLWrad, nCol, nLev, icseed_lw, iovr, endif ! Exponential decorrelation length overlap if (iovr == iovr_dcorr) then - ! No need to call RNG second time for now, just use the same seeds for precip as clouds. - !! Generate second RNG - !do iCol=1,ncol - ! call random_setseed(ipseed_lw(icol),rng_stat) - ! call random_number(rng1D,rng_stat) - ! rng3D2(:,:,iCol) = reshape(source = rng1D,shape=[lw_gas_props%get_ngpt(),nLev]) - !enddo call sampled_mask(rng3D, precip_frac, precipfracSAMP, & overlap_param = precip_overlap_param(:,1:nLev-1), & randoms2 = rng3D2) diff --git a/physics/rrtmgp_lw_gas_optics.F90 b/physics/rrtmgp_lw_gas_optics.F90 index 738ff5b30..67a888911 100644 --- a/physics/rrtmgp_lw_gas_optics.F90 +++ b/physics/rrtmgp_lw_gas_optics.F90 @@ -466,8 +466,7 @@ end subroutine rrtmgp_lw_gas_optics_init !! \htmlinclude rrtmgp_lw_gas_optics_run.html !! subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, p_lay, p_lev, t_lay, t_lev, tsfg, & - active_gases_array, gas_concentrations, lw_optical_props_clrsky, sources, & - errmsg, errflg) + gas_concentrations, lw_optical_props_clrsky, sources, errmsg, errflg) ! Inputs logical, intent(in) :: & @@ -483,10 +482,8 @@ subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, p_lay, p_lev, t_lay, t_ t_lev ! Temperature @ model levels real(kind_phys), dimension(ncol), intent(in) :: & tsfg ! Surface ground temperature (K) - type(ty_gas_concs),intent(inout) :: & + type(ty_gas_concs),intent(in) :: & gas_concentrations ! RRTMGP DDT: trace gas concentrations (vmr) - character(len=*), dimension(:), intent(in) :: & - active_gases_array ! List of active gases from namelist as array ! Output character(len=*), intent(out) :: & @@ -507,8 +504,6 @@ subroutine rrtmgp_lw_gas_optics_run(doLWrad, nCol, nLev, p_lay, p_lev, t_lay, t_ if (.not. doLWrad) return - gas_concentrations%gas_name(:) = active_gases_array(:) - ! Copy spectral information into GP DDTs. lw_optical_props_clrsky%band2gpt = lw_gas_props%get_band_lims_gpoint() sources%band2gpt = lw_gas_props%get_band_lims_gpoint() diff --git a/physics/rrtmgp_lw_gas_optics.meta b/physics/rrtmgp_lw_gas_optics.meta index 7a3d86eb8..2024df664 100644 --- a/physics/rrtmgp_lw_gas_optics.meta +++ b/physics/rrtmgp_lw_gas_optics.meta @@ -165,21 +165,13 @@ type = real kind = kind_phys intent = in -[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 [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 = inout + intent = in [lw_optical_props_clrsky] standard_name = longwave_optical_properties_for_clear_sky long_name = Fortran DDT containing RRTMGP optical properties diff --git a/physics/rrtmgp_lw_rte.F90 b/physics/rrtmgp_lw_rte.F90 index c9c3db1e6..aed4f0027 100644 --- a/physics/rrtmgp_lw_rte.F90 +++ b/physics/rrtmgp_lw_rte.F90 @@ -2,14 +2,11 @@ ! ########################################################################################### 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, ty_optical_props_2str 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 radiation_tools, only: check_error_msg + use radiation_tools, only: check_error_msg use rrtmgp_lw_gas_optics, only: lw_gas_props implicit none @@ -29,13 +26,14 @@ end subroutine rrtmgp_lw_rte_init !! \htmlinclude rrtmgp_lw_rte_run.html !! subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, nCol, & - nLev, p_lev, sfc_emiss_byband, sources, lw_optical_props_clrsky, & + nLev, top_at_1, sfc_emiss_byband, sources, lw_optical_props_clrsky, & lw_optical_props_clouds, lw_optical_props_aerosol, nGauss_angles, fluxlwUP_allsky, & fluxlwDOWN_allsky, fluxlwUP_clrsky, fluxlwDOWN_clrsky, fluxlwUP_jac, & fluxlwUP_radtime, fluxlwDOWN_radtime, errmsg, errflg) ! Inputs logical, intent(in) :: & + top_at_1, & ! Vertical ordering flag doLWrad, & ! Logical flag for longwave radiation call doLWclrsky, & ! Compute clear-sky fluxes for clear-sky heating-rate? use_LW_jacobian, & ! Compute Jacobian of LW to update radiative fluxes between radiation calls? @@ -44,8 +42,6 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, 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+1), intent(in) :: & - p_lev ! Pressure @ model layer-interfaces (Pa) 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) :: & @@ -75,9 +71,6 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, 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 :: & - top_at_1 - integer :: iSFC, iTOA real(kind_phys), dimension(nCol,lw_gas_props%get_ngpt()) :: lw_Ds ! Initialize CCPP error handling variables @@ -86,16 +79,6 @@ subroutine rrtmgp_lw_rte_run(doLWrad, doLWclrsky, use_LW_jacobian, doGP_lwscat, if (.not. doLWrad) return - ! 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 - ! Initialize RRTMGP DDT containing 2D(3D) fluxes flux_allsky%bnd_flux_up => fluxLW_up_allsky flux_allsky%bnd_flux_dn => fluxLW_dn_allsky diff --git a/physics/rrtmgp_lw_rte.meta b/physics/rrtmgp_lw_rte.meta index 33fcdf309..752251c43 100644 --- a/physics/rrtmgp_lw_rte.meta +++ b/physics/rrtmgp_lw_rte.meta @@ -57,13 +57,12 @@ dimensions = () type = integer intent = in -[p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP - long_name = air pressure level - units = Pa - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys +[top_at_1] + standard_name = flag_for_vertical_ordering_in_RRTMGP + long_name = flag for vertical ordering in RRTMGP + units = flag + dimensions = () + type = logical intent = in [sfc_emiss_byband] standard_name = surface_emissivity_in_each_RRTMGP_LW_band diff --git a/physics/rrtmgp_sw_aerosol_optics.F90 b/physics/rrtmgp_sw_aerosol_optics.F90 index 0ac03bb12..afd039249 100644 --- a/physics/rrtmgp_sw_aerosol_optics.F90 +++ b/physics/rrtmgp_sw_aerosol_optics.F90 @@ -2,7 +2,7 @@ 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 radiation_tools, only: check_error_msg + use radiation_tools, only: check_error_msg use rrtmgp_sw_gas_optics, only: sw_gas_props use rrtmgp_lw_gas_optics, only: lw_gas_props use module_radiation_aerosols, only: & diff --git a/physics/rrtmgp_sw_cloud_optics.F90 b/physics/rrtmgp_sw_cloud_optics.F90 index 0ab0c3361..f80440522 100644 --- a/physics/rrtmgp_sw_cloud_optics.F90 +++ b/physics/rrtmgp_sw_cloud_optics.F90 @@ -5,7 +5,7 @@ module rrtmgp_sw_cloud_optics use mo_optical_props, only: ty_optical_props_2str use mo_rrtmg_sw_cloud_optics, only: rrtmg_sw_cloud_optics use rrtmgp_sw_gas_optics, only: sw_gas_props - use radiation_tools, only: check_error_msg + use radiation_tools, only: check_error_msg use netcdf #ifdef MPI use mpi @@ -534,7 +534,7 @@ subroutine rrtmgp_sw_cloud_optics_run(doSWrad, doG_cldoptics, icliq_sw, icice_sw tau_cld, ssa_cld, asy_cld, & tau_precip, ssa_precip, asy_precip) - ! Cloud-optics (Need to reorder from G->GP band conventions) + ! Cloud-optics (Need to reorder from G->GP band conventions) sw_optical_props_cloudsByBand%tau(:,:,1) = tau_cld(:,:,sw_gas_props%get_nband()) sw_optical_props_cloudsByBand%ssa(:,:,1) = ssa_cld(:,:,sw_gas_props%get_nband()) sw_optical_props_cloudsByBand%g(:,:,1) = asy_cld(:,:,sw_gas_props%get_nband()) diff --git a/physics/rrtmgp_sw_cloud_sampling.F90 b/physics/rrtmgp_sw_cloud_sampling.F90 index 23d47c919..3172ae315 100644 --- a/physics/rrtmgp_sw_cloud_sampling.F90 +++ b/physics/rrtmgp_sw_cloud_sampling.F90 @@ -31,13 +31,13 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, idxday, iovr, nCol, & ! Number of horizontal gridpoints nDay, & ! Number of daylit points. nLev, & ! Number of vertical layers - iovr, & ! Choice of cloud-overlap method - iovr_max, & ! Flag for maximum cloud overlap method - iovr_maxrand, & ! Flag for maximum-random cloud overlap method - iovr_rand, & ! Flag for random cloud overlap method - iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method - iovr_exp, & ! Flag for exponential cloud overlap method - iovr_exprand, & ! Flag for exponential-random cloud overlap method + iovr, & ! Choice of cloud-overlap method + iovr_max, & ! Flag for maximum cloud overlap method + iovr_maxrand, & ! Flag for maximum-random cloud overlap method + iovr_rand, & ! Flag for random cloud overlap method + iovr_dcorr, & ! Flag for decorrelation-length cloud overlap method + iovr_exp, & ! Flag for exponential cloud overlap method + iovr_exprand, & ! Flag for exponential-random cloud overlap method isubc_sw integer,intent(in),dimension(ncol) :: & idxday ! Indices for daylit points. @@ -54,7 +54,7 @@ subroutine rrtmgp_sw_cloud_sampling_run(doSWrad, nCol, nDay, nLev, idxday, iovr, precip_overlap_param ! Precipitation overlap parameter type(ty_optical_props_2str),intent(in) :: & sw_optical_props_cloudsByBand, & ! RRTMGP DDT: Shortwave optical properties in each band (clouds) - sw_optical_props_precipByBand ! RRTMGP DDT: Shortwave optical properties in each band (precipitation) + sw_optical_props_precipByBand ! RRTMGP DDT: Shortwave optical properties in each band (precipitation) ! Outputs character(len=*), intent(out) :: & diff --git a/physics/rrtmgp_sw_rte.F90 b/physics/rrtmgp_sw_rte.F90 index f28e94b0f..1726d4bbd 100644 --- a/physics/rrtmgp_sw_rte.F90 +++ b/physics/rrtmgp_sw_rte.F90 @@ -1,14 +1,10 @@ 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 radiation_tools, only: check_error_msg + use radiation_tools, only: check_error_msg use rrtmgp_sw_gas_optics, only: sw_gas_props implicit none @@ -29,19 +25,21 @@ end subroutine rrtmgp_sw_rte_init !! \htmlinclude rrtmgp_sw_rte.html !! subroutine rrtmgp_sw_rte_run(doSWrad, doSWclrsky, nCol, nLev, nDay, idxday, coszen, p_lay, & - t_lay, p_lev, sw_optical_props_clrsky, sfc_alb_nir_dir, sfc_alb_nir_dif, & + t_lay, top_at_1, iSFC, 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, scmpsw, fluxswUP_allsky, fluxswDOWN_allsky, fluxswUP_clrsky,& fluxswDOWN_clrsky, errmsg, errflg) ! Inputs logical, intent(in) :: & + top_at_1, & ! Vertical ordering flag doSWrad, & ! Flag to calculate SW irradiances doSWclrsky ! Compute clear-sky fluxes? integer, intent(in) :: & nCol, & ! Number of horizontal gridpoints nday, & ! Number of daytime points - nLev ! Number of vertical levels + nLev, & ! Number of vertical levels + iSFC ! Vertical index for surface-level integer, intent(in), dimension(ncol) :: & idxday ! Index array for daytime points real(kind_phys),intent(in), dimension(ncol) :: & @@ -49,8 +47,6 @@ subroutine rrtmgp_sw_rte_run(doSWrad, doSWclrsky, nCol, nLev, nDay, idxday, cosz 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_optical_props_2str),intent(inout) :: & sw_optical_props_clrsky ! RRTMGP DDT: shortwave clear-sky radiative properties type(ty_optical_props_2str),intent(in) :: & @@ -74,9 +70,7 @@ subroutine rrtmgp_sw_rte_run(doSWrad, doSWclrsky, nCol, nLev, nDay, idxday, cosz 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 :: & + type(cmpfsw_type), dimension(ncol), intent(inout) :: & scmpsw ! 2D surface fluxes, components: ! uvbfc - total sky downward uv-b flux (W/m2) ! uvbf0 - clear sky downward uv-b flux (W/m2) @@ -94,8 +88,7 @@ subroutine rrtmgp_sw_rte_run(doSWrad, doSWclrsky, nCol, nLev, nDay, idxday, cosz 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_scmpsw=.false., top_at_1 - integer :: iGas,iSFC,iTOA,iBand + integer :: iBand ! Initialize CCPP error handling variables errmsg = '' @@ -103,36 +96,9 @@ subroutine rrtmgp_sw_rte_run(doSWrad, doSWclrsky, nCol, nLev, nDay, idxday, cosz 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_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 @@ -190,11 +156,15 @@ subroutine rrtmgp_sw_rte_run(doSWrad, doSWclrsky, nCol, nLev, nDay, idxday, cosz ! Store fluxes fluxswUP_allsky(idxday(1:nday),:) = sum(flux_allsky%bnd_flux_up,dim=3) fluxswDOWN_allsky(idxday(1:nday),:) = sum(flux_allsky%bnd_flux_dn,dim=3) - if ( l_scmpsw ) then - scmpsw(idxday(1:nday))%nirbm = sum(flux_allsky%bnd_flux_dn_dir(1:nday,iSFC,:),dim=2) - scmpsw(idxday(1:nday))%nirdf = sum(flux_allsky%bnd_flux_dn(1:nday,iSFC,:),dim=2) - & - sum(flux_allsky%bnd_flux_dn_dir(1:nday,iSFC,:),dim=2) - endif + 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) + else + fluxswUP_allsky(:,:) = 0._kind_phys + fluxswDOWN_allsky(:,:) = 0._kind_phys + fluxswUP_clrsky(:,:) = 0._kind_phys + fluxswDOWN_clrsky(:,:) = 0._kind_phys + scmpsw = cmpfsw_type( 0.0, 0.0, 0.0, 0.0, 0.0, 0.0 ) endif end subroutine rrtmgp_sw_rte_run diff --git a/physics/rrtmgp_sw_rte.meta b/physics/rrtmgp_sw_rte.meta index 4abb558f7..995a5626a 100644 --- a/physics/rrtmgp_sw_rte.meta +++ b/physics/rrtmgp_sw_rte.meta @@ -66,13 +66,19 @@ type = real kind = kind_phys intent = in -[p_lev] - standard_name = air_pressure_at_interface_for_RRTMGP - long_name = air pressure level - units = Pa - dimensions = (horizontal_loop_extent,vertical_interface_dimension) - type = real - kind = kind_phys +[top_at_1] + standard_name = flag_for_vertical_ordering_in_RRTMGP + long_name = flag for vertical ordering in RRTMGP + units = flag + dimensions = () + type = logical + intent = in +[iSFC] + standard_name = vertical_index_for_surface_in_RRTMGP + long_name = index for surface layer in RRTMGP + units = flag + dimensions = () + type = integer intent = in [t_lay] standard_name = air_temperature_at_layer_for_RRTMGP From b5616bb1d4145616b125f7d4961938e05c848ebc Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Tue, 30 Nov 2021 15:36:04 +0000 Subject: [PATCH 09/11] Fixed typo. --- physics/GFS_rrtmgp_lw_post.F90 | 2 +- physics/GFS_rrtmgp_sw_post.F90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/physics/GFS_rrtmgp_lw_post.F90 b/physics/GFS_rrtmgp_lw_post.F90 index 0396667c4..cccaa501c 100644 --- a/physics/GFS_rrtmgp_lw_post.F90 +++ b/physics/GFS_rrtmgp_lw_post.F90 @@ -112,7 +112,7 @@ subroutine GFS_rrtmgp_lw_post_run (nCol, nLev, lslwr, do_lw_clrsky_hr, save_diag ! ####################################################################################### ! Save LW outputs. - ! (Copy fluxes from RRTGMP types into model radiation types.) + ! (Copy fluxes from RRTMGP types into model radiation types.) ! ####################################################################################### ! TOA fluxes topflw(:)%upfxc = fluxlwUP_allsky(:,iTOA) diff --git a/physics/GFS_rrtmgp_sw_post.F90 b/physics/GFS_rrtmgp_sw_post.F90 index 8b8d271f6..a52caac38 100644 --- a/physics/GFS_rrtmgp_sw_post.F90 +++ b/physics/GFS_rrtmgp_sw_post.F90 @@ -149,7 +149,7 @@ subroutine GFS_rrtmgp_sw_post_run (nCol, nLev, nDay, idxday, lsswr, do_sw_clrsky ! ####################################################################################### ! Save SW outputs - ! (Copy fluxes from RRTGMP types into model radiation types.) + ! (Copy fluxes from RRTMGP types into model radiation types.) ! ####################################################################################### ! TOA fluxes From 002d070fdff8fa30538594d89c6e30fc2e7f3b58 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 3 Dec 2021 22:10:58 +0000 Subject: [PATCH 10/11] Updated rte-rrtmgp submodule. Performance improvements. --- physics/rte-rrtmgp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index 56c549450..cf0eb0903 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit 56c549450787cc7f592a66b4005a299244056568 +Subproject commit cf0eb0903835f21b4da717f3150133137895d4e2 From 4bf8b44e8022ebc39120506b412dc021c0f94c14 Mon Sep 17 00:00:00 2001 From: Dustin Swales Date: Fri, 3 Dec 2021 23:40:33 +0000 Subject: [PATCH 11/11] Fixed error in rte-rrtmgp submodule hash. --- physics/rte-rrtmgp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/physics/rte-rrtmgp b/physics/rte-rrtmgp index cf0eb0903..cec1e8e12 160000 --- a/physics/rte-rrtmgp +++ b/physics/rte-rrtmgp @@ -1 +1 @@ -Subproject commit cf0eb0903835f21b4da717f3150133137895d4e2 +Subproject commit cec1e8e12d969c3c8c76574dbe4f40b366419cc7