diff --git a/physics/GFS_rrtmgp_pre.F90 b/physics/GFS_rrtmgp_pre.F90 index b5fd3ed14..4d076706c 100644 --- a/physics/GFS_rrtmgp_pre.F90 +++ b/physics/GFS_rrtmgp_pre.F90 @@ -199,8 +199,7 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, real(kind_phys),dimension(NCOL,Model%levs) :: vmr_o3, vmr_h2o, coldry, tem0, colamt real(kind_phys) :: es, qs, tem1, tem2 real(kind_phys), dimension(ncol, NF_ALBD) :: sfcalb - real(kind_phys), dimension(ncol, Model%levs) :: qs_lay, q_lay, deltaZ, deltaP, o3_lay, p_lay_log - real(kind_phys), dimension(ncol, Model%levs+1) :: p_lev_log + real(kind_phys), dimension(ncol, Model%levs) :: qs_lay, q_lay, deltaZ, deltaP, o3_lay real(kind_phys), dimension(ncol, Model%levs, NF_VGAS) :: gas_vmr real(kind_phys), dimension(ncol, Model%levs, NF_CLDS) :: clouds real(kind_phys), dimension(ncol) :: precipitableH2o @@ -242,35 +241,15 @@ subroutine GFS_rrtmgp_pre_run (Model, Grid, Statein, Coupling, Radtend, Sfcprop, ! Temperature at layer-interfaces if (top_at_1) then - ! Log of pressure (used for temperature level interpolation) - p_lay_log = log(p_lay) - p_lev_log(:,1) = log(max(1.0e-6,p_lev(:,1))) - p_lev_log(:,2:iSFC+1) = log(p_lev(:,2:iSFC+1)) - ! t_lev(1:NCOL,1) = t_lay(1:NCOL,iTOA) - do iLay=2,iSFC - t_lev(1:nCol,iLay) = t_lay(1:nCol,iLay) + (t_lay(1:nCol,iLay-1)-t_lay(1:nCol,iLay)) * & - (p_lev_log(1:nCol,iLay) - p_lay_log(1:nCol,iLay)) / & - (p_lay_log(1:nCol,iLay-1) - p_lay_log(1:nCol,iLay)) - enddo - !t_lev(1:NCOL,2:iSFC) = (t_lay(1:NCOL,2:iSFC)+t_lay(1:NCOL,1:iSFC-1))/2._kind_phys + t_lev(1:NCOL,2:iSFC) = (t_lay(1:NCOL,2:iSFC)+t_lay(1:NCOL,1:iSFC-1))/2._kind_phys t_lev(1:NCOL,iSFC+1) = Sfcprop%tsfc(1:NCOL) else - ! Log of pressure (used for temperature level interpolation) - p_lay_log = log(p_lay) - p_lev_log(:,1) = log(max(1.0e-6,p_lev(:,1))) - p_lev_log(:,2:iTOA+1) = log(p_lev(:,2:iTOA+1)) - ! t_lev(1:NCOL,1) = Sfcprop%tsfc(1:NCOL) - do iLay=2,iTOA - t_lev(1:nCol,iLay) = t_lay(1:nCol,iLay-1) + (t_lay(1:nCol,iLay)-t_lay(1:nCol,iLay-1)) * & - (p_lev_log(1:nCol,iLay)-p_lay_log(1:nCol,iLay-1)) / & - (p_lay_log(1:nCol,iLay)-p_lay_log(1:nCol,iLay-1)) - enddo - !t_lev(1:NCOL,2:iTOA) = (t_lay(1:NCOL,2:iTOA)+t_lay(1:NCOL,1:iTOA-1))/2._kind_phys + t_lev(1:NCOL,2:iTOA) = (t_lay(1:NCOL,2:iTOA)+t_lay(1:NCOL,1:iTOA-1))/2._kind_phys t_lev(1:NCOL,iTOA+1) = t_lay(1:NCOL,iTOA) endif - + ! Compute layer pressure thicknes deltaP = abs(p_lev(:,2:model%levs+1)-p_lev(:,1:model%levs)) diff --git a/physics/rrtmg_lw_cloud_optics.F90 b/physics/rrtmg_lw_cloud_optics.F90 index 0447caea5..31551d797 100644 --- a/physics/rrtmg_lw_cloud_optics.F90 +++ b/physics/rrtmg_lw_cloud_optics.F90 @@ -646,16 +646,19 @@ subroutine rrtmg_lw_cloud_optics(ncol, nlay, nBandsLW, cld_lwp, cld_ref_liq, cld fint*(absice3(index+1,ib) - absice3(index,ib)) )) enddo endif - endif - - ! Cloud optical depth - do ib = 1, nBandsLW - tau_cld(ij,ik,ib) = tau_ice(ib) + tau_liq(ib) + tau_rain + tau_snow - enddo - - endif ! Cloud layer? - end do ! Layer - end do ! Column + endif + else + tau_rain = 0. + tau_snow = 0. + tau_liq(:) = 0. + tau_ice(:) = 0. + endif + ! Cloud optical depth + do ib = 1, nBandsLW + tau_cld(ij,ik,ib) = tau_ice(ib) + tau_liq(ib) + tau_rain + tau_snow + enddo + end do + end do endif end subroutine rrtmg_lw_cloud_optics ! ####################################################################################### diff --git a/physics/rrtmgp_lw_cloud_optics.F90 b/physics/rrtmgp_lw_cloud_optics.F90 index 1ba051768..aacecd6df 100644 --- a/physics/rrtmgp_lw_cloud_optics.F90 +++ b/physics/rrtmgp_lw_cloud_optics.F90 @@ -395,7 +395,8 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, nCol, nLev, cld_optics_scheme, nr ! Local variables logical,dimension(ncol,nLev) :: liqmask, icemask - integer :: k + real(kind_phys), dimension(ncol,nLev,lw_gas_props%get_nband()) :: & + tau_cld ! Initialize CCPP error handling variables errmsg = '' @@ -411,7 +412,6 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, nCol, nLev, cld_optics_scheme, nr ! Cloud optics [nCol,nLev,nBands] call check_error_msg('rrtmgp_lw_cloud_optics_run',lw_optical_props_cloudsByBand%alloc_1scl(& ncol, nLev, lw_gas_props%get_band_lims_wavenumber())) - lw_optical_props_cloudsByBand%tau(:,:,:) = 0._kind_phys ! Compute cloud-optics for RTE. if (rrtmgp_cld_optics .gt. 0) then @@ -434,7 +434,8 @@ subroutine rrtmgp_lw_cloud_optics_run(doLWrad, nCol, nLev, cld_optics_scheme, nr if (any(cld_frac .gt. 0)) then call rrtmg_lw_cloud_optics(ncol, nLev, lw_gas_props%get_nband(), cld_lwp, & cld_reliq, cld_iwp, cld_reice, cld_rwp, cld_rerain, cld_swp, cld_resnow, & - cld_frac, lw_optical_props_cloudsByBand%tau) + cld_frac, tau_cld) + lw_optical_props_cloudsByBand%tau = tau_cld endif endif